<> <> <> <> <> <> DIRECTORY AMBridge USING [ContextPC, FHFromTV, GetWorld, GFHFromTV, IsRemote, OctalRead, RemoteFHFromTV, RemoteGFHFromTV, SetTVFromLI, TVToCardinal, TVToCharacter, TVToLC, TVToLI, TVToReal, TVToWordSequence, WordSequence, TVForSignal, TVForPointerReferent], AMTypes USING [Apply, Argument, Class, Coerce, Copy, Domain, EnclosingBody, Error, First, GlobalParent, Globals, GroundStar, Index, IndexToName, IndexToTV, IndexToType, IsAtom, IsComputed, IsNil, IsOverlaid, IsRefAny, IsRope, Last, Length, Locals, NComponents, Next, Procedure,Range, Referent, Result, Signal, Tag, TVSize, TVToName, TVToType, TVType, TypeClass, UnderClass, UnderType, Variant, TV, Size], BackStop USING [Call], Convert USING [RopeFromChar], IO USING [Put, PutChar, PutF, PutF1, PutRope, STREAM], PrintTV USING [GetClassPrintProc, GetTVPrintProc, PrintType, TVPrintProc], Rope USING [Concat, Fetch, InlineLength, IsEmpty, Map, ROPE, Size], RuntimeError USING [SendMsgSignal, UNCAUGHT], SafeStorage USING [EquivalentTypes, nullType, Type], <> VM USING [AddressFault], WorldVM USING [Address, AddressFault, LocalWorld, Long, Read, World]; PrintTVImpl: CEDAR MONITOR IMPORTS AMBridge, AMTypes, BackStop, Convert, IO, PrintTV, Rope, RuntimeError, SafeStorage, VM, WorldVM EXPORTS PrintTV = BEGIN OPEN PrintTV, Rope, AMBridge, AMTypes, SafeStorage, WorldVM; <> <<>> CR: CHAR = '\n; STREAM: TYPE = IO.STREAM; needInit: BOOL _ TRUE; UnderBoolean: Type _ CODE[BOOL]; UnderString: Type _ CODE[STRING]; UnderLongString: Type _ CODE[LONG STRING]; UnderRefText: Type _ CODE[REF TEXT]; UnderPtrText: Type _ CODE[LONG POINTER TO TEXT]; Pair: TYPE = MACHINE DEPENDENT RECORD [lo, hi: CARDINAL]; <> <<>> EnsureInit: ENTRY PROC = { ENABLE UNWIND => NULL; IF needInit THEN { UnderBoolean _ UnderType[UnderBoolean]; UnderString _ UnderType[UnderString]; UnderLongString _ UnderType[UnderLongString]; UnderRefText _ UnderType[UnderRefText]; UnderPtrText _ UnderType[UnderPtrText]; needInit _ FALSE; }; }; Print: PUBLIC PROC [tv: TV, put: STREAM, depth: INT _ 4, width: INT _ 32, verbose: BOOL _ FALSE] = { PutWords: PROC [tv: TV, prefix: ROPE _ NIL, postfix: ROPE _ NIL] = TRUSTED { <> ENABLE {RuntimeError.UNCAUGHT => GOTO err}; size: INT _ 0; IF prefix # NIL AND prefix.Size[] > 0 THEN put.PutRope[prefix]; size _ TVSize[tv]; SELECT size FROM 0 => IO.PutRope[put, "[]"]; 1 => PrintOctal[put, TVToCardinal[tv]]; 2 => PrintOctal[put, TVToLC[tv]]; ENDCASE => { sep: ROPE _ NIL; IO.PutChar[put, '[]; FOR i: INT IN [0..size) DO IF i > width THEN {IO.PutRope[put, ", ..."]; EXIT}; put.PutRope[sep]; sep _ ", "; PrintOctal[put, LOOPHOLE[AMBridge.OctalRead[tv, i], CARDINAL]] ENDLOOP; IO.PutChar[put, ']]; }; IF postfix # NIL AND postfix.Size[] > 0 THEN IO.PutRope[put, postfix] EXITS err => PutErr["??"] }; PutEscape: PROC [c: CHAR] RETURNS [quit: BOOL _ FALSE] = { IO.PutRope[put, Convert.RopeFromChar[c, FALSE]]; }; PutRopeConst: PROC [r: ROPE, max: INT] = { size: INT _ r.Size[]; max _ max + 16; -- allow for a reasonable minimum length IO.PutChar[put, '\"]; [] _ Rope.Map[base: r, start: 0, len: max, action: PutEscape]; IF size > max THEN IO.PutRope[put, "..."]; IO.PutChar[put, '"] }; QPutName: PROC [name: ROPE] = { IF name.Size[] = 0 THEN IO.PutRope[put, "??"] ELSE IO.PutRope[put, name] }; PutStringConst: PROC [s: LONG STRING] = TRUSTED { len: CARDINAL _ s.length; charsToPrint: CARDINAL _ len; max: CARDINAL _ width * depth; IF max < charsToPrint THEN charsToPrint _ max; IF max < 8 THEN max _ max + 16; IO.PutChar[put, '"]; FOR i: CARDINAL IN [0..charsToPrint) DO [] _ PutEscape[s[i]]; ENDLOOP; IF len > charsToPrint THEN IO.PutRope[put, "..."]; IO.PutChar[put, '"]; }; PutErr: PROC [r1,r2: ROPE _ NIL] = { IO.PutF[put, "--{%g%g}--", [rope[r1]], [rope[r2]] ]; }; PutRecord: PROC [tv: TV, start: NAT _ 0, depth: INT _ 0] = { size: Index; sep: ROPE _ NIL; type: Type; innerSize: PROC = {type _ TVType[tv]; size _ NComponents[type]}; IF depth <= 1 THEN {IO.PutRope[put, "[...]"]; RETURN}; sep _ BackStop.Call[innerSize]; IF sep # NIL THEN {PutErr["can't examine, ", sep]; RETURN}; IO.PutChar[put, '[]; <> <<{ ENABLE UNWIND => StructuredStreams.End[put];>> FOR i: Index IN [start..size] DO name: ROPE; inner: TV _ NIL; quitFlag: BOOL _ FALSE; innerIndexToTV: PROC = {inner _ IndexToTV[tv, i]}; innerPut: PROC = { itype: Type _ TVType[inner]; iunder: Type; iclass: Class; [iunder, iclass] _ UnderTypeAndClass[itype]; IF i = size AND iclass = union THEN { variantTV: TV; IF IsOverlaid[iunder] THEN {IO.PutRope[put, "--Overlaid--"]; RETURN}; IF IsComputed[iunder] THEN {IO.PutRope[put, "--Computed--"]; RETURN}; variantTV _ Variant[inner]; QPutName[TVToName[Tag[inner]]]; PutRecord[variantTV, i, depth - 1]; RETURN}; PutTV[inner, depth - 1]; }; msg: ROPE _ NIL; IF i > start THEN { IO.PutRope[put, ", "]; <> }; IF i > width THEN {IO.PutRope[put, "..."]; EXIT}; name _ IndexToName[type, i]; PrintName[put, name]; msg _ BackStop.Call[innerIndexToTV]; IF msg # NIL THEN {PutErr["Can't get element: ", msg]; LOOP}; msg _ BackStop.Call[innerPut]; IF msg # NIL THEN {PutErr["Can't print element: ", msg]; LOOP}; ENDLOOP; <<}; -- end ENABLE UNWIND => StructuredStreams.End[put];>> <> IO.PutChar[put, ']] }; PutTVAsType: PROC [tv: TV] = TRUSTED { type: Type _ TVToType[tv]; PrintTV.PrintType[type, put]; }; PutTypeOfTV: PROC [tv: TV, class: Class] = { inner: PROC = { SELECT class FROM globalFrame => IO.PutRope[put, "--GlobalFrame--"]; localFrame => IO.PutRope[put, "--LocalFrame--"] ENDCASE => { type: Type _ TVType[tv]; PrintTV.PrintType[type, put]; }; }; PrintBraces[put, BackStop.Call[inner]]; }; PutTV: PROC [tv: TV, depth: INT, verbose: BOOL _ FALSE] = TRUSTED { deep: BOOL _ TRUE; msg1, msg2: ROPE _ NIL; IF tv = NIL THEN {IO.PutRope[put, "NIL"]; RETURN}; IF depth <= 0 THEN {IO.PutRope[put, "&"]; RETURN}; <> IF NOT HandledByPrintProc[tv: tv, type: TVType[tv], depth: depth] THEN { inner: PROC = TRUSTED { PutTVNoCatch[tv, depth, verbose]; }; PrintBraces[put, BackStop.Call[inner]]; }; }; HandledByPrintProc: PROC [tv: TV, type: Type, depth: INT] RETURNS[handled: BOOL _ FALSE] = TRUSTED { proc: TVPrintProc; data: REF; [proc, data] _ GetTVPrintProc[type]; IF proc # NIL AND NOT proc[tv, data, put, depth, width, verbose] THEN RETURN [TRUE]; [proc, data] _ GetClassPrintProc[UnderClass[type]]; IF proc # NIL THEN handled _ NOT proc[tv, data, put, depth, width, verbose]; }; PutTVNoCatch: PROC [tv: TV, depth: INT, verbose: BOOL _ FALSE, type: Type _ nullType] = TRUSTED { fooey: BOOL _ FALSE; under: Type; class: Class; isRemote: BOOL _ AMBridge.IsRemote[tv]; putList: PROC [node: TV] = CHECKED { <> sep: ROPE _ NIL; count: INT _ 0; IO.PutRope[put, "LIST["]; <> <<{ ENABLE UNWIND => StructuredStreams.End[put];>> WHILE node # NIL DO elem: TV _ IndexToTV[node, 2]; IF node = NIL THEN EXIT; IO.PutRope[put, sep]; sep _ ", "; <> IF (count _ count + 1) > width THEN {IO.PutRope[put, "..."]; EXIT}; PutTV[IndexToTV[node, 1], depth]; node _ Referent[IndexToTV[node, 2]]; ENDLOOP; <<}; -- end ENABLE UNWIND => StructuredStreams.End[put];>> <> IO.PutChar[put, ']]; }; isAList: PROC [underType: Type] RETURNS [is: BOOL _ FALSE, listType: Type _ nullType] = CHECKED { IF TypeClass[underType] = structure AND NComponents[underType] = 2 THEN { ENABLE AMTypes.Error => GO TO nope; <> IF EquivalentTypes[ Range[listType _ IndexToType[underType, 2]], underType] THEN RETURN [TRUE, listType]; EXITS nope => {}; }; RETURN [FALSE]; }; IF type = nullType THEN type _ TVType[tv]; [under, class] _ UnderTypeAndClass[type]; SELECT class FROM definition => ERROR; record => PutRecord[tv, 1, depth]; structure => { IF isAList[under].is THEN {putList[tv]; RETURN}; PutRecord[tv, 1, depth]}; union => PutWords[tv, "UNION#"]; -- shouldn't really happen array, sequence => { indexType: Type _ AMTypes.Domain[type]; index: TV _ AMTypes.First[indexType]; max: INT _ LAST[INT]; IF AMTypes.UnderClass[indexType] = integer THEN { <> index _ AMTypes.Copy[index]; AMBridge.SetTVFromLI[index, 0]; }; IF class = sequence THEN <> max _ AMTypes.Length[tv] ELSE { <> low: INT _ AMBridge.TVToLI[index]; high: INT _ AMBridge.TVToLI[AMTypes.Last[indexType]]; max _ high-low+1; }; <> IO.PutF1[put, "(%g)[", [integer[max]] ]; <> IF depth <= 1 THEN {IO.PutRope[put, "...]"]; RETURN}; <> <<{ ENABLE UNWIND => StructuredStreams.End[put];>> <> FOR i: INT IN [0..width] WHILE index # NIL AND i < max DO ENABLE AMTypes.Error => GOTO urp; elem: TV _ NIL; msg: ROPE _ NIL; IF i > 0 THEN { IO.PutRope[put, ", "]; <> }; IF i = width THEN {IO.PutRope[put, "..."]; EXIT}; elem _ AMTypes.Apply[tv, index]; PutTV[elem, depth - 1]; index _ AMTypes.Next[index]; ENDLOOP; IO.PutChar[put, ']]; EXITS urp => {PutErr["Can't fetch element"]; IO.PutChar[put, ']]}; <<}; -- end ENABLE UNWIND => StructuredStreams.End[put];>> <> }; enumerated => { name: ROPE _ NIL; wrap: BOOL _ verbose AND under # UnderBoolean AND under # type; IF wrap THEN { PutTypeOfTV[tv, class]; IO.PutChar[put, '[]}; name _ TVToName[tv ! AMTypes.Error => CONTINUE]; IF name = NIL THEN PutWords[tv, NIL, "?"] ELSE QPutName[name]; IF wrap THEN IO.PutChar[put, ']]; }; subrange => { ground: Type = GroundStar[under]; wide: TV _ NIL; wide _ Coerce[tv, ground ! AMTypes.Error => CONTINUE]; IF wide = NIL THEN PutWords[tv, "??"] ELSE PutTV[wide, depth]; }; opaque => PutWords[tv, "OPAQUE#"]; countedZone => PutWords[tv, "ZONE#"]; uncountedZone => PutWords[tv, "UZONE#"]; list => { count: INT _ 0; valid: BOOL _ FALSE; IF IsNil[tv] THEN GO TO putNil; valid _ LocalValidate[tv, class]; IF depth <= 2 OR NOT valid THEN { IO.PutF1[put, IF valid THEN "%bB^" ELSE "%bB^??", [cardinal[TVToLC[tv]]]]; RETURN}; putList[Referent[tv]]; }; atom => { IF IsNil[tv] THEN GO TO putNil; IO.PutChar[put, '$]; IO.PutRope[put, TVToName[tv]]; }; rope => { IF IsNil[tv] THEN GO TO putNil; PutRopeConst[TVToName[tv], width * depth]; }; ref => { referentTV: TV _ NIL; referentType: Type; bits: LONG CARDINAL = TVToLC[tv]; msg: ROPE _ NIL; useReferent: BOOL _ depth > 2; inner: PROC = TRUSTED {referentTV _ Referent[tv]}; isList: BOOL; listType: Type; IF IsNil[tv] THEN GO TO putNil; IF NOT LocalValidate[tv] THEN {IO.PutF1[put, "%bB^??", [cardinal[bits]]]; RETURN}; IF AMTypes.IsRefAny[type] THEN { IF AMTypes.IsAtom[tv] THEN { IO.PutChar[put, '$]; IO.PutRope[put, TVToName[tv]]; RETURN}; IF AMTypes.IsRope[tv] THEN { PutRopeConst[TVToName[tv], width * depth]; RETURN}; }; IF useReferent THEN msg _ BackStop.Call[inner]; IF msg # NIL OR NOT useReferent THEN { <> IO.PutF1[put, "%bB^", [cardinal[bits]] ]; PrintBraces[put, msg]; RETURN}; referentType _ TVType[referentTV]; <> <> <> [isList, listType] _ isAList[underType: referentType]; IF isList THEN { IF NOT HandledByPrintProc[tv: tv, type: listType, depth: depth] THEN putList[referentTV]; RETURN}; IO.PutChar[put, '^]; -- used to be @ PutTV[referentTV, depth - 1]; }; pointer => { bits: CARDINAL _ TVToCardinal[tv]; short: POINTER _ LOOPHOLE[bits]; lp: LONG POINTER _ short; <> IF bits = 0 THEN GO TO putNil; IF NOT LocalValidate[tv] THEN { IO.PutF1[put, "%bB@??", [cardinal[bits]] ]; RETURN}; IF NOT isRemote AND under = UnderString THEN { PutStringConst[LOOPHOLE[short, STRING]]; RETURN}; IO.PutF1[put, "%bB@", [cardinal[bits]] ]; }; longPointer, basePointer => { bits: LONG CARDINAL _ TVToLC[tv]; IF IsNil[tv] THEN GO TO putNil; IF NOT LocalValidate[tv] THEN { IO.PutF1[put, "%bB@??", [cardinal[bits]] ]; RETURN}; IF NOT isRemote THEN SELECT under FROM UnderLongString, UnderPtrText => { PutStringConst[LOOPHOLE[bits, LONG STRING]]; RETURN}; ENDCASE; IO.PutF1[put, "%bB@", [cardinal[bits]] ]; }; relativePointer => { IF IsNil[tv] THEN GO TO putNil; IO.PutF1[put, "%g^R", [integer[TVToLC[tv]]]]; }; descriptor, longDescriptor => { ws: AMBridge.WordSequence = AMBridge.TVToWordSequence[tv]; base: LONG CARDINAL _ 0; len: CARDINAL _ 0; IO.PutRope[put, "DESCRIPTOR["]; SELECT class FROM descriptor => { shortDesc: LONG POINTER TO DESCRIPTOR FOR ARRAY OF WORD = LOOPHOLE[@ws[0]]; base _ LOOPHOLE[BASE[shortDesc^], CARDINAL]; len _ LENGTH[shortDesc^]; }; longDescriptor => { longDesc: LONG POINTER TO LONG DESCRIPTOR FOR ARRAY OF WORD = LOOPHOLE[@ws[0]]; base _ LOOPHOLE[BASE[longDesc^]]; len _ LENGTH[longDesc^]; }; ENDCASE => ERROR; IF base = 0 THEN IO.PutRope[put, "NIL, "] ELSE IO.PutF1[put, "%bB@, ", [cardinal[base]] ]; IO.PutF1[put, "%g]", [integer[len]]]; }; port => PutWords[tv, "PORT#"]; process => PutWords[tv, "PROCESS#"]; type => <> <> PutTVAsType[tv]; nil => GO TO putNil; any => PutWords[tv, "ANY??"]; globalFrame => { name: ROPE _ TVToName[tv]; IO.PutRope[put, "{globalFrame: "]; QPutName[name]; IF verbose THEN { gf: CARDINAL _ IF isRemote THEN AMBridge.RemoteGFHFromTV[tv].gfh ELSE LOOPHOLE[GFHFromTV[tv], CARDINAL]; IO.PutF1[put, " (GF#%bB)\n", [cardinal[gf]] ]; PrintVariables[tv, put]; }; IO.PutChar[put, '}]; }; localFrame => { proc: TV _ NIL; pc: CARDINAL = AMBridge.ContextPC[tv]; lf: CARDINAL = IF isRemote THEN AMBridge.RemoteFHFromTV[tv].fh ELSE LOOPHOLE[FHFromTV[tv], CARDINAL]; temp: TV _ tv; WHILE temp # NIL DO ENABLE AMTypes.Error => EXIT; proc _ Procedure[temp ! AMTypes.Error => CONTINUE]; IF proc # NIL THEN EXIT; temp _ EnclosingBody[temp]; ENDLOOP; IF proc # NIL THEN { ENABLE AMTypes.Error => GO TO oops; IF UnderTypeAndClass[TVType[proc]].class = nil THEN proc _ NIL; EXITS oops => proc _ NIL; }; IF proc = NIL THEN { ENABLE AMTypes.Error => GO TO oops; gf: TV _ GlobalParent[tv]; IF gf = NIL THEN GO TO oops; IO.PutRope[put, TVToName[gf]]; IO.PutRope[put, ".??"]; EXITS oops => {IO.PutRope[put, "??"]; RETURN}} ELSE PutTV[proc, depth]; IF verbose THEN { IO.PutF[put, "(lf: %bB, pc: %bB)", [cardinal[lf]], [cardinal[pc]] ]; IF depth > 1 THEN { IO.PutRope[put, "\nArguments:\n"]; PrintArguments[tv: tv, put: put, breakBetweenItems: TRUE]; IO.PutRope[put, "\nVariables:\n"]; PrintVariables[tv: tv, put: put, breakBetweenItems: TRUE]; }; IO.PutRope[put, "\n"]; }; }; program, procedure, signal, error => { kind: ROPE _ NIL; name: ROPE _ NIL; useGlobalName: BOOL _ TRUE; IF IsNil[tv] THEN GO TO putNil; name _ TVToName[tv ! AMTypes.Error => CONTINUE]; SELECT class FROM program => {kind _ "PROGRAM#"; useGlobalName _ FALSE}; procedure => kind _ NIL; signal, error => { kind _ IF class = signal THEN "SIGNAL " ELSE "ERROR "; IF AllCaps[name] THEN useGlobalName _ FALSE; } ENDCASE => ERROR; IO.PutRope[put, kind]; IF useGlobalName THEN { ENABLE AMTypes.Error => GO TO oops; gn: ROPE _ NIL; gp: TV _ GlobalParent[tv]; IF gp # NIL THEN gn _ TVToName[gp]; QPutName[gn]; IO.PutChar[put, '.]; EXITS oops => IO.PutRope[put, "??."]; }; QPutName[name]; }; character => IO.PutRope[put, Convert.RopeFromChar[TVToCharacter[tv]]]; integer, longInteger => IO.Put[put, [integer[TVToLI[tv]]]]; unspecified, cardinal, longCardinal => { lc: LONG CARDINAL = TVToLC[tv]; IO.PutF[put, "%bB (%g)", [cardinal[lc]], [cardinal[lc]] ]; }; real => IO.Put[put, [real[TVToReal[tv]]]]; ENDCASE => ERROR; EXITS putNil => IO.PutRope[put, "NIL"]; }; <<>> <> IF needInit THEN EnsureInit[]; PutTV[tv, depth, verbose]; }; AllCaps: PROC [name: ROPE] RETURNS [BOOL] = { FOR i: INT IN [0..name.Size[]) DO IF name.Fetch[i] IN ['a..'z] THEN RETURN [FALSE]; ENDLOOP; RETURN [TRUE]; }; PrintArguments: PUBLIC PROC [tv: TV, put: STREAM, depth: INT _ 4, width: INT _ 32, breakBetweenItems: BOOL _ FALSE] = { <> <> <> type: Type; class: Class; n: NAT _ 0; i: NAT _ 0; inner1: PROC = { Print[Argument[tv, i], put, depth, width, FALSE]; }; inner: PROC = { ptv: TV _ NIL; sep: ROPE _ IF breakBetweenItems THEN "\n " ELSE ", "; [type, class] _ UnderTypeAndClass[TVType[tv]]; IF class # localFrame THEN { IO.PutRope[put, "-- not a local frame! --"]; RETURN}; ptv _ Procedure[tv ! Error => CONTINUE]; IF ptv = NIL THEN ptv _ Signal[tv ! Error => CONTINUE]; IF ptv = NIL THEN RETURN; [type, class] _ UnderTypeAndClass[TVType[ptv]]; IF type = nullType THEN RETURN; [type, class] _ UnderTypeAndClass[Domain[type]]; IF type = nullType THEN RETURN; n _ NComponents[type]; IF n = 0 THEN RETURN; IO.PutRope[put, " "]; FOR i IN [1..n] DO name: ROPE _ IndexToName[type, i]; each: ROPE _ NIL; IF i > 1 THEN IO.PutRope[put, sep]; PrintName[put, name]; PrintBraces[put, BackStop.Call[inner1]]; ENDLOOP; }; PrintBraces[put, BackStop.Call[inner]]; }; PrintResults: PUBLIC PROC [tv: TV, put: STREAM, depth: INT _ 4, width: INT _ 32, breakBetweenItems: BOOL _ FALSE] = { <> <> <> type: Type; class: Class; n: NAT _ 0; i: NAT _ 0; inner1: PROC = { Print[Result[tv, i], put, depth, width, FALSE]; }; inner: PROC = { ptv: TV _ NIL; sep: ROPE _ IF breakBetweenItems THEN "\n " ELSE ", "; [type, class] _ UnderTypeAndClass[TVType[tv]]; IF class # localFrame THEN { IO.PutRope[put, "-- not a local frame! --"]; RETURN}; ptv _ Procedure[tv ! AMTypes.Error => CONTINUE]; IF ptv = NIL THEN ptv _ Signal[tv ! AMTypes.Error => CONTINUE]; IF ptv = NIL THEN RETURN; [type, class] _ UnderTypeAndClass[TVType[ptv]]; IF type = nullType THEN RETURN; [type, class] _ UnderTypeAndClass[Range[type]]; IF type = nullType THEN RETURN; n _ NComponents[type]; IF n = 0 THEN RETURN; IO.PutRope[put, " "]; FOR i IN [1..n] DO name: ROPE _ IndexToName[type, i]; each: ROPE _ NIL; IF i > 1 THEN IO.PutRope[put, sep]; PrintName[put, name]; PrintBraces[put, BackStop.Call[inner1]]; ENDLOOP; }; PrintBraces[put, BackStop.Call[inner]]; }; PrintVariables: PUBLIC PROC [tv: TV, put: STREAM, depth: INT _ 4, width: INT _ 32, all, breakBetweenItems: BOOL _ TRUE] = TRUSTED { <> <> <> <> type: Type; local, global: BOOL _ FALSE; class: Class; n: NAT _ 0; i: NAT _ 0; indent: ROPE _ " "; sep: ROPE _ IF breakBetweenItems THEN "\n" ELSE ", "; nvars: NAT _ 0; inner1: PROC = TRUSTED { tv1: TV _ IF local THEN Locals[tv] ELSE Globals[tv]; type1: Type _ TVType[tv1]; nvars _ IF tv1 = NIL THEN 0 ELSE NComponents[type1]; FOR i: INT IN [1..nvars] DO inner2: PROC = TRUSTED { name: ROPE _ IndexToName[type1, i]; IF breakBetweenItems THEN IO.PutRope[put, indent]; PrintName[put, name]; Print[IndexToTV[tv1, i], put, depth, width] }; IF i > 1 THEN IO.PutRope[put, sep]; PrintBraces[put, BackStop.Call[inner2]]; ENDLOOP; IF local THEN tv _ EnclosingBody[tv] ELSE tv _ NIL; IF breakBetweenItems THEN indent _ Rope.Concat[indent, " "]; }; inner: PROC = TRUSTED { [type, class] _ UnderTypeAndClass[TVType[tv]]; SELECT class FROM globalFrame => global _ TRUE; localFrame => local _ TRUE; ENDCASE => {IO.PutRope[put, "--{not a frame}--"]; RETURN}; WHILE tv # NIL DO msg: ROPE _ NIL; IF nvars # 0 THEN IO.PutRope[put, sep]; msg _ BackStop.Call[inner1]; IF msg # NIL THEN {PrintBraces[put, msg]; EXIT}; IF NOT all THEN EXIT; ENDLOOP; }; PrintBraces[put, BackStop.Call[inner]]; }; PrintSignal: PUBLIC PROC [signalTV, argsTV: TV, put: STREAM, depth: INT _ 4, width: INT _ 32, verbose: BOOL _ FALSE] = TRUSTED { msg, signal: UNSPECIFIED; r: ROPE; PutSignal1: PROC = TRUSTED { OPEN AMTypes, IO; signalType: Type; argsType: Type; ptr: LONG POINTER; argsSize: NAT _ 0; signalTV _ AMBridge.TVForSignal[LOOPHOLE[signal, ERROR ANY RETURNS ANY]]; signalType _ TVType[signalTV]; argsType _ Domain[signalType]; IF argsType # SafeStorage.nullType THEN argsSize _ AMTypes.Size[argsType]; IF argsSize > 1 THEN ptr _ LOOPHOLE[msg, POINTER] ELSE ptr _ @msg; IF argsSize # 0 THEN argsTV _ AMBridge.TVForPointerReferent[ptr, argsType] ELSE RETURN; }; -- of PutSignal1 <> IF signalTV = NIL THEN { [msg, signal] _ SIGNAL RuntimeError.SendMsgSignal[]; SELECT signal FROM -- some common signals which have to be handled specially -1 => {IO.PutRope[put, "ERROR"]; RETURN}; ABORTED => {IO.PutRope[put, "ABORTED"]; RETURN}; -- says andrew ENDCASE; r _ BackStop.Call[PutSignal1]; IF ~Rope.IsEmpty[r] THEN {IO.PutRope[put, r]; RETURN}; }; Print[tv: signalTV, put: put, depth: depth, width: width, verbose: verbose]; IF argsTV # NIL THEN Print[tv: argsTV, put: put, depth: depth, width: width, verbose: verbose]; }; PrintOctal: PROC [put: STREAM, n: LONG CARDINAL] = { IO.PutF1[put, "%bB", [cardinal[n]]]; }; PrintName: PROC [put: STREAM, name: ROPE] = { IF Rope.InlineLength[name] # 0 THEN IO.PutF1[put, "%g: ", [rope[name]]]; }; PrintBraces: PROC [put: STREAM, stuff: ROPE] = { IF stuff # NIL THEN IO.PutF1[put, "--{%g}--", [rope[stuff]]]; }; <> UnderTypeAndClass: PROC [type: Type] RETURNS [under: Type, class: Class] = { under _ type; WHILE (class _ TypeClass[under]) = definition DO under _ UnderType[under]; ENDLOOP; }; AddrForFrameTV: PROC [frame: TV] RETURNS [world: World, addr: Address] = TRUSTED { class: Class _ UnderClass[TVType[frame]]; world _ WorldVM.LocalWorld[]; addr _ 0; SELECT class FROM localFrame, globalFrame => {}; ENDCASE => RETURN; IF AMBridge.IsRemote[frame] THEN { card: CARDINAL _ 0; world _ AMBridge.GetWorld[frame]; IF class = localFrame THEN card _ LOOPHOLE[AMBridge.RemoteFHFromTV[frame].fh, CARDINAL] ELSE card _ LOOPHOLE[AMBridge.RemoteGFHFromTV[frame].gfh, CARDINAL]; addr _ WorldVM.Long[world, card]; } ELSE { <> sp: POINTER _ IF class = localFrame THEN LOOPHOLE[FHFromTV[frame], POINTER] ELSE LOOPHOLE[GFHFromTV[frame], POINTER]; lp: LONG POINTER _ sp; addr _ LOOPHOLE[lp, LONG CARDINAL]; }; }; LocalValidate: PROC [tv: TV, class: Class _ definition] RETURNS [BOOL] = TRUSTED { <> <> isRemote: BOOL _ AMBridge.IsRemote[tv]; validateRef: BOOL _ FALSE; world: World _ IF isRemote THEN AMBridge.GetWorld[tv] ELSE WorldVM.LocalWorld[]; bits: Address _ 0; IF class = definition THEN class _ UnderClass[TVType[tv]]; SELECT class FROM definition => RETURN [FALSE]; -- huh? atom, rope, list, ref, countedZone => { <> validateRef _ TRUE; bits _ TVToLC[tv]; }; longPointer, uncountedZone, basePointer => { <> bits _ TVToLC[tv]; }; pointer => { <> bits _ WorldVM.Long[world, TVToCardinal[tv]]; }; globalFrame, localFrame => [world, bits] _ AddrForFrameTV[tv]; ENDCASE => RETURN [TRUE]; IF bits = 0 THEN RETURN [FALSE]; <

> [] _ WorldVM.Read[world, bits ! VM.AddressFault, WorldVM.AddressFault => GO TO bad]; <> RETURN [TRUE]; EXITS bad => RETURN [FALSE]; }; END.