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],
Constructor USING [cd],
Expression USING [recentExp],
FileParms USING [ActualId],
Final USING [ccInfo],
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;
constructor: POINTER TO FRAME [Constructor] ← NIL;
CPtr: POINTER TO FRAME [Code] ← NIL;
expression: POINTER TO FRAME [Expression] ← NIL;
final: POINTER TO FRAME [Final] ← 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;
CCFirst: PUBLIC PROCEDURE [h: Handle] RETURNS [CodeDefs.CCIndex] =
BEGIN
CheckFrame[h, @CPtr, "Code"];
RETURN [CDRead[h, @CPtr.codeStart]];
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.