DIRECTORY
Alloc USING [BaseSeq],
AllocImpl: FROM "InternalAllocImpl" USING [InstanceData, SizeSeq],
AMBridge USING [GFHFromTV],
AMModel USING [Context, MostRecentNamedContext, RootContext],
AMModelBridge USING [FrameFromContext],
AMTypes USING [TV],
CDebugDefs USING [Handle],
Code USING [
codeptr, curctxlvl, framesz, stking, tempcontext, tempstart],
CodeDefs USING [
CCIndex, codeType, LabelInfoIndex, StackIndex, 
StackItem, StackNull],
ComData USING [bodyIndex, source, table, textIndex],
Expression USING [recentExp],
FileParms USING [ActualId],
Flow USING [labelStack],
IO USING [PutChar, PutF, PutRope, RopeFromROS, ROS, STREAM],
LogPack USING [map],
OpCodeParams USING [GlobalBase, GlobalLoadSlots, LocalBase, LocalLoadSlots],
PrincOpsUtils USING [LongCopy],
RESOut USING [
Complain, PChar, PCr, PDecimal, PLongNumber, PNext, PNextUnsigned, PRope, PUnsigned],
Rope USING [ROPE],
Selection,
StackImpl USING [stkHead, stkPtr],
Statement USING [recentStmt],
STDebugDefs USING [Handle],
Symbols USING [
BitAddress, ContextLevel, CTXRecord, ctxType, ISEIndex, ISENull, lG, lZ, 
SERecord, seType],
Table USING [Base, chunkType, Selector],
Tree USING [Link],
VarTemp USING [heapList, pendTempList],
WorldVM USING [LocalWorld];

CDebugGlobals: PROGRAM 
IMPORTS AMBridge, AMModel, AMModelBridge, IO, PrincOpsUtils, RESOut, WorldVM
EXPORTS CDebugDefs, STDebugDefs 
SHARES AllocImpl, Flow, LogPack, StackImpl, VarTemp =
BEGIN OPEN CodeDefs, RESOut, CDebugDefs;

Handle: TYPE = CDebugDefs.Handle;
ROPE: TYPE = Rope.ROPE;

wordlength: CARDINAL = 16;
basesValid: BOOLEAN _ FALSE;
CPtr: POINTER TO FRAME [Code] _ NIL;
expression: POINTER TO FRAME [Expression] _ NIL;
flow: POINTER TO FRAME [Flow] _ NIL;
MPtr: POINTER TO FRAME [ComData] _ NIL;
logPack: POINTER TO FRAME [LogPack] _ NIL;
stack: POINTER TO FRAME [StackImpl] _ NIL;
statement: POINTER TO FRAME [Statement] _ NIL;
temp: POINTER TO FRAME [VarTemp] _ NIL;
AllocTypes: POINTER TO FRAME [AllocImpl] _ NIL;

CheckFrame: PROC[h: Handle, atP: POINTER TO POINTER, mod: ROPE] =
BEGIN
wc, cc, mc: AMModel.Context;
tx: AMTypes.TV;
IF atP^ # NIL THEN RETURN;
wc _ AMModel.RootContext[WorldVM.LocalWorld[]];
cc _ AMModel.MostRecentNamedContext["CompilerServer", wc];
IF cc = NIL THEN GO TO notFound;
mc _ AMModel.MostRecentNamedContext[mod, cc];
IF mc = NIL THEN GO TO notFound;
tx _ AMModelBridge.FrameFromContext[mc];
atP^ _ AMBridge.GFHFromTV[tx];
EXITS
notFound => {
RESOut.Complain[h: h, msg: "Base of ", abort: FALSE, clear: TRUE];
RESOut.Complain[h: h, msg: mod, abort: FALSE, clear: FALSE];
RESOut.Complain[h: h, msg: " unknown", abort: TRUE, clear: FALSE]};
END;

StackBottom: PUBLIC PROCEDURE [h: Handle] RETURNS [StackIndex] =
BEGIN OPEN CodeDefs;
sHead: StackIndex;
sir: StackItem;
cb: Table.Base =  TableBase[h, CodeDefs.codeType];
CheckFrame[h, @stack, "StackImpl"];
sHead _ CDRead[h, @stack.stkHead];
IF sHead = StackNull THEN RETURN [StackNull];
CDCopyRead[h: h,  to: @sir, from: @cb[sHead], nwords: SIZE[StackItem]];
RETURN [sir.uplink];
END;

StackState: PUBLIC PROCEDURE [h: Handle] RETURNS [BOOLEAN] =
BEGIN
CheckFrame[h, @CPtr, "Code"];
RETURN [CDRead[h, @CPtr.stking]];
END;

