-- FindSigs.Mesa  Edited by Sandman on July 8, 1980  8:48 AM
-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  AltoFileDefs USING [CFA],
  ControlDefs USING [ControlLink, PrefixHandle],
  FastDirDefs USING [StripSwitches, Cap],
  FrameOps USING [FrameSize],
  ImageDefs USING [StopMesa],
  ImageFileInfoDefs USING [
    CodeSegForFrame, EnumerateGlobalFrames, FindAllSymbols, FrameToModuleName,
    GlobalFrameHandle, SetImage, SymbolSegForFrame, Version, VirtualGlobalFrame],
  IODefs USING [CR, SP],
  MiscDefs USING [CommandLineCFA],
  PrincOps USING [ControlLink],
  OutputDefs USING [
    CloseOutput, OpenOutput, PutCR, PutChar, PutNumber, PutOctal, PutString,
    PutTime],
  SegmentDefs USING [
    FileSegmentAddress, FileSegmentHandle, InsertFile, SwapIn, Unlock],
  StreamDefs USING [CreateByteStream, JumpToFA, Read, StreamHandle],
  String USING [AppendChar, AppendString, AppendSubString, SubStringDescriptor],
  SymbolTable USING [Acquire, Release, Base, TableForSegment],
  Symbols USING [BTIndex, HTIndex, ISEIndex, ISENull, BTNull, CBTIndex],
  Storage USING [CopyString, FreeString];

