<> <> <> <<>> DIRECTORY BcdDefs: TYPE USING [Base, BcdBase, Link, MTIndex, MTRecord, MTNull, NameString], ConvertUnsafe: TYPE USING [SubString, SubStringToRope], FileSegment: TYPE USING [Pages, nullPages], IO: TYPE USING [card, char, CR, Close, Put, PutChar, PutRope, rope, STREAM, TAB], ListerOps: TYPE USING [], ListerUtil: TYPE USING [ CreateStream, GetTypescript, LoadBcd, LoadModule, MapPages, Message, PutFileID, SetExtension, SetRoutineSymbols, UnknownModule], PrincOps: TYPE USING [globalbase], Rope: TYPE USING [ROPE], Symbols: TYPE USING [ Name, ISEIndex, CSEIndex, CTXIndex, CBTIndex, BitAddress, nullName, ISENull, CSENull, CTXNull, RootBti, WordLength], SymbolTable: TYPE USING [Acquire, Base, Release, SetCacheSize], VM: TYPE USING [AddressForPageNumber, Free, Interval, nullInterval]; GLList: PROGRAM IMPORTS ConvertUnsafe, IO, ListerUtil, SymbolTable, VM EXPORTS ListerOps = { OPEN Symbols; <

> out: IO.STREAM _ NIL; typescript: BOOLEAN _ FALSE; OpenOutput: PROC [output: Rope.ROPE] = { typescript _ (output = NIL); IF typescript THEN out _ ListerUtil.GetTypescript[] ELSE {output _ ListerUtil.SetExtension[output, "sl"]; out _ ListerUtil.CreateStream[output]}}; CloseOutput: PROC = { IF ~typescript THEN IO.Close[out]; out _ NIL}; <> symbols: SymbolTable.Base _ NIL; DoSymbol: PROC [sei: ISEIndex] RETURNS [span: CARDINAL] = { addr: BitAddress = symbols.seb[sei].idValue; size: CARDINAL = symbols.seb[sei].idInfo/WordLength; name: Name = symbols.NameForSe[sei]; d: ConvertUnsafe.SubString; n: NAT; IO.PutRope[out," "]; IF name = nullName THEN { IO.PutRope[out, "(anon)"]; n _ ("(anon)"L).length} ELSE { d _ symbols.SubStringForName[name]; IO.PutRope[out, ConvertUnsafe.SubStringToRope[d]]; n _ d.length}; WHILE n < 16 DO IO.PutChar[out, ' ]; n _ n + 1 ENDLOOP; IO.Put[out, IO.char[IO.TAB], IO.card[size], IO.char[IO.CR]]; 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 { IO.PutRope[out, " Global arguments:\n"]; maxSpan _ MAX[DoFields[typeIn], maxSpan]}; IF typeOut # CSENull THEN { IO.PutRope[out, " Global results:\n"]; maxSpan _ MAX[DoFields[typeOut], maxSpan]}; IF symbols.bb[bti].localCtx # CTXNull THEN { IO.PutRope[out, " Global variables:\n"]; maxSpan _ MAX[DoContext[symbols.bb[bti].localCtx], maxSpan]}; IF ~symbols.bb[bti].hints.noStrings THEN IO.PutRope[out, " Global string literals or string bodies\n"]; IF maxSpan # frameSize AND frameSize > frameOverhead THEN { IO.Put[out, IO.rope[" "], IO.card[frameSize - maxSpan]]; IO.PutRope[out, " words not in listed variables or overhead\n"]}; IO.PutChar[out, IO.CR]}; <> DoGlobals: PROC [root: Rope.ROPE] = { bcdFile: Rope.ROPE; bcdSeg: FileSegment.Pages _ FileSegment.nullPages; bcdInterval: VM.Interval; bcd: BcdDefs.BcdBase _ NIL; mtb: BcdDefs.Base _ NIL; ssb: BcdDefs.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: ConvertUnsafe.SubString _ [ base: @ssb.string, offset: mtb[mti].name, length: ssb.size[mtb[mti].name]]; name: Rope.ROPE; sSeg: FileSegment.Pages; name _ ConvertUnsafe.SubStringToRope[d]; IO.PutRope[out, "Module: "]; IO.PutRope[out, name]; IF mtb[mti].tableCompiled THEN GO TO Table; [symbols: sSeg] _ ListerUtil.LoadModule[bcdSeg, name ! ListerUtil.UnknownModule => {GOTO NoModule}]; IF ~bcd.definitions THEN IO.Put[out, IO.rope[", frame size: "], IO.card[mtb[mti].framesize]]; IF mtb[mti].ngfi > 1 THEN IO.Put[out, IO.rope[", gfi slots: "], IO.card[mtb[mti].ngfi]]; IO.PutChar[out, IO.CR]; 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 IO.PutRope[out, " No global frame\n\n"] ELSE DoBody[Symbols.RootBti, mtb[mti].framesize]; SymbolTable.Release[symbols]; symbols _ NIL; EXITS Table => IO.PutRope[out, " -- table compiled\n\n"]; NoModule => IO.PutRope[out, " -- not found in file\n\n"]; NoSymbols => IO.PutRope[out, " symbols not available\n\n"]}; bcdFile _ ListerUtil.SetExtension[root, "bcd"]; bcdSeg _ ListerUtil.LoadBcd[bcdFile]; bcdInterval _ ListerUtil.MapPages[bcdSeg]; IF bcdInterval # VM.nullInterval THEN { ListerUtil.PutFileID[out]; bcd _ VM.AddressForPageNumber[bcdInterval.page]; mtb _ LOOPHOLE[bcd, BcdDefs.Base] + bcd.mtOffset; ssb _ LOOPHOLE[bcd + bcd.ssOffset]; [] _ EnumerateModules[DoModule]; ssb _ NIL; mtb _ NIL; bcd _ NIL; VM.Free[bcdInterval]} ELSE ListerUtil.Message["File could not be opened"]}; <> ListGlobals: PUBLIC PROC [root, output: Rope.ROPE] = { OpenOutput[output]; DoGlobals[root]; CloseOutput[]}; }.