-- CGenDebugGlobals.mesa Edited by Bruce, September 22, 1980 10:55 AM
DIRECTORY
AllocDebugDefs USING [],
AltoDefs USING [wordlength],
CGenDebugDefs USING [ccInfo, cd, UpdateConstDest],
CGenDebugGlobalDefs USING [
AllocatorbaseOffset, AllocatortopOffset, CodecodeptrOffset,
CodecurctxlvlOffset, CodeframeszOffset, CodestkingOffset,
CodetempcontextOffset, CodetempstartOffset, ComDatabodyIndexOffset,
ComDatasourceFileOffset, ComDatatextIndexOffset, ConstructorcdOffset,
DrivercodestartOffset, ExpressionrecentExpOffset, FinalccInfoOffset,
FlowlabelStackOffset, StackImplstkHeadOffset, StackImplstkPtrOffset,
StatementrecentStmtOffset, TempheapListOffset, TemppendTempListOffset],
CodeDefs USING [
CCIndex, CCInfoType, ConsDestination, LabelInfoIndex, StackIndex,
StackItem, StackNull],
ControlDefs USING [GlobalFrameHandle],
DebugUsefulDefs USING [Enumerate, Name, ShortCopyREAD, ShortREAD, window],
Event USING [AddNotifier, Item, Masks, Notifier],
IODefs USING [ControlZ, CR],
OpCodeParams USING [GlobalBase, GlobalLoadSlots, LocalBase, LocalLoadSlots],
Process USING [Detach, Yield],
RESOut USING [
cancelAction, Complain, PChar, PCr, PNext, PNextUnsigned, POctal, PString,
PUnsigned],
SegmentDefs USING [FileNameError],
StreamDefs USING [
GetIndex, ModifyIndex, NewByteStream, NormalizeIndex, Read, SetIndex,
StreamHandle, StreamIndex],
StringDefs USING [AppendChar, AppendDecimal, AppendString, CompareStrings],
Symbols USING [
BitAddress, ContextLevel, CTXRecord, ctxType, ISEIndex, ISENull, lG, lZ,
SERecord, seType],
Storage USING [String, FreeString],
Table USING [Base, chunkType, Selector],
UserInput USING [
CancelPeriodicNotify, CreatePeriodicNotify, PeriodicNotifyHandle,
PeriodicProcType];
CGenDebugGlobals: PROGRAM
IMPORTS CGenDebugDefs, DebugUsefulDefs, Event, Process, RESOut,
SegmentDefs, StreamDefs, StringDefs, Storage, UserInput
EXPORTS CGenDebugDefs, AllocDebugDefs =
BEGIN OPEN CodeDefs, DebugUsefulDefs, RESOut, CGenDebugDefs, CGenDebugGlobalDefs;
basesValid: BOOLEAN ← FALSE;
al: POINTER ← NIL;
constructor: POINTER ← NIL;
CPtr: POINTER ← NIL;
driver: POINTER ← NIL;
expression: POINTER ← NIL;
final: POINTER ← NIL;
flow: POINTER ← NIL;
MPtr: POINTER ← NIL;
stack: POINTER ← NIL;
statement: POINTER ← NIL;
temp: POINTER ← NIL;
StackBottom: PUBLIC PROCEDURE RETURNS [StackIndex] =
BEGIN OPEN CodeDefs;
sHead: StackIndex;
sir: StackItem;
cb: Table.Base = TableBase[];
IF stack = NIL THEN
BEGIN
RESOut.Complain["Base of StackImpl unknown"L];
ERROR cancelAction;
END;
sHead ← ShortREAD[stack+StackImplstkHeadOffset];
IF sHead = StackNull THEN RETURN [StackNull];
ShortCopyREAD[to: @sir, from: @cb[sHead], nwords: SIZE[StackItem]];
RETURN [sir.uplink];
END;
StackState: PUBLIC PROCEDURE RETURNS [BOOLEAN] =
BEGIN
IF stack = NIL THEN
BEGIN
RESOut.Complain["Base of StackImpl unknown"L];
ERROR cancelAction;
END;
RETURN [ShortREAD[CPtr+CodestkingOffset]];
END;
StackTop: PUBLIC PROCEDURE RETURNS [StackIndex] =
BEGIN OPEN CodeDefs;
IF stack = NIL THEN
BEGIN
RESOut.Complain["Base of StackImpl unknown"L];
ERROR cancelAction;
END;
RETURN [ShortREAD[stack+StackImplstkPtrOffset]];
END;
PutTempState: PUBLIC PROCEDURE =
BEGIN OPEN Symbols;
seb: Table.Base = TableBase[seType];
ser: id SERecord;
name: STRING ← [20];
ShowList: PROCEDURE [sei: ISEIndex, heading: STRING] =
BEGIN
first: BOOLEAN ← TRUE;
IF sei = ISENull THEN RETURN;
PCr[]; PString[" "L];
PString[heading]; PString[": {"L];
WHILE sei # ISENull DO
ShortCopyREAD[to: @ser, from: @seb[sei], nwords: SIZE[id SERecord]];
GetVarName[name, sei];
IF first THEN PString[name] ELSE PNext[name,,6];
first ← FALSE;
WITH ser SELECT FROM
linked => sei ← link;
ENDCASE => sei ← ISENull;
ENDLOOP;
PChar['}];
END;
IF temp = NIL THEN
BEGIN
RESOut.Complain["Base of Temp unknown"L];
ERROR cancelAction;
END;
PCr[];
PString["Temp ctx: "L]; PUnsigned[ShortREAD[CPtr+CodetempcontextOffset]];
PNextUnsigned["start"L, ShortREAD[CPtr+CodetempstartOffset]];
PNextUnsigned["framesz"L, ShortREAD[CPtr+CodeframeszOffset]];
ShowList[ShortREAD[temp+TemppendTempListOffset], "Pending"L];
ShowList[ShortREAD[temp+TempheapListOffset], "Heap"L];
END;
GetVarName: PROCEDURE [s: STRING, sei: Symbols.ISEIndex] =
BEGIN OPEN StringDefs, Symbols;
ctxb: Table.Base = TableBase[ctxType];
seb: Table.Base = TableBase[seType];
ser: id SERecord;
ctr: CTXRecord;
addr: BitAddress;
ShortCopyREAD[to: @ser, from: @seb[sei], nwords: SIZE [id SERecord]];
ShortCopyREAD[to: @ctr, from: @ctxb[ser.idCtx], nwords: SIZE[CTXRecord]];
addr ← ser.idValue;
s.length ← 0;
GetFrameName[s, addr.wd, ctr.level,
CARDINAL[ser.idInfo+AltoDefs.wordlength-1]/AltoDefs.wordlength];
END;
GetFrameName: PUBLIC PROCEDURE [s: STRING,
wd: CARDINAL, level: Symbols.ContextLevel, wSize: CARDINAL] =
BEGIN OPEN StringDefs, Symbols;
curlvl: ContextLevel = CurContext[];
levadj: STRING ← [10];
SELECT level FROM
lZ => AppendString[s, "Field "L];
lG => AppendChar[s, 'G];
curlvl => AppendChar[s, 'L];
ENDCASE =>
BEGIN
AppendChar[s, 'L];
AppendString[levadj,"(up "L];
AppendDecimal[levadj, curlvl-level];
AppendChar[levadj,')];
END;
SELECT level FROM
lZ => NULL;
lG => IF wd IN OpCodeParams.GlobalLoadSlots THEN
wd ← wd - OpCodeParams.GlobalBase
ELSE AppendString[s, "B "L];
ENDCASE => IF wd IN OpCodeParams.LocalLoadSlots THEN
wd ← wd - OpCodeParams.LocalBase
ELSE AppendString[s, "B "L];
AppendDecimal[s, wd];
IF wSize > 1 THEN
BEGIN
AppendString[s, ".."L];
AppendDecimal[s, wd + wSize - 1];
END;
AppendString[s, levadj];
END;
TableBase: PUBLIC PROCEDURE [table: Table.Selector ← Table.chunkType]
RETURNS [Table.Base] =
BEGIN
base: DESCRIPTOR FOR ARRAY Table.Selector OF Table.Base;
IF al = NIL THEN
BEGIN
RESOut.Complain["Base of Allocator unknown"L];
ERROR cancelAction;
END;
ShortCopyREAD[to: @base, from: al+AllocatorbaseOffset, nwords:
SIZE[DESCRIPTOR FOR ARRAY Table.Selector OF Table.Base]];
RETURN [ShortREAD[@base[table]]];
END;
TableSize: PUBLIC PROCEDURE [table: Table.Selector ← Table.chunkType]
RETURNS [CARDINAL] =
BEGIN
top: DESCRIPTOR FOR ARRAY Table.Selector OF CARDINAL;
IF al = NIL THEN
BEGIN
RESOut.Complain["Base of Allocator unknown"L];
ERROR cancelAction;
END;
DebugUsefulDefs.ShortCopyREAD[to: @top, from: al+AllocatortopOffset, nwords:
SIZE[DESCRIPTOR FOR ARRAY Table.Selector OF CARDINAL]];
RETURN [ShortREAD[@top[table]]];
END;
-- following two procedures should be called from StringDefs
-- whenever CompareStrings gets fixed
UpperCase: PROCEDURE [c: CHARACTER] RETURNS [CHARACTER] =
BEGIN
IF c IN ['a..'z] THEN c ← c + ('A-'a);
RETURN[c]
END;
nMods: CARDINAL = 11;
LookForFrames: PROCEDURE =
BEGIN
moduleName: ARRAY [0..nMods) OF STRING ← [
"Allocator"L, "Code"L, "ComData"L, "Constructor"L, "Driver"L,
"Expression"L, "Final"L, "Flow"L, "StackImpl"L, "Statement"L, "Temp"L];
basePtr: ARRAY [0..nMods) OF POINTER ← [
@al, @CPtr, @MPtr, @constructor, @driver,
@expression, @final, @flow, @stack, @statement, @temp];
keyString: STRING = [40];
firstOut: BOOLEAN ← TRUE;
i, nFound: CARDINAL;
CheckOneFrame: PROCEDURE [han: ControlDefs.GlobalFrameHandle]
RETURNS [BOOLEAN] =
BEGIN
l, u, i: CARDINAL;
name: POINTER TO ARRAY [0..nMods) OF STRING = @moduleName;
base: POINTER TO ARRAY [0..nMods) OF POINTER = @basePtr;
key: STRING = keyString;
key.length ← 0;
DebugUsefulDefs.Name[name: key, gf: han];
l ← 0; u ← nMods-1;
WHILE l <= u DO
i ← (l+u)/2;
SELECT StringDefs.CompareStrings[key, name[i], FALSE] FROM
< 0 => u ← i-1;
> 0 => l ← i+1;
ENDCASE =>
BEGIN
IF base[i]↑ = NIL THEN
BEGIN base[i]↑ ← han; nFound ← nFound + 1 END
ELSE
BEGIN
IF firstOut THEN
BEGIN
firstOut ← FALSE;
RESOut.Complain["Duplicate: "L];
END
ELSE RESOut.Complain[", "L, FALSE];
RESOut.Complain[key, FALSE];
END;
EXIT
END;
ENDLOOP;
Process.Yield[];
RETURN[nFound = nMods];
END;
FOR i IN [0..nMods) DO basePtr[i]↑ ← NIL; ENDLOOP;
nFound ← 0;
[] ← DebugUsefulDefs.Enumerate[CheckOneFrame];
IF nFound # nMods THEN
BEGIN
IF ~firstOut THEN RESOut.Complain[", "L, FALSE];
RESOut.Complain["Missing: "L, ~firstOut];
firstOut ← TRUE;
FOR i IN [0..nMods) DO
IF basePtr[i]↑ = NIL THEN
BEGIN
IF firstOut THEN firstOut ← FALSE
ELSE RESOut.Complain[", "L, FALSE];
RESOut.Complain[moduleName[i], FALSE];
END;
ENDLOOP;
END;
CopyGlobalData[];
END;
FindFrames: PUBLIC PROCEDURE =
BEGIN
END;
CurContext: PUBLIC PROCEDURE RETURNS [Symbols.ContextLevel] =
BEGIN
IF CPtr = NIL THEN
BEGIN
RESOut.Complain["Base of Code unknown"L];
ERROR cancelAction;
END;
RETURN [ShortREAD[CPtr+CodecurctxlvlOffset]];
END;
CCCur: PUBLIC PROCEDURE RETURNS [CodeDefs.CCIndex] =
BEGIN
IF CPtr = NIL THEN
BEGIN
RESOut.Complain["Base of Code unknown"L];
ERROR cancelAction;
END;
RETURN [ShortREAD[CPtr+CodecodeptrOffset]];
END;
CCFirst: PUBLIC PROCEDURE RETURNS [CodeDefs.CCIndex] =
BEGIN
IF driver = NIL THEN
BEGIN
RESOut.Complain["Base of Driver unknown"L];
ERROR cancelAction;
END;
RETURN [ShortREAD[driver+DrivercodestartOffset]];
END;
LabelStack: PUBLIC PROCEDURE RETURNS [CodeDefs.LabelInfoIndex] =
BEGIN
IF flow = NIL THEN
BEGIN
RESOut.Complain["Base of Driver unknown"L];
ERROR cancelAction;
END;
RETURN [ShortREAD[flow+FlowlabelStackOffset]];
END;
PutCurrentBody: PUBLIC PROCEDURE =
BEGIN
IF MPtr = NIL THEN
BEGIN
RESOut.Complain["Base of ComData unknown"L];
ERROR cancelAction;
END;
PCr[];
PString["Current body bti = "L];
PUnsigned[ShortREAD[MPtr+ComDatabodyIndexOffset]];
END;
PutCurrentSource: PUBLIC PROCEDURE =
BEGIN
index: CARDINAL;
IF sourceName # NIL THEN Storage.FreeString[sourceName];
IF MPtr = NIL THEN
BEGIN
RESOut.Complain["Base of ComData unknown"L];
ERROR cancelAction;
END;
sourceName ← CopyUserString[ShortREAD[MPtr+ComDatasourceFileOffset]];
index ← ShortREAD[MPtr+ComDatatextIndexOffset];
PCr[];
PString["Current source: "L]; PString[sourceName];
PString[" ["L]; POctal[index]; PChar[']];
IF index # LAST[CARDINAL] THEN
BEGIN
PCr[];
PrintTextLine[sourceName, index];
END;
END;
sourceName: STRING ← NIL;
firstPrinted, lastPrinted: StreamDefs.StreamIndex ← [0,0];
PrintNextLine: PUBLIC PROCEDURE =
BEGIN OPEN StreamDefs, IODefs;
in: StreamHandle;
ch: CHARACTER;
IF sourceName = NIL THEN RETURN;
in ← NewByteStream[sourceName, Read ! SegmentDefs.FileNameError =>
GO TO bad];
SetIndex[in, lastPrinted];
IF in.endof[in] THEN RETURN;
ch ← in.get[in];
IF ch = ControlZ THEN
WHILE ~in.endof[in] AND in.get[in] # CR DO ENDLOOP;
IF in.endof[in] THEN RETURN;
PCr[];
firstPrinted ← lastPrinted ← GetIndex[in];
THROUGH [0..80] WHILE ~in.endof[in] DO
lastPrinted ← GetIndex[in];
SELECT (ch ← in.get[in]) FROM
CR, ControlZ => EXIT;
ENDCASE => PChar[ch];
ENDLOOP;
EXITS
bad =>
BEGIN
RESOut.Complain["Bad File Name"L];
ERROR cancelAction;
END;
END;
PrintPrevLine: PUBLIC PROCEDURE =
BEGIN OPEN StreamDefs, IODefs;
in: StreamHandle;
ch: CHARACTER;
again: BOOLEAN;
lineIndex: StreamIndex;
IF sourceName = NIL OR firstPrinted = [0,0] THEN RETURN;
in ← NewByteStream[sourceName, Read ! SegmentDefs.FileNameError =>
GO TO bad];
lineIndex ← lastPrinted ← firstPrinted ← ModifyIndex[firstPrinted, -1];
again ← TRUE;
WHILE again DO
again ← FALSE;
THROUGH [1..80] UNTIL lineIndex = [0, 0]
DO
lineIndex ← ModifyIndex[lineIndex, -1];
SetIndex[in, lineIndex];
SELECT in.get[in] FROM
CR => EXIT;
ControlZ => GO TO skipTrailer;
ENDCASE;
firstPrinted ← lineIndex;
REPEAT
skipTrailer =>
BEGIN
lastPrinted ← firstPrinted ← lineIndex;
again ← TRUE;
END;
ENDLOOP;
ENDLOOP;
PCr[];
SetIndex[in, firstPrinted];
DO
SELECT (ch ← in.get[in]) FROM
CR, ControlZ => EXIT;
ENDCASE => PChar[ch];
IF GetIndex[in] = lastPrinted THEN EXIT;
ENDLOOP;
EXITS
bad =>
BEGIN
RESOut.Complain["Bad File Name"L];
ERROR cancelAction;
END;
END;
PrintTextLine: PROCEDURE [source: STRING, i: CARDINAL] =
BEGIN OPEN StreamDefs, IODefs;
in: StreamHandle;
start, lineIndex, mark: StreamIndex;
char: CHARACTER;
n: [1..100];
in ← NewByteStream[source, Read ! SegmentDefs.FileNameError =>
GO TO bad];
start ← lineIndex ← mark ← NormalizeIndex[[page:0, byte:i]];
FOR n IN [1..40] UNTIL lineIndex = [0, 0]
DO
lineIndex ← ModifyIndex[lineIndex, -1];
SetIndex[in, lineIndex];
IF in.get[in] = CR THEN EXIT;
start ← lineIndex;
ENDLOOP;
firstPrinted ← lastPrinted ← start;
SetIndex[in, start];
FOR n IN [1..80] WHILE ~in.endof[in]
DO
IF GetIndex[in] = mark THEN PString["<>"L];
lastPrinted ← GetIndex[in];
SELECT (char ← in.get[in]) FROM
CR, ControlZ => EXIT;
ENDCASE => PChar[char];
ENDLOOP;
in.destroy[in];
EXITS
bad =>
BEGIN
RESOut.Complain["Bad File Name"L];
ERROR cancelAction;
END;
END;
CopyUserString: PRIVATE PROCEDURE [us: STRING] RETURNS [s: STRING] =
BEGIN
sb: StringBody;
IF us = NIL THEN GO TO bad;
ShortCopyREAD[to: @sb, from: us, nwords: SIZE[StringBody]];
IF sb.length > 40 THEN GO TO bad;
s ← Storage.String[sb.length];
ShortCopyREAD[to: @s.text, from: @us.text, nwords: (sb.length+1)/2];
s.length ← sb.length;
EXITS
bad =>
BEGIN
RESOut.Complain["Bad String"L];
ERROR cancelAction;
END;
END;
PutCurrentStmt: PUBLIC PROCEDURE =
BEGIN
IF statement = NIL THEN
BEGIN
RESOut.Complain["Base of Statement unknown"L];
ERROR cancelAction;
END;
PCr[];
PString["Current stmt tree = "L];
PUnsigned[ShortREAD[statement+StatementrecentStmtOffset]];
END;
PutCurrentExpr: PUBLIC PROCEDURE =
BEGIN
IF expression = NIL THEN
BEGIN
RESOut.Complain["Base of Expression unknown"L];
ERROR cancelAction;
END;
PCr[];
PString["Current expr tree = "L];
PUnsigned[ShortREAD[expression+ExpressionrecentExpOffset]];
END;
CopyGlobalData: PROCEDURE =
BEGIN
info: CodeDefs.CCInfoType ← generating;
IF final # NIL THEN info ← ShortREAD[final+FinalccInfoOffset];
CGenDebugDefs.ccInfo ← IF info IN CodeDefs.CCInfoType THEN info
ELSE generating;
IF constructor # NIL THEN
BEGIN
ShortCopyREAD[to: @CGenDebugDefs.cd,
from: constructor+ConstructorcdOffset,
nwords: SIZE[CodeDefs.ConsDestination]];
UpdateConstDest[];
END;
END;
LookupTheFrames: UserInput.PeriodicProcType =
BEGIN
periodic ← UserInput.CancelPeriodicNotify[periodic];
Process.Detach[FORK LookForFrames[]];
END;
periodic: UserInput.PeriodicNotifyHandle ←
UserInput.CreatePeriodicNotify[LookupTheFrames, DebugUsefulDefs.window, 1];
Notify: Event.Notifier =
BEGIN
SELECT why FROM
newSession => IF periodic = NIL THEN
periodic ← UserInput.CreatePeriodicNotify[LookupTheFrames, DebugUsefulDefs.window, 1];
resumeSession => CopyGlobalData[];
ENDCASE;
SELECT why FROM
newSession, resumeSession =>
BEGIN
firstPrinted ← lastPrinted ← [0,0];
IF sourceName # NIL THEN Storage.FreeString[sourceName];
sourceName ← NIL;
END;
ENDCASE;
END;
notifierItem: Event.Item ← [
eventMask: Event.Masks[newSession] + Event.Masks[resumeSession],
eventProc: Notify];
Event.AddNotifier[@notifierItem];
END.