[Cyan]<CedarLang>Nucleus>Lister>GLList.mesa!1

file GLList.mesa

last edited by Satterthwaite, May 10, 1983 12:23 pm

Last Edited by: Maxwell, August 12, 1983 8:54 am

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;

output streams

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};

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;

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]};

module enumeration

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"]};

overall control

ListGlobals: PUBLIC PROC [root, output: Rope.ROPE] = {

OpenOutput[output];

DoGlobals[root];

CloseOutput[]};