DIRECTORY Commander, CommanderOps, Atom, Rope, Convert, Basics, List, RefPrint, SafeStorage, IO, CardTab, ProcessProps; RefPrintImpl: CEDAR MONITOR IMPORTS Commander, CommanderOps, Atom, Rope, Convert, List, SafeStorage, IO, CardTab, ProcessProps EXPORTS RefPrint ~ BEGIN ROPE: TYPE ~ Rope.ROPE; 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" }; headerUnits: CARD = 8; 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]; 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] }; 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 = { 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 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"]; END. *RefPrintImpl.mesa Copyright Σ 1988, 1990, 1991 by Xerox Corporation. All rights reserved. Michael Plass, June 11, 1991 0:09 am PDT last: POINTER TO WORD _ p + ((nBytes-headerUnits-1)/BYTES[WORD])*UNITS[WORD]; IO.PutF[stream, "(nBytes=%g pointerFree=%g hdrPointer=%08xH\n)", [integer[nBytes]], [integer[ORD[pointerFree]]], [cardinal[hdrPointer]]]; [key: CardTab.Key, val: CardTab.Val] RETURNS [quit: BOOL _ FALSE] IF NOT DesparatePrintReferent[cmd.out, addr] THEN IO.PutF[cmd.out, "Not a REF: %g (0%08xH) \n", [cardinal[addr]], [cardinal[addr]]]; Κ ο–(cedarcode) style•NewlineDelimiter ˜codešœ™Kšœ Οeœ=™HK™(K™—šΟk œTžœ˜wK˜—K˜KšΠln œžœž˜KšžœBžœ˜bKšžœ ˜šœž˜K˜šžœžœžœ˜K˜—K˜)šœ žœžœžœ˜/K˜—K˜šΟnœžœžœ žœžœžœžœ žœžœžœžœžœž œžœžœ˜Kšœ ˜ Kšœ˜K˜—šœ žœ˜K˜—š œžœ žœžœ žœžœžœžœ˜[Kšœžœ˜Kšœ žœžœ˜Kšœ žœ,˜<šžœžœ%žœ˜@Kšœžœžœ ˜Kšœžœžœ ˜(Kš œžœžœžœžœžœ™MKšœC˜CK•StartOfExpansion&[x: CardTab.Ref, key: CardTab.Key]šœ žœžœ˜Kšœ˜Kš žœ#žœžœ žœžœ˜\šžœ ž˜Kšžœ žœžœžœ˜7Kšœ#˜#Kšœžœžœ˜Kšœžœžœ˜Kšžœ˜—Kšžœ˜Kšžœžœ˜ Kšœ˜—Kšžœ[žœ)™‰Kšžœžœ˜Kšœ˜K˜—š  œžœ žœžœ žœ žœžœ˜KKšœžœ˜Kšœ žœžœ˜Kš œ žœžœ žœžœ'˜Pšžœžœ!˜6Kšžœžœ ˜/Kšžœžœ+˜4—Kšœ˜K˜—š  œžœžœ žœžœžœžœžœžœ˜VKšœC˜CK–&[x: CardTab.Ref, key: CardTab.Key]šœ žœžœ˜Kšœ žœžœ/˜Zšžœ ž˜šžœ˜š žœžœžœ.žœžœž˜RKšžœžœžœžœ˜.Kšžœ˜—Kšžœžœ žœ ˜AKšœ˜—Kšžœžœ˜"—Kšœ˜K˜—Kšœžœ˜Kšœžœžœ˜/šœžœžœ˜#Kšœ˜Kšœ ž˜Kšœ˜—š œžœžœ žœžœžœžœžœžœ˜Qšžœž˜ Kšžœžœ˜"šžœ˜Kšœžœ˜Kšœžœ˜š œžœ˜Kšžœ3žœ˜Sšžœžœžœ ˜MKšžœ˜šžœ˜Kšœ,˜,Kšžœ˜Kšœ"žœ˜8Kšœ ˜ Kšœ,˜,Kšœ˜——Kšœ˜—šžœ(žœž˜7Kšœ*˜*Kšœžœ3˜=Kšžœ*˜1—šžœ ž˜šžœ˜Kšœ žœK˜XKšœBžœ ˜OKšœ˜—Kšžœ ˜—Kšœ˜——Kšœ˜K˜—š œžœž œ=˜XK–&[x: CardTab.Ref, key: CardTab.Key]šœ žœžœ˜K–:[x: CardTab.Ref, key: CardTab.Key, val: CardTab.Val]šœ3žœ"˜XKšœ˜K˜—š œžœž œ%˜HK–&[x: CardTab.Ref, key: CardTab.Key]šœ žœ˜%Kšœ˜K˜—š  œžœž œ%˜B–E -- [key: CardTab.Key, val: CardTab.Val] RETURNS [quit: BOOL _ FALSE]š œ˜$Kšœ%žœžœžœ™AKšœ žœžœ˜4K–&[x: CardTab.Ref, key: CardTab.Key]šžœžœ,˜IK˜—Kšœ4˜4K–4[x: CardTab.Ref, action: CardTab.EachPairAction]˜2K˜K˜—š œžœžœ(žœžœžœžœžœ˜”šžœžœž˜Kšœžœžœžœ˜Kšœžœ)˜Gšžœ˜ KšœžœžœA˜NKš žœžœžœžœžœ˜BKšœ˜——K˜K˜—š  œ˜&Kšžœ*žœ ˜Kšœžœ"˜+Kšœ žœ˜š œžœ˜Kšœžœ˜'Kšœžœ˜ Kšžœžœ'žœžœP™„Kšœ˜—šžœžœžœ˜&KšœB˜BKšœ%˜%Kšœ˜—Kšžœ#˜%šžœ˜šžœ˜KšœžœH˜fKšœBžœ ˜OKšœ˜—Kšžœ ˜—Kšžœ%˜'Kšœ˜K˜—Kšœ@˜@KšœN˜Nšœ˜K˜—Kšœp˜pK˜—K˜Kšžœ˜—…—τ(