-- FindBcdSigs.Mesa  Edited by Sandman on August 22, 1980  8:46 AM
-- Copyright  Xerox Corporation 1979, 1980

DIRECTORY
  AltoFileDefs USING [CFA],
  BcdDefs USING [MTIndex],
  BcdOps USING [BcdBase, MTHandle, NameString, ProcessModules],
  ControlDefs USING [ControlLink, PrefixHandle],
  FastDirDefs USING [StripSwitches, Cap],
  FrameOps USING [FrameSize],
  ImageDefs USING [StopMesa],
  BcdInfoDefs USING [CodeForModule, FindAllFiles, SetBcd, SymbolsForModule],
  IODefs USING [CR, SP, WriteChar, WriteString],
  MiscDefs USING [CommandLineCFA],
  OutputDefs USING [
    CloseOutput, OpenOutput, PutCR, PutChar, PutNumber, PutOctal, PutString,
    PutTime],
  PrincOps USING [ControlLink],
  SegmentDefs USING [
    FileSegmentHandle, FileSegmentAddress, InsertFile, SwapIn, Unlock],
  StreamDefs USING [CreateByteStream, JumpToFA, Read, StreamHandle],
  String USING [
    AppendChar, AppendString, AppendSubString, InvalidNumber, StringToOctal,
    SubStringDescriptor],
  SymbolTable USING [Acquire, Release, Base, TableForSegment],
  Symbols USING [BTIndex, HTIndex, ISEIndex, ISENull, BTNull, CBTIndex],
  Storage USING [CopyString, FreeString];

FindBcdSigs: PROGRAM
  IMPORTS
    BcdOps, FastDirDefs, ImageDefs, OutputDefs, SegmentDefs, StreamDefs, String,
    SymbolTable, Storage, BcdInfoDefs, MiscDefs, IODefs, FrameOps =
  BEGIN OPEN SegmentDefs, OutputDefs;
  
  SigItem: TYPE = RECORD [name: STRING, desc: CARDINAL];
  
  altoCode: BOOLEAN;
  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;
    cd: ControlDefs.ControlLink;
    po: PrincOps.ControlLink;
    gfiOffset: CARDINAL _ LOOPHOLE[num, PrincOps.ControlLink].gfi;
    epOffset: CARDINAL _ LOOPHOLE[num, PrincOps.ControlLink].ep;
    cd _ [procedure[gfi: gfiOffset + gfi - 1, ep: epOffset, tag: procedure]];
    po _ [procedure[gfi: gfiOffset + gfi - 1, ep: epOffset, tag: TRUE]];
    PutString["  "L];
    PutNumber[
      IF altoCode THEN LOOPHOLE[cd] ELSE LOOPHOLE[po], [8, FALSE, TRUE, 6]];
    PutChar['B];
    END;
    
  MungeModule: PROCEDURE [mth: BcdOps.MTHandle, mti: BcdDefs.MTIndex]
    RETURNS [BOOLEAN] =
    BEGIN OPEN BcdInfoDefs;
    
    Cleanup: PROCEDURE = BEGIN SymbolTable.Release[symbols] END;
      
    symseg, codeseg: FileSegmentHandle;
    BEGIN
    OutputDefs.PutCR[];
    WriteModuleName[bcd: bcd, mth: mth];
    PutChar[IODefs.SP];
    PutChar['[];
    IF (altoCode _ mth.altoCode) THEN
      PutOctal[
	ControlDefs.ControlLink[
	procedure[gfi: mth.gfi + offset, ep: 0, tag: frame]]]
    ELSE
      PutOctal[
	PrincOps.ControlLink[
	procedure[gfi: mth.gfi + offset, ep: 0, tag: FALSE]]];
    PutChar[']];
    symseg _ SymbolsForModule[mti: mti ! ANY => GOTO badName];
    IF symseg = NIL THEN
      BEGIN PutString[" (cannot find symbols)"]; PutCR[]; RETURN[FALSE] END;
    symbols _ SymbolTable.Acquire[SymbolTable.TableForSegment[symseg]];
    codeseg _ CodeForModule[mti: mti ! ANY => GOTO badName];
    OutputDefs.PutCR[];
    IF sigs THEN
      PrintSignals[mth.gfi + offset ! ANY => BEGIN Cleanup[]; GOTO badName END];
    IF procs THEN
      PrintProcs[
	mth.gfi + offset, codeseg, mth.code.offset !
	ANY => BEGIN Cleanup[]; GOTO badName END];
    Cleanup[];
    EXITS badName => BEGIN PutString["  (problems encountered)"L]; END;
    END;
    RETURN[FALSE]
    END;
    
  WriteModuleName: PROCEDURE [bcd: BcdOps.BcdBase, mth: BcdOps.MTHandle] =
    BEGIN
    ssb: BcdOps.NameString _ LOOPHOLE[bcd + bcd.ssOffset];
    i: CARDINAL;
    FOR i IN [mth.name..mth.name + ssb.size[mth.name]) DO
      PutChar[ssb.string.text[i]]; ENDLOOP;
    END;
    
  GetName: PROCEDURE [s: STRING, hti: Symbols.HTIndex] =
    BEGIN
    ss: String.SubStringDescriptor;
    symbols.SubStringForHash[@ss, hti];
    s.length _ 0;
    String.AppendSubString[s, @ss];
    END;
    
  offset: CARDINAL;
  sigs, procs, number, procdesc, controllink: BOOLEAN;
  
  SetSwitches: PROCEDURE [root: STRING] =
    BEGIN
    i: CARDINAL;
    switches: STRING _ [10];
    notMinus: BOOLEAN _ TRUE;
    sigs _ TRUE;
    number _ procdesc _ 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;
	'N => number _ TRUE;
	'C => controllink _ TRUE;
	'X => procdesc _ TRUE;
	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;
    
  bcd: BcdOps.BcdBase;
  
  ProcessBcd: PROCEDURE =
    BEGIN
    infile: STRING _ [40];
    root: STRING _ [40];
    i: CARDINAL;
    offset _ 0;
    DO
      root.length _ 0;
      GetToken[infile];
      IF infile.length = 0 THEN EXIT;
      SetSwitches[infile];
      IF number OR procdesc THEN
	BEGIN OPEN String;
	offset _ StringToOctal[
	  infile ! InvalidNumber => BEGIN offset _ 0; LOOP END];
	IF procdesc THEN offset _ offset/200B;
	IF controllink THEN offset _ offset/100B;
	offset _ offset - 1;
	LOOP;
	END;
      CheckForExtension[infile, ".bcd"];
      FOR i IN [0..infile.length) DO
	IF infile[i] = '. THEN EXIT; String.AppendChar[root, infile[i]]; ENDLOOP;
      bcd _ BcdInfoDefs.SetBcd[infile];
      IF bcd # NIL THEN
	BEGIN
	BcdInfoDefs.FindAllFiles[];
	OpenOutput[root, IF procs THEN ".procs"L ELSE ".signals."L];
	WriteHerald[infile];
	[] _ BcdOps.ProcessModules[bcd, MungeModule];
	CloseOutput[];
	END
      ELSE BEGIN OPEN IODefs; WriteChar['!]; WriteString[infile] END;
      offset _ 0;
      ENDLOOP;
    END;
    
  WriteHerald: PROCEDURE [name: STRING] =
    BEGIN OPEN OutputDefs;
    PutString[name];
    PutString[" -- "L];
    PutTime[bcd.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
  
  ProcessBcd[];
  ImageDefs.StopMesa[];
  
  END...