StackTop: PUBLIC PROCEDURE [h: Handle] RETURNS [StackIndex] =
BEGIN OPEN CodeDefs;
CheckFrame[h, @stack, "StackImpl"];
RETURN [CDRead[h, @stack.stkPtr]];
END;

PutTempState: PUBLIC PROCEDURE [h: Handle] =
BEGIN OPEN Symbols;
seb: Table.Base =  TableBase[h, seType];
ser: id SERecord;

ShowList: PROCEDURE [sei: ISEIndex, heading: ROPE] =
BEGIN
name: ROPE;
first: BOOLEAN _ TRUE;
IF sei = ISENull THEN RETURN;
PCr[h]; PRope[h, "    "];
PRope[h, heading]; PRope[h, ": {"];
WHILE sei # ISENull DO
CDCopyRead[h: h,  to: @ser, from: @seb[sei], nwords: SIZE[id SERecord]];
name _ GetVarName[h, sei];
IF first THEN PRope[h, name] ELSE PNext[h, name,,6];
first _ FALSE;
WITH ser SELECT FROM
linked => sei _ link;
ENDCASE => sei _ ISENull;
ENDLOOP;
PChar[h, '}];
END;

CheckFrame[h, @temp, "VarTemp"];
CheckFrame[h, @CPtr, "Code"];
PCr[h];
PRope[h, "Temp ctx: "]; PUnsigned[h, CDRead[h, @CPtr.tempcontext]];
PNextUnsigned[h, "start", CDRead[h, @CPtr.tempstart]];
PNextUnsigned[h, "framesz", CDRead[h, @CPtr.framesz]];
ShowList[CDRead[h, @temp.pendTempList], "Pending"];
ShowList[CDRead[h, @temp.heapList], "Heap"];
END;

GetVarName: PROCEDURE [h: Handle, sei: Symbols.ISEIndex] RETURNS [ROPE] =
BEGIN OPEN Symbols;
ros: IO.STREAM _ IO.ROS[];
ctxb: Table.Base =  TableBase[h, ctxType];
seb: Table.Base =  TableBase[h, seType];
ser: id SERecord;
ctr: CTXRecord;
addr: BitAddress;

CDCopyRead[h: h,  to: @ser, from: @seb[sei], nwords: SIZE [id SERecord]];
CDCopyRead[h: h,  to: @ctr, from: @ctxb[ser.idCtx], nwords: SIZE[CTXRecord]];

addr _ ser.idValue;
GetFrameName[h, ros, addr.wd, 8*ctr.levelOrigin + ctr.levelOffset, CARDINAL[ser.idInfo+wordlength-1]/wordlength];
RETURN [ros.RopeFromROS[]];
END;

GetFrameName: PUBLIC PROCEDURE [h: Handle, s: IO.STREAM, wd: CARDINAL, level: Symbols.ContextLevel, wSize: CARDINAL] =
BEGIN OPEN Symbols;
curlvl: ContextLevel = CurContext[h];
levadj: IO.STREAM _ IO.ROS[];

SELECT level FROM
lZ => s.PutRope["Field "];
lG => s.PutChar['G];
curlvl => s.PutChar['L];
ENDCASE =>
BEGIN
s.PutChar['L];
levadj.PutF[" (up %d)", [integer[curlvl-level]]];
END;
SELECT level FROM
lZ => NULL;
lG => IF wd IN OpCodeParams.GlobalLoadSlots THEN 
wd _ wd - OpCodeParams.GlobalBase
ELSE s.PutRope["B "]; 
ENDCASE => IF wd IN OpCodeParams.LocalLoadSlots THEN 
wd _ wd - OpCodeParams.LocalBase
ELSE s.PutRope["B "]; 
s.PutF["%d", [cardinal[wd]]];
IF wSize > 1 THEN 
s.PutF["..%d", [cardinal[wd + wSize - 1]]];
s.PutRope[levadj.RopeFromROS[]];
END;

TableBase: PUBLIC PROCEDURE [h: STDebugDefs.Handle, table: Table.Selector _ Table.chunkType]
RETURNS [b: Table.Base] =
BEGIN
ah: LONG POINTER TO AllocTypes.InstanceData;
bs: LONG POINTER TO Alloc.BaseSeq;

CheckFrame[NARROW[h], @MPtr, "ComData"];
STCopyRead[h: h, to: @ah, from: @MPtr.table, nwords: SIZE[LONG POINTER]];
STCopyRead[h: h,  to: @bs, from: @ah.bases, nwords: SIZE[LONG POINTER]];
STCopyRead[h: h,  to: @b, from: @bs[table], nwords: SIZE[Table.Base]];
RETURN
END;

TableSize: PUBLIC PROCEDURE [h: STDebugDefs.Handle, table: Table.Selector _ Table.chunkType]
RETURNS [CARDINAL] =
BEGIN
ah: LONG POINTER TO AllocTypes.InstanceData;
ts: LONG POINTER TO AllocTypes.SizeSeq;

CheckFrame[NARROW[h], @MPtr, "ComData"];
STCopyRead[h: h, to: @ah, from: @MPtr.table, nwords: SIZE[LONG POINTER]];
STCopyRead[h: h,  to: @ts, from: @ah.top, nwords: SIZE[LONG POINTER]];
RETURN [STRead[h, @ts[table]]];
END;

STRead: PUBLIC PROCEDURE [h: STDebugDefs.Handle, addr: LONG POINTER] RETURNS [UNSPECIFIED] =
BEGIN
RETURN [addr^];
END;

CDRead: PUBLIC PROCEDURE [h: Handle, addr: LONG POINTER] RETURNS [UNSPECIFIED] =
BEGIN
RETURN [addr^];
END;

STCopyRead: PUBLIC PROCEDURE [h: STDebugDefs.Handle, from: LONG POINTER, nwords: CARDINAL, to: LONG POINTER] =
BEGIN
PrincOpsUtils.LongCopy[from: from, nwords: nwords, to: to];
END;

CDCopyRead: PUBLIC PROCEDURE [h: Handle, from: LONG POINTER, nwords: CARDINAL, to: LONG POINTER] =
BEGIN
PrincOpsUtils.LongCopy[from: from, nwords: nwords, to: to];
END;

CurContext: PUBLIC PROCEDURE [h: Handle] RETURNS [Symbols.ContextLevel] =
BEGIN
CheckFrame[h, @CPtr, "Code"];
RETURN [CDRead[h, @CPtr.curctxlvl]];
END;

CCCur: PUBLIC PROCEDURE [h: Handle] RETURNS [CodeDefs.CCIndex] =
BEGIN
CheckFrame[h, @CPtr, "Code"];
RETURN [CDRead[h, @CPtr.codeptr]];
END;

LabelStack: PUBLIC PROCEDURE [h: Handle] RETURNS [CodeDefs.LabelInfoIndex] =
BEGIN
CheckFrame[h, @flow, "Flow"];
RETURN [CDRead[h, @flow.labelStack]];
END;

PutCurrentBody: PUBLIC PROCEDURE [h: Handle] =
BEGIN
CheckFrame[h, @MPtr, "ComData"];
PCr[h];
PRope[h, "Current body bti = "];
PUnsigned[h, CDRead[h, @MPtr.bodyIndex]]; 
END;

StmtMapVal: PUBLIC PROC[h: Handle, loc: CARDINAL] RETURNS[index: INT] = {
IF loc <= NAT.LAST THEN index _ loc
ELSE {
chunkSize: NAT = 256;
maxChunks: NAT = NAT.LAST/chunkSize + 1;
IndexChunk: TYPE = ARRAY [0..chunkSize) OF INT;
ChunkMap: TYPE = ARRAY [0..maxChunks) OF LONG POINTER TO IndexChunk;
map: LONG POINTER TO ChunkMap;
ch: LONG POINTER TO IndexChunk;
d: NAT = loc - CARDINAL[NAT.LAST+1];
CheckFrame[h, @logPack, "LogPack"];
CDCopyRead[h: h, to: map, from: @logPack.map, nwords: SIZE[LONG POINTER]];
CDCopyRead[h: h, to: @ch, from: @map[d/chunkSize], nwords: SIZE[LONG POINTER]];
CDCopyRead[h: h, to: @index, from: @ch[d MOD chunkSize], nwords: SIZE[INT]]};
RETURN};

PutCurrentSource: PUBLIC PROCEDURE [h: Handle] =
BEGIN
index: CARDINAL;
us: FileParms.ActualId;
BEGIN
CheckFrame[h, @MPtr, "ComData"];
CDCopyRead[h: h, to: @us, from: @MPtr.source, nwords: SIZE[FileParms.ActualId]];
index _ CDRead[h, @MPtr.textIndex];
PCr[h];
PRope[h, "Current source: "]; PutUserRope[h, us.locator];
PRope[h, " ["]; PLongNumber[h, StmtMapVal[h, index], []]; PChar[h, ']];
END;
END;

PutUserRope: PRIVATE PROCEDURE [h: Handle, r: ROPE] =
BEGIN
PRope[h, r];
END;

PutCurrentStmt: PUBLIC PROCEDURE [h: Handle] =
BEGIN 
st: Tree.Link;
CheckFrame[h, @statement, "Statement"];
PCr[h];
PRope[h, "Current stmt tree = "];
CDCopyRead[h: h, from: @statement.recentStmt, to: @st, nwords: SIZE[Tree.Link]]; 
PDecimalLink[h, st]; 
END;

PutCurrentExpr: PUBLIC PROCEDURE [h: Handle] =
BEGIN 
st: Tree.Link;
CheckFrame[h, @expression, "Expression"];
PCr[h];
PRope[h, "Current expr tree = "];
CDCopyRead[h: h, from: @expression.recentExp, to: @st, nwords: SIZE[Tree.Link]]; 
PDecimalLink[h, st]; 
END;

PDecimalLink: PROC [h: Handle, l: Tree.Link] = {
WITH l SELECT FROM
subtree => {PRope[h, "[subtree["]; PDecimal[h, LOOPHOLE[index]]};
hash => {PRope[h, "[hash["]; PDecimal[h, LOOPHOLE[index]]};
symbol => {PRope[h, "[symbol["]; PDecimal[h, LOOPHOLE[index]]};
literal => {PRope[h, "[literal["]; PDecimal[h, LOOPHOLE[index]]};
ENDCASE;
PRope[h, "]]"]};

END.


ΦCDebugGlobals.mesa  
Edited by Bruce, September 22, 1980  10:55 AM
Edited by Sweet,  1-Mar-83 16:10:05
Edited by Haynes,  8-Dec-82 19:18:33
Sweet February 11, 1986 10:47:43 am PST
Constructor USING [cd],
Final USING [ccInfo],
constructor: POINTER TO FRAME [Constructor] _ NIL;
final: POINTER TO FRAME [Final]  _ NIL;
CCFirst: PUBLIC PROCEDURE [h: Handle] RETURNS [CodeDefs.CCIndex] =
BEGIN
CheckFrame[h, @CPtr, "Code"];
RETURN [CDRead[h, @CPtr.codeStart]];
END;

Κ
(˜Icodeš
œ™Kš
œ-™-Kš
œ#™#š
œ$™$K™'—K˜š
Οk	˜	Kšœœ˜Kšœœœ˜BKšœ	œ
˜Kšœœ0˜=Kšœœ˜'Kšœœœ˜Kšœœ
˜šœœ˜K˜=—šœ	œ˜K˜/K˜—Kšœœ'˜4Kšœœ™Kšœœ
˜Kšœ
œ˜Kšœœ
™Kšœœ˜Kšœ
œ'œœ˜<Kšœœ˜Kšœ
œ:˜LKšœœ˜šœœ˜K˜U—Kšœœœ˜K˜
Kšœ
œ˜"Kšœ
œ˜Kšœœ
˜šœœ˜K˜IK˜—Kšœœ˜(Kšœœ˜Kšœœ˜'Kšœœ˜—K˜šœœ
˜Kšœ#œ ˜LKšœ˜ Kšœ/˜5Kšœ
œ˜(K˜Kšœœ˜!Kšœœœ
˜K˜Kšœœ˜Kšœœœ
˜Kš	œ
œ
œ
œœ
™2Kš	œœ
œ
œ
œ
˜$Kš	œœ
œ
œœ
˜0Kš	œœ
œ
œœ
™'Kš	œœ
œ
œ
œ
˜$Kš	œœ
œ
œ
œ
˜'Kš	œ	œ
œ
œ
œ
˜*Kš	œœ
œ
œœ
˜*Kš	œœ
œ
œœ
˜.Kš	œœ
œ
œ
œ
˜'Kš	œœ
œ
œœ
˜/K˜šΟn
œœœ
œ
œœ˜AKš
˜K˜Kšœœ
˜Kšœœ
œ
œ
˜Kš
œ/˜/Kš
œ:˜:Kš
œœ
œ
œ
œ
˜ Kš
œ-˜-Kš
œœ
œ
œ
œ
˜ Kš
œ(˜(Kš
œ˜š
˜˜
Kšœ.œ	œ˜BKšœ'œ	œ˜<Kšœ.œ	œ˜C——Kšœ
˜K˜—šžœœ
	œ
œ˜@Kšœ
œ
˜K˜K˜K˜2K˜#K˜"Kšœœ
œ
˜-Kšœ6œ
˜GKšœ˜Kšœ
˜K˜—š
ž
œœ
	œ
œœ˜<Kš
˜K˜Kšœ˜!Kšœ
˜K˜—šžœœ
	œ
œ˜=Kšœ
œ
˜K˜#Kšœ˜"Kšœ
˜K˜—šžœœ
	œ˜,Kšœ
œ	˜K˜(K˜K˜šžœ	œœ˜4Kš
˜Kšœœ
˜Kšœœœ
˜Kšœœ
œ
˜K˜K˜#šœ˜Kšœ5œ˜HK˜Kšœœœ˜4Kšœœ
˜šœœ
˜K˜Kšœ˜—Kšœ
˜—K˜
Kšœ
˜K˜—K˜ K˜K˜K˜CK˜6K˜6K˜3K˜,Kšœ
˜K˜—šž
œ	œ$œœ˜IKšœ
œ	˜Kš	œœ
œœ
œ˜K˜*K˜(K˜K˜K˜K˜Kšœ5œ˜IKšœ<œ
˜MK˜K˜KšœB	œ&˜qKšœ˜Kšœ
˜K˜—šžœœ
	œ	œœ&œ˜vKšœ
œ	˜K˜%Kš	œœ
œœ
œ˜K˜šœ˜K˜K˜K˜šœ˜
Kš
˜K˜K˜1Kšœ
˜——šœ˜Kšœœ
˜šœœœœ
˜1K˜!Kšœ˜—šœœœœ
˜5K˜ Kšœ˜——K˜šœœ
˜Kš
œ+˜+—K˜ Kšœ
˜K˜—šž	œœ
	œA˜\Kšœ˜Kš
˜Kšœœ
œ
œ˜,Kšœœ
œ
œ˜"K˜Kšœœ˜(Kšœ5œ
œ
œ˜IKšœ4œ
œ
œ˜HKšœ4œ˜FKš
˜Kšœ
˜K˜—šž	œœ
	œA˜\Kšœœ˜Kš
˜Kšœœ
œ
œ˜,Kšœœ
œ
œ˜'K˜Kšœœ˜(Kšœ5œ
œ
œ˜IKšœ2œ
œ
œ˜FKšœ˜Kšœ
˜K˜—šžœœ
	œœ
œœœ˜\Kš
˜Kšœ	˜Kšœ
˜K˜—šžœœ
	œœ
œœœ˜PKš
˜Kšœ	˜Kšœ
˜K˜—šž
œœ
	œœ
œ
œœ
œ˜nKš
˜K˜;Kšœ
˜K˜—šž
œœ
	œœ
œ
œœ
œ˜bKš
˜K˜;Kšœ
˜K˜—šž
œœ
	œ
œ˜IKš
˜K˜Kšœ˜$Kšœ
˜K˜—šžœœ
	œ
œ˜@Kš
˜K˜Kšœ˜"Kšœ
˜K˜—šžœœ
	œ
œ™BKš
™K™Kšœ™$Kšœ
™K™—šž
œœ
	œ
œ˜LKš
˜K˜Kšœ˜%Kšœ
˜K˜—šžœœ
	œ˜.Kš
˜K˜ K˜K˜ K˜*Kšœ
˜K˜—šž
œœ
œœœœ˜IKšœœ
œ
œ˜#šœ˜Kšœœ˜Kšœœœ
œ˜(Kš	œœœœ
œ
˜/Kš	œ
œœœ
œ˜DKšœœ
œ
œ
˜Kšœœ
œ
œ˜Kš	œœ	œ
œ
œ˜$K˜#Kšœ6œ
œ
œ˜JKšœ;œ
œ
œ˜OKšœ)œœ
œ˜M—Kšœ˜K˜—šžœœ
	œ˜0Kš
˜Kšœœ
˜Kš
œ˜Kš
˜K˜ Kšœ6œ˜PK˜#K˜Kš
œ9˜9Kš
œG˜GKšœ
˜Kšœ
˜K˜—šžœœ
	œœ˜5Kš
˜K˜Kšœ
˜K˜—šžœœ
	œ˜.Kšœ
˜K˜K˜'K˜K˜!Kšœ?œ˜QKš
œ˜Kšœ
˜K˜—šžœœ
	œ˜.Kšœ
˜K˜K˜)K˜K˜!Kšœ?œ˜QKš
œ˜Kšœ
˜K˜—šžœœ˜0šœœ
˜Kšœ/œ
˜AKšœ)œ
˜;Kšœ-œ
˜?Kšœ/œ
˜AKšœ
˜—K˜K˜—Kšœ
˜—K˜—…—&5