FindSigs: PROGRAM
  IMPORTS
    FastDirDefs, ImageDefs, OutputDefs, SegmentDefs, StreamDefs, String,
    SymbolTable, Storage, ImageFileInfoDefs, MiscDefs, FrameOps =
  BEGIN OPEN SegmentDefs;
  
  SigItem: TYPE = RECORD [name: STRING, desc: CARDINAL];
  
  comstr: StreamDefs.StreamHandle _ GetCommandLineStream[];
  sigdata: ARRAY [0..128) OF SigItem;
  nsigs: CARDINAL;
  symbols: SymbolTable.Base;
  
  PrintSignals: PROCEDURE [gfi: CARDINAL] =
    BEGIN
    tname: STRING _ [60];
    sei: Symbols.ISEIndex;
    t, desc: CARDINAL;
    nsigs _ 0;
    FOR sei _ symbols.FirstCtxSe[symbols.stHandle.outerCtx], symbols.NextSe[sei]
      UNTIL sei = Symbols.ISENull DO 
      OPEN id: symbols.seb[sei];
      IF id.immutable THEN
	WITH symbols.seb[symbols.UnderType[id.idType]] SELECT FROM
	  transfer =>
	    IF (mode = signal OR mode = error) AND symbols.seb[sei].idCtx =
	      symbols.stHandle.outerCtx THEN
	      BEGIN
	      GetName[tname, symbols.seb[sei].hash];
	      desc _ symbols.seb[sei].idValue;
	      t _ nsigs;
	      WHILE t > 0 DO
		IF sigdata[t - 1].desc < desc THEN EXIT;
		sigdata[t] _ sigdata[t - 1];
		t _ t - 1;
		ENDLOOP;
	      nsigs _ nsigs + 1;
	      sigdata[t] _ [Storage.CopyString[tname], desc];
	      END;
	  ENDCASE;
      ENDLOOP;
    FOR t IN [0..nsigs) DO
      PutIdValue[sigdata[t].desc, gfi];
      OutputDefs.PutString["  "L];
      OutputDefs.PutString[sigdata[t].name];
      OutputDefs.PutCR[];
      Storage.FreeString[sigdata[t].name]
      ENDLOOP;
    RETURN
    END;
    
  PrintProcs: PROCEDURE [
    gfi: CARDINAL, codeseg: FileSegmentHandle, offset: CARDINAL] =
    BEGIN OPEN symbols;
    bti, prev: Symbols.BTIndex;
    cp: ControlDefs.PrefixHandle _ NIL;
    IF codeseg # NIL THEN
      BEGIN SwapIn[codeseg]; cp _ FileSegmentAddress[codeseg] + offset; END;
    bti _ LOOPHOLE[0];
    OutputDefs.PutCR[];
    DO
      WITH bb[bti] SELECT FROM
	Callable => IF ~inline THEN Proc[LOOPHOLE[bti], gfi, cp];
	ENDCASE;
      IF bb[bti].firstSon # Symbols.BTNull THEN bti _ bb[bti].firstSon
      ELSE
	DO
	  prev _ bti;
	  bti _ bb[bti].link.index;
	  IF bti = Symbols.BTNull THEN GO TO Done;
	  IF bb[prev].link.which # parent THEN EXIT;
	  ENDLOOP;
      REPEAT Done => NULL;
      ENDLOOP;
    IF codeseg # NIL THEN Unlock[codeseg];
    OutputDefs.PutCR[];
    END;
    
  Proc: PROCEDURE [
    bti: Symbols.CBTIndex, gfi: CARDINAL, cp: ControlDefs.PrefixHandle] =
    BEGIN OPEN symbols;
    isei: Symbols.ISEIndex _ bb[bti].id;
    fsi, origin: CARDINAL;
    WITH bb[bti].info SELECT FROM
      External =>
	BEGIN OPEN OutputDefs;
	PutIdValue[seb[isei].idValue, gfi];
	IF cp # NIL THEN
	  BEGIN
	  fsi _ cp.entry[bb[bti].entryIndex].info.framesize;
	  PutNumber[fsi, [8, FALSE, TRUE, 3]];
	  PutNumber[FrameOps.FrameSize[fsi], [8, FALSE, TRUE, 5]];
	  origin _ cp.entry[bb[bti].entryIndex].initialpc;
	  PutNumber[origin*2, [8, FALSE, TRUE, 5]];
	  END;
	PutNumber[bytes, [10, FALSE, TRUE, 4]];
	PutString["  "L];
	PutBodyName[isei];
	PutCR[];
	END;
      ENDCASE;
    RETURN
    END;
    
  PutBodyName: PROCEDURE [isei: Symbols.ISEIndex] =
    BEGIN OPEN symbols;
    name: STRING _ [60];
    IF isei = Symbols.ISENull THEN name _ "(priv)"L
    ELSE GetName[name, seb[isei].hash];
    OutputDefs.PutString[name];
    END;
    
  PutIdValue: PROCEDURE [num, gfi: CARDINAL] =
    BEGIN OPEN OutputDefs;
    proc: ControlDefs.ControlLink;
    gfiOffset: CARDINAL _ LOOPHOLE[num, PrincOps.ControlLink].gfi;
    epOffset: CARDINAL _ LOOPHOLE[num, PrincOps.ControlLink].ep;
    proc _ [procedure[gfi: gfiOffset + gfi - 1, ep: epOffset, tag: procedure]];
    PutString["  "L];
    PutNumber[LOOPHOLE[proc], [8, FALSE, TRUE, 6]];
    PutChar['B];
    END;
    
  MungeModule: PROCEDURE [f: ImageFileInfoDefs.GlobalFrameHandle]
    RETURNS [BOOLEAN] =
    BEGIN OPEN ImageFileInfoDefs;
    
    Cleanup: PROCEDURE = BEGIN SymbolTable.Release[symbols] END;
      
    symseg, codeseg: FileSegmentHandle;
    offset: CARDINAL;
    modname: STRING _ [60];
    BEGIN
    FrameToModuleName[f, modname ! ANY => GOTO badFrame];
    OutputDefs.PutCR[];
    OutputDefs.PutNumber[LOOPHOLE[f], [8, FALSE, TRUE, 6]];
    OutputDefs.PutString["B "];
    symseg _ SymbolSegForFrame[f ! ANY => GOTO badName];
    IF symseg = NIL THEN
      BEGIN OPEN OutputDefs;
      PutString[modname];
      PutString[" (cannot find symbols)"];
      PutCR[];
      RETURN[FALSE]
      END;
    symbols _ SymbolTable.Acquire[SymbolTable.TableForSegment[symseg]];
    [seg: codeseg, offset: offset] _ CodeSegForFrame[f ! ANY => GOTO badName];
    WITH symbols.bb[FIRST[Symbols.BTIndex]] SELECT FROM
      Callable => GetName[modname, symbols.seb[id].hash];
      ENDCASE;
    OutputDefs.PutString[modname];
    OutputDefs.PutCR[];
    IF sigs THEN
      PrintSignals[
	VirtualGlobalFrame[f].gfi ! ANY => BEGIN Cleanup[]; GOTO badName END];
    IF procs THEN
      PrintProcs[
	VirtualGlobalFrame[f].gfi, codeseg, offset !
	ANY => BEGIN Cleanup[]; GOTO badName END];
    Cleanup[];
    EXITS
      badFrame =>
	BEGIN OPEN OutputDefs;
	PutOctal[f];
	PutString["  (problems encountered)"L];
	END;
      badName =>
	BEGIN OPEN OutputDefs;
	PutString[modname];
	PutString["  (problems encountered)"L];
	END;
    END;
    RETURN[FALSE]
    END;
    
  GetName: PROCEDURE [s: STRING, hti: Symbols.HTIndex] =
    BEGIN
    ss: String.SubStringDescriptor;
    symbols.SubStringForHash[@ss, hti];
    s.length _ 0;
    String.AppendSubString[s, @ss];
    END;
    
  sigs, procs: BOOLEAN;
  
  SetSwitches: PROCEDURE [root: STRING] =
    BEGIN
    i: CARDINAL;
    switches: STRING _ [10];
    notMinus: BOOLEAN _ TRUE;
    sigs _ TRUE;
    procs _ FALSE; -- reset from last time
    FastDirDefs.StripSwitches[root, switches];
    IF switches = NIL THEN RETURN;
    FOR i IN [0..switches.length) DO
      SELECT FastDirDefs.Cap[
	switches[i]] FROM
	'- => BEGIN notMinus _ FALSE; LOOP END;
	'P => procs _ notMinus;
	'S => sigs _ notMinus;
	ENDCASE => LOOP;
      notMinus _ TRUE;
      ENDLOOP;
    END;
    
  CheckForExtension: PROCEDURE [name, ext: STRING] =
    BEGIN
    i: CARDINAL;
    FOR i IN [0..name.length) DO IF name[i] = '. THEN RETURN; ENDLOOP;
    String.AppendString[name, ext];
    RETURN
    END;
    
  ProcessImage: PROCEDURE =
    BEGIN
    infile: STRING _ [40];
    root: STRING _ [40];
    i: CARDINAL;
    GetToken[infile];
    WHILE infile.length # 0 DO
      SetSwitches[infile];
      CheckForExtension[infile, ".image"];
      FOR i IN [0..infile.length) DO
	IF infile[i] = '. THEN EXIT; String.AppendChar[root, infile[i]]; ENDLOOP;
      ImageFileInfoDefs.SetImage[infile];
      ImageFileInfoDefs.FindAllSymbols[];
      OutputDefs.OpenOutput[root, IF procs THEN ".procs"L ELSE ".signals."L];
      WriteHerald[infile];
      [] _ ImageFileInfoDefs.EnumerateGlobalFrames[MungeModule];
      OutputDefs.CloseOutput[];
      GetToken[infile];
      root.length _ 0;
      ENDLOOP;
    END;
    
  WriteHerald: PROCEDURE [name: STRING] =
    BEGIN OPEN OutputDefs;
    PutString[name];
    PutString[" -- "L];
    PutTime[ImageFileInfoDefs.Version[].time];
    PutCR[];
    PutCR[];
    PutCR[];
    RETURN
    END;
    
  GetToken: PROCEDURE [token: STRING] =
    BEGIN
    c: CHARACTER;
    token.length _ 0;
    UNTIL comstr.endof[comstr] DO
      SELECT c
	_
	comstr.get[
	comstr] FROM
	IODefs.SP, IODefs.CR => IF token.length # 0 THEN RETURN;
	ENDCASE => String.AppendChar[token, c];
      ENDLOOP;
    RETURN
    END;
    
  GetCommandLineStream: PROCEDURE RETURNS [s: StreamDefs.StreamHandle] =
    BEGIN OPEN StreamDefs;
    cfa: POINTER TO AltoFileDefs.CFA _ MiscDefs.CommandLineCFA[];
    s _ CreateByteStream[SegmentDefs.InsertFile[@cfa.fp, Read], Read];
    JumpToFA[s, @cfa.fa];
    RETURN
    END;
    
  -- Main Body
  
  ProcessImage[];
  ImageDefs.StopMesa[];
  
  END...