DIRECTORY Commander, CommanderOps, Atom, Rope, Convert, Basics, List, RefPrint, SafeStorage,
IO, CardTab, ProcessProps;
~
BEGIN
printers: CardTab.Ref ~ CardTab.Create[];
fallbacks:
LIST
OF RefPrint.PrintRefProc ¬
NIL;
RefTest:
UNSAFE
PROC [candidate:
WORD, szp:
POINTER
TO
INT, ptrfreep:
POINTER
TO
BOOLEAN]
RETURNS [hdrPointer:
WORD] ~
UNCHECKED
MACHINE
CODE {
"XR←PtrTest"
};
DesparatePrintReferent:
PROC [stream:
IO.
STREAM, maybeRef:
WORD]
RETURNS [
BOOL] ~
TRUSTED {
nBytes: INT ¬ 0;
pointerFree: BOOL ¬ FALSE;
hdrPointer: WORD ¬ RefTest[maybeRef, @nBytes, @pointerFree];
IF hdrPointer # 0
AND hdrPointer + headerUnits = maybeRef
THEN {
ref: REF ~ LOOPHOLE[maybeRef];
p: POINTER TO WORD ¬ LOOPHOLE[maybeRef];
last: POINTER TO WORD ← p + ((nBytes-headerUnits-1)/BYTES[WORD])*UNITS[WORD];
type: SafeStorage.Type ~ SafeStorage.GetCanonicalReferentType[ref];
ordType: CARD16 ~ ORD[type];
nBytes ¬ nBytes - headerUnits;
IO.PutF[stream, "TC%g%g[", [cardinal[ORD[type]]], [rope[IF pointerFree THEN "pf" ELSE ""]]];
WHILE nBytes > 0
DO
IF maybeRef # LOOPHOLE[p] THEN IO.PutRope[stream, " "];
PrintWord[stream, p, pointerFree];
p ¬ p + UNITS[WORD];
nBytes ¬ nBytes - BYTES[WORD];
ENDLOOP;
IO.PutRope[stream, "]"];
RETURN [TRUE]
};
IO.PutF[stream, "(nBytes=%g pointerFree=%g hdrPointer=%08xH\n)", [integer[nBytes]], [integer[ORD[pointerFree]]], [cardinal[hdrPointer]]];
RETURN [FALSE]
};
PrintWord:
PROC [stream:
IO.
STREAM, value:
WORD, refFree:
BOOL] ~
TRUSTED {
nBytes: INT ¬ 0;
pointerFree: BOOL ¬ FALSE;
hdrPointer: WORD ¬ IF refFree THEN 0 ELSE RefTest[value, @nBytes, @pointerFree];
IF hdrPointer # 0
AND hdrPointer + headerUnits = value
THEN { [] ¬ PrintREF[stream, LOOPHOLE[value]] }
ELSE { IO.PutF1[stream, "%08x", [cardinal[value]]] }
};
PrintReferent:
PUBLIC
PROC [stream:
IO.
STREAM, ref:
REF]
RETURNS [ok:
BOOL ¬
TRUE] ~ {
type: SafeStorage.Type ~ SafeStorage.GetCanonicalReferentType[ref];
ordType: CARD16 ~ ORD[type];
printer: REF RefPrint.PrintRefProc ~ NARROW[CardTab.Fetch[x: printers, key: ordType].val];
IF printer =
NIL
THEN {
FOR tail:
LIST
OF RefPrint.PrintRefProc ¬ fallbacks, tail.rest
UNTIL tail =
NIL
DO
IF tail.first[stream, ref] THEN RETURN [TRUE];
ENDLOOP;
TRUSTED { RETURN DesparatePrintReferent[stream, LOOPHOLE[ref]] };
}
ELSE RETURN printer[stream, ref];
};
defaultDepthLimit: INT ¬ 2;
RefPrintControl: TYPE ~ REF RefPrintControlRep;
RefPrintControlRep:
TYPE ~
RECORD [
seen: CardTab.Ref,
depthLimit: INT
];
PrintREF:
PUBLIC
PROC [stream:
IO.
STREAM, ref:
REF]
RETURNS [ok:
BOOL ¬
TRUE] ~ {
IF ref =
NIL
THEN { IO.PutRope[stream, "NIL"] }
ELSE {
newDepthLimit: INT ¬ -1;
control: RefPrintControl ¬ NIL;
Inner:
PROC ~ {
IO.PutF[stream, "(%l%08x%l)", [rope["b"]], [cardinal[LOOPHOLE[ref]]], [rope["B"]]];
IF control.depthLimit = 0
OR CardTab.Fetch[control.seen,
LOOPHOLE[ref]].found
THEN { }
ELSE {
control.depthLimit ¬ control.depthLimit - 1;
IO.PutRope[stream, "^="];
[] ¬ CardTab.Insert[control.seen, LOOPHOLE[ref], $TRUE];
ok ¬ PrintReferent[stream, ref];
control.depthLimit ¬ control.depthLimit + 1;
};
};
WITH ProcessProps.GetProp[$RefPrintControl]
SELECT
FROM
ctl: RefPrintControl => { control ¬ ctl };
rope: ROPE => { newDepthLimit ¬ Convert.CardFromRope[rope] };
ENDCASE => { newDepthLimit ¬ defaultDepthLimit };
IF control =
NIL
THEN {
control ¬ NEW[RefPrintControlRep ¬ [seen: CardTab.Create[], depthLimit: newDepthLimit]];
ProcessProps.AddPropList[List.PutAssoc[$RefPrintControl, control, NIL], Inner];
}
ELSE { Inner[] };
};
};
Register:
PUBLIC
ENTRY PROC [printer: RefPrint.PrintRefProc, type: SafeStorage.Type] ~ {
ordType: CARD16 ~ ORD[type];
[] ¬ CardTab.Store[x: printers, key: ordType, val: NEW[RefPrint.PrintRefProc ¬ printer]]
};
RegisterFallback:
PUBLIC
ENTRY PROC [printer: RefPrint.PrintRefProc] ~ {
fallbacks ¬ CONS[printer, fallbacks];
};
UnRegister:
PUBLIC
ENTRY PROC [printer: RefPrint.PrintRefProc] ~ {
EachPair: CardTab.EachPairAction = {
[key: CardTab.Key, val: CardTab.Val] RETURNS [quit: BOOL ← FALSE]
valPrinter: REF RefPrint.PrintRefProc ~ NARROW[val];
IF valPrinter = printer THEN [] ¬ CardTab.Delete[x: printers, key: key];
};
fallbacks ¬ UnRegisterFallbacks[printer, fallbacks];
[] ¬ CardTab.Pairs[x: printers, action: EachPair];
};
UnRegisterFallbacks:
INTERNAL
PROC [printer: RefPrint.PrintRefProc, list:
LIST
OF RefPrint.PrintRefProc]
RETURNS [
LIST
OF RefPrint.PrintRefProc] ~ {
SELECT
TRUE
FROM
list = NIL => RETURN [NIL];
list.first = printer => RETURN UnRegisterFallbacks[printer, list.rest];
ENDCASE => {
tail: LIST OF RefPrint.PrintRefProc ~ UnRegisterFallbacks[printer, list.rest];
RETURN [IF tail = list.rest THEN list ELSE CONS[list.first, tail]]
};
};
ATOMPrinter: RefPrint.PrintRefProc = {
IO.PutF1[stream, "$%g", [rope[Atom.GetPName[NARROW[ref]]]]];
};
REFLongNumberPrinter: RefPrint.PrintRefProc = {
refLongNumber: REF Basics.LongNumber ~ NARROW[ref];
IO.PutF1[stream, "[lc[%08xH]]", [cardinal[refLongNumber.lc]]];
};
PrintRopeLiteral:
PROC [stream:
IO.
STREAM, rope:
ROPE] ~ {
i: INT ¬ 0;
Action:
PROC [c:
CHAR]
RETURNS [quit:
BOOL ¬
FALSE] ~ {
IF i > 120 THEN {IO.PutRope[stream, "..."]; RETURN [TRUE]};
IF c = '" OR c='\\ THEN IO.PutChar[stream, '\\];
IO.PutChar[stream, c];
i ¬ i + 1;
};
IO.PutChar[stream, '"];
[] ¬ Rope.Map[base: rope, action: Action];
IO.PutChar[stream, '"];
};
ROPEPrinter: RefPrint.PrintRefProc ~ {
PrintRopeLiteral[stream, NARROW[ref]];
};
LORAPrinter: RefPrint.PrintRefProc ~ {
WITH ref
SELECT
FROM
lora:
LIST
OF
REF => {
IO.PutRope[self: stream, r: "LIST["];
FOR tail:
LIST
OF
REF ¬ lora, tail.rest
UNTIL tail =
NIL
DO
IF tail # lora THEN IO.PutRope[self: stream, r: ", "];
[] ¬ PrintREF[stream, tail.first];
ENDLOOP;
IO.PutRope[self: stream, r: "]"];
};
ENDCASE => RETURN [FALSE];
};
RefPrintCommand: Commander.CommandProc ~ {
ENABLE Convert.Error => CommanderOps.Failed[cmd.procData.doc];
arg: ROPE ¬ CommanderOps.NextArgument[cmd];
depthLimit: INT ¬ -1;
Inner:
PROC ~ {
addr: CARD ~ Convert.CardFromRope[arg];
PrintWord[cmd.out, addr, FALSE];
IF NOT DesparatePrintReferent[cmd.out, addr] THEN IO.PutF[cmd.out, "Not a REF: %g (0%08xH) \n", [cardinal[addr]], [cardinal[addr]]];
};
IF Rope.Equal[arg, "-d",
FALSE]
THEN {
depthLimit ¬ Convert.CardFromRope[CommanderOps.NextArgument[cmd]];
arg ¬ CommanderOps.NextArgument[cmd];
};
IO.PutF1[cmd.out, "%l", [rope["f"]]];
IF depthLimit >= 0
THEN {
control: RefPrintControl ¬ NEW[RefPrintControlRep ¬ [seen: CardTab.Create[], depthLimit: depthLimit]];
ProcessProps.AddPropList[List.PutAssoc[$RefPrintControl, control, NIL], Inner];
}
ELSE { Inner[] };
IO.PutF1[cmd.out, "%l\n", [rope["F"]]];
};
Register[ATOMPrinter, SafeStorage.GetCanonicalReferentType[$a]];
Register[ROPEPrinter, SafeStorage.GetCanonicalReferentType[Rope.Flatten[""]]];
RegisterFallback[LORAPrinter];
Commander.Register["RefPrint", RefPrintCommand, "args: [ -d depthLimit ] address\nPrint the referent of a REF"];