-- file GLList.mesa 
-- last edited by Satterthwaite, September 16, 1982 8:36 am

DIRECTORY
  BcdDefs: TYPE USING [Base, Link, MTIndex, MTRecord, MTNull],
  BcdOps: TYPE USING [BcdBase, NameString],
  CharIO: TYPE USING [PutChar, PutDecimal, PutString, PutSubString],
  FileSegment: TYPE USING [Pages, nullPages],
  ListerOps: TYPE USING [],
  ListerUtil: TYPE USING [
    CreateStream, LoadBcd, LoadModule, MapPages, Message, PutFileID,
    SetFileName, SetRoutineSymbols, TTYStream, UnknownModule],
  PrincOps: TYPE USING [globalbase],
  Space: TYPE USING [Handle, Delete, LongPointer, nullHandle],
  Stream: TYPE USING [Delete, Handle],
  Strings: TYPE USING [
    String, SubStringDescriptor, AppendString, AppendSubString],
  Symbols: TYPE USING [
    HTIndex, ISEIndex, CSEIndex, CTXIndex, CBTIndex, BitAddress,
    HTNull, ISENull, CSENull, CTXNull, RootBti, WordLength],
  SymbolTable: TYPE USING [Acquire, Base, Release, SetCacheSize];

GLList: PROGRAM
    IMPORTS CharIO, ListerUtil, Space, Stream, Strings, SymbolTable
    EXPORTS ListerOps = {
  OPEN Symbols;
  
 -- output streams
 
  out: Stream.Handle _ NIL;
  
  OpenOutput: PROC [root: Strings.String, tty: BOOL] = {
    IF tty THEN out _ ListerUtil.TTYStream[]
    ELSE {
      outName: STRING _ [40];
      ListerUtil.SetFileName[outName, root, "gl"L];
      out _ ListerUtil.CreateStream[outName]}};
    
  CloseOutput: PROC = {Stream.Delete[out]; out _ NIL};
    
 -- symbol printing
 
  symbols: SymbolTable.Base _ NIL;

  DoSymbol: PROC [sei: ISEIndex] RETURNS [span: CARDINAL] = {
    addr: BitAddress = symbols.seb[sei].idValue;
    size: CARDINAL = symbols.seb[sei].idInfo/WordLength;
    hti: HTIndex = symbols.HashForSe[sei];
    d: Strings.SubStringDescriptor;
    n: NAT;
    CharIO.PutString[out,"    "L];
    IF hti = HTNull THEN {
      CharIO.PutString[out, "(anon)"L];
      n _ ("(anon)"L).length}
    ELSE {
      symbols.SubStringForHash[@d, hti];
      CharIO.PutSubString[out, @d];
      n _ d.length};
    WHILE n < 16 DO CharIO.PutChar[out, ' ]; n _ n + 1 ENDLOOP;
    CharIO.PutChar[out, '\t];  CharIO.PutDecimal[out, size];
    CharIO.PutChar[out, '\n];
    RETURN [addr.wd + size]};
      
  DoContext: PROC [ctx: CTXIndex] RETURNS [maxSpan: CARDINAL _ 0] = {
    FOR sei: ISEIndex _ symbols.FirstCtxSe[ctx], symbols.NextSe[sei]
     UNTIL sei = ISENull DO
      IF ~symbols.seb[sei].constant THEN
        maxSpan _ MAX[DoSymbol[sei], maxSpan];
      ENDLOOP};
      
  DoFields: PROC [rSei: CSEIndex] RETURNS [maxSpan: CARDINAL] = {
    RETURN [WITH t: symbols.seb[rSei] SELECT FROM
      record => DoContext[t.fieldCtx],
      ENDCASE => 0]};
      
  DoBody: PROC [bti: Symbols.CBTIndex, frameSize: CARDINAL] = {
    frameOverhead: CARDINAL = PrincOps.globalbase+1;	-- for start trap pointer
    maxSpan: CARDINAL _ PrincOps.globalbase;
    typeIn, typeOut: CSEIndex;
    [typeIn, typeOut] _ symbols.TransferTypes[symbols.bb[bti].ioType];
    IF typeIn # CSENull THEN {
      CharIO.PutString[out, "  Global arguments:\n"L];
      maxSpan _ MAX[DoFields[typeIn], maxSpan]};
    IF typeOut # CSENull THEN {
      CharIO.PutString[out, "  Global results:\n"L];
      maxSpan _ MAX[DoFields[typeOut], maxSpan]};
    IF symbols.bb[bti].localCtx # CTXNull THEN {
      CharIO.PutString[out, "  Global variables:\n"L];
      maxSpan _ MAX[DoContext[symbols.bb[bti].localCtx], maxSpan]};
    IF ~symbols.bb[bti].hints.noStrings THEN
      CharIO.PutString[out, "  Global string literals or string bodies\n"L];
    IF maxSpan # frameSize AND frameSize > frameOverhead THEN {
      CharIO.PutString[out, "  "L];
      CharIO.PutDecimal[out, frameSize - maxSpan];
      CharIO.PutString[out, " words not in listed variables or overhead\n"L]};
    CharIO.PutChar[out, '\n]};
 
 -- module enumeration
 
  DoGlobals: PROC [root: Strings.String] = {
    bcdFile: Strings.String _ [100];
    bcdSeg: FileSegment.Pages _ FileSegment.nullPages;
    bcdSpace: Space.Handle;

    bcd: BcdOps.BcdBase _ NIL;
    mtb: BcdDefs.Base _ NIL;
    ssb: BcdOps.NameString;
      
    EnumerateModules: PROC [proc: PROC [BcdDefs.MTIndex] RETURNS [BOOL]]
        RETURNS [BcdDefs.MTIndex] = {
      mti: BcdDefs.MTIndex _ BcdDefs.MTIndex.FIRST;
      UNTIL mti = bcd.mtLimit DO
	IF proc[mti] THEN RETURN [mti];
	mti _ mti + (WITH m: mtb[mti] SELECT FROM
		direct => BcdDefs.MTRecord.direct.SIZE + m.length*BcdDefs.Link.SIZE,
		indirect => BcdDefs.MTRecord.indirect.SIZE,
		multiple => BcdDefs.MTRecord.multiple.SIZE,
		ENDCASE => ERROR)
	ENDLOOP;
      RETURN [BcdDefs.MTNull]};
    
    DoModule: PROC [mti: BcdDefs.MTIndex] RETURNS [BOOL_FALSE] = {
      d: Strings.SubStringDescriptor _ [
	base: @ssb.string, offset: mtb[mti].name, length: ssb.size[mtb[mti].name]];
      name: Strings.String _ [100];
      sSeg: FileSegment.Pages;
      CharIO.PutString[out, "Module: "L];  CharIO.PutSubString[out, @d];
      IF mtb[mti].tableCompiled THEN GO TO Table;
      Strings.AppendSubString[name, @d];
      [symbols: sSeg] _ ListerUtil.LoadModule[bcdSeg, name
	! ListerUtil.UnknownModule => {GOTO NoModule}];
      IF ~bcd.definitions THEN {
	CharIO.PutString[out, ", frame size: "L];
	CharIO.PutDecimal[out, mtb[mti].framesize]};
      IF mtb[mti].ngfi > 1 THEN {
	CharIO.PutString[out, ", gfi slots: "L];
	CharIO.PutDecimal[out, mtb[mti].ngfi]};
      CharIO.PutChar[out, '\n];
      IF sSeg = FileSegment.nullPages THEN GO TO NoSymbols;
      SymbolTable.SetCacheSize[0];	-- flush cache
      symbols _ SymbolTable.Acquire[sSeg];
      ListerUtil.SetRoutineSymbols[symbols];
      IF symbols.stHandle.definitionsFile THEN
	CharIO.PutString[out, "  No global frame\n\n"L]
      ELSE DoBody[Symbols.RootBti, mtb[mti].framesize];
      SymbolTable.Release[symbols]; symbols _ NIL;
      EXITS
	Table => CharIO.PutString[out, " -- table compiled\n\n"L];
	NoModule => CharIO.PutString[out, " -- not found in file\n\n"L];
	NoSymbols => CharIO.PutString[out, "  symbols not available\n\n"L]};
    
    MakeBcdFilename[bcdFile, root];
    bcdSeg _ ListerUtil.LoadBcd[bcdFile];
    bcdSpace _ ListerUtil.MapPages[bcdSeg];
    IF bcdSpace # Space.nullHandle THEN {
      ListerUtil.PutFileID[out];
      bcd _ bcdSpace.LongPointer;
      mtb _ LOOPHOLE[bcd, BcdDefs.Base] + bcd.mtOffset;
      ssb _ LOOPHOLE[bcd + bcd.ssOffset];
      [] _ EnumerateModules[DoModule];
      ssb _ NIL;  mtb _ NIL;  bcd _ NIL;
      Space.Delete[bcdSpace]}
    ELSE ListerUtil.Message["File could not be opened"L]};
    
 -- overall control
 
  MakeBcdFilename: PROC [bcd, root: Strings.String] = {
    Strings.AppendString[bcd, root];
    FOR i: CARDINAL IN [0..bcd.length) DO IF bcd[i] = '. THEN RETURN ENDLOOP;
    Strings.AppendString[bcd, ".bcd"L]};
    
  ListGlobals: PUBLIC PROC [root: Strings.String, ttyOut: BOOL] = {
    OpenOutput[root, ttyOut];
    DoGlobals[root];
    CloseOutput[]};

  }.