<> <> <> DIRECTORY Allocator USING [NormalHeader], AMBridge USING [GetWorld, GFHFromTV, IsRemote, IsStarted, RemoteGFHFromTV, TVForFrame, TVForGFHReferent, TVForProc, TVForReferent, TVForRemoteFrame, TVForRemoteGFHReferent, TVToCardinal], AMEvents USING [BreakID, ClearBreak, SetBreak], AMModel USING [Context], AMModelPrivate USING [FindMatchingGlobalFrames], AMTypes USING[GetEmptyTV, Globals, IndexToName, IndexToTV, NComponents, TV, TVType], BackStop USING [Call], Commander USING [Handle], Convert USING [RopeFromCard], -- for non-standard number bases EvalQuote USING [EvalQuoteProc, Register], InterpreterOps USING [EnumerateSymbols, Eval, EvalHead, GetArg, RegisterTV, Ruminant, Tree, TreeToName, WorldFromHead], InterpreterPrivate USING [GetGlobalSymTab], IO USING [Put, PutChar, PutF, PutF1, PutRope, STREAM], PPLeaves USING [LTIndex], PrincOps USING [FrameCodeBase], PrintTV USING [Print], ProcessProps USING [GetProp], Rope USING [Cat, Fetch, Flatten, Length, Match, ROPE, Size, SkipTo], RTTypesPrivate USING [TypedVariableHead, TypedVariableRec], RuntimeError USING [UNCAUGHT], SafeStorage USING [Type], SymTab USING [Ref], WorldVM USING [Address, CurrentIncarnation, LocalWorld, Long, LongRead, Read, World, Write]; OctalCommands: CEDAR MONITOR IMPORTS AMBridge, AMEvents, AMModelPrivate, AMTypes, BackStop, Convert, EvalQuote, InterpreterOps, InterpreterPrivate, IO, PrintTV, ProcessProps, Rope, RuntimeError, WorldVM = BEGIN OPEN Rope; CARD: TYPE = LONG CARDINAL; TV: TYPE = AMTypes.TV; STREAM: TYPE = IO.STREAM; Type: TYPE = SafeStorage.Type; TypedVariableHead: TYPE = RTTypesPrivate.TypedVariableHead; TypedVariableRec: TYPE = RTTypesPrivate.TypedVariableRec; ShortAddrHack: CARDINAL = 100000B; Bit1: TYPE = CARDINAL [0..2); Bit2: TYPE = CARDINAL [0..4); Bit4: TYPE = CARDINAL [0..16); Bit8: TYPE = CARDINAL [0..256); Array1: TYPE = PACKED ARRAY [0..16) OF Bit1; Array2: TYPE = PACKED ARRAY [0..8) OF Bit2; Array4: TYPE = PACKED ARRAY [0..4) OF Bit4; Array8: TYPE = PACKED ARRAY [0..2) OF Bit8; Pair: TYPE = MACHINE DEPENDENT RECORD [lo,hi: CARDINAL]; safetyCheck: BOOL _ TRUE; Help: PROC [pattern: ROPE] = { put: STREAM _ GetSTREAM[]; sTab: REF _ ProcessProps.GetProp[$InterpreterSymTab]; <> inner: InterpreterOps.Ruminant = { <<[name: ROPE, help: ROPE, tv: TV, data: REF] RETURNS [stop: BOOL]>> IsDigit: PROC[ch: CHAR] RETURNS[BOOL] ={RETURN[ch IN ['0 .. '9]];}; IF Rope.Match[pattern, name, FALSE] AND (name.Length[] < 2 OR name.Fetch[0] # '& OR NOT IsDigit[name.Fetch[1]]) THEN IO.PutF[put, " %g: %g\n", [rope[name]], [rope[IF help # NIL THEN help ELSE "(no help rope)"]] ]; RETURN[FALSE]; }; [] _ InterpreterOps.EnumerateSymbols[inner]; IF sTab # NIL THEN TRUSTED { [] _ InterpreterOps.EnumerateSymbols[proc: inner, symTab: LOOPHOLE[sTab, SymTab.Ref]]; }; }; FindMatching: PROC [name: ROPE, world: WorldVM.World _ NIL] = TRUSTED { put: STREAM _ GetSTREAM[]; pos: INT _ name.SkipTo[0, "."]; globalName: ROPE _ name.Flatten[0, pos]; localName: ROPE _ IF (pos _ pos + 1) >= name.Size[] THEN NIL ELSE name.Flatten[pos]; tryElem: PROC [glob: TV, index: INT] = TRUSTED { elem: TV _ NIL; innerElem: PROC = TRUSTED { elem _ AMTypes.IndexToTV[glob, index]; PrintTV.Print[elem, put]; IO.PutRope[put, "\n"]; }; msg: ROPE _ BackStop.Call[innerElem]; IF msg # NIL THEN IO.PutF1[put, "--{%g}--\n", [rope[msg]] ]; }; eachMatch: PROC[name: ROPE, gf: AMModel.Context] RETURNS[--stop:-- BOOL] = TRUSTED { inner: PROC = TRUSTED { glob: TV _ AMTypes.Globals[gf]; globType: Type _ AMTypes.TVType[glob]; n: NAT _ AMTypes.NComponents[globType]; first: BOOL _ TRUE; FOR i: INT IN [1..n] DO compName: ROPE _ AMTypes.IndexToName[globType, i]; IF NOT localName.Match[compName, FALSE] THEN LOOP; IF first THEN {IO.PutRope[put, "\n"]; showGF[]; first _ FALSE}; IO.PutF1[put, " %g: ", [rope[compName]] ]; tryElem[glob, i]; ENDLOOP; }; showGF: PROC = TRUSTED { IO.PutRope[put, " "]; PrintTV.Print[gf, put]; IF NOT AMBridge.IsStarted[gf] THEN IO.PutRope[put, "~"]; IO.PutF1[put, " %bB\n", [cardinal[LoopholeOfGlobalFrame[gf]]] ]; }; msg: ROPE _ NIL; IF localName = NIL THEN {showGF[]; RETURN[TRUE]}; msg _ BackStop.Call[inner]; IF msg # NIL THEN put.PutRope[Rope.Cat[" --{", msg, "}--\n"]]; RETURN[FALSE]; }; IF world = NIL THEN world _ WorldVM.LocalWorld[]; [] _ AMModelPrivate.FindMatchingGlobalFrames[world, globalName, eachMatch]; }; OctalRead: PUBLIC PROC [ addr: CARD _ 0, len: CARDINAL _ 4, width: CARDINAL _ 16, base: CARDINAL _ 8, offset: CARDINAL _ 0] = TRUSTED { world: WorldVM.World _ GetDefaultWorld[]; p: WorldVM.Address _ addr; pos: CARDINAL _ 0; poslim: CARDINAL _ 8; put: STREAM _ GetSTREAM[]; IF base NOT IN [1..36] THEN { IO.PutF1[put, "invalid base: %g", [integer[base]]]; RETURN}; SELECT width FROM 1,2,4,8,16,32 => {}; ENDCASE => {IO.PutF1[put, "invalid width: %g", [integer[width]]]; RETURN}; IF base < 8 OR width = 32 THEN poslim _ 4; -- hack! IF base = 1 THEN width _ 8; -- another hack! SELECT LOOPHOLE[p, Pair].hi FROM 0 => { <> p _ WorldVM.Long[world, p]}; ShortAddrHack => { <> LOOPHOLE[p, Pair].hi _ 0; }; ENDCASE; WHILE len > 0 DO card: CARD _ 0; pp: WorldVM.Address _ p; pint: INT _ 0; lo: CARDINAL _ 0; SELECT width FROM 1 => pp _ p + offset / 16; 2 => pp _ p + offset / 8; 4 => pp _ p + offset / 4; 8 => pp _ p + offset / 2; 16 => pp _ p + offset; 32 => pp _ p + offset + offset; ENDCASE => ERROR; IF safetyCheck AND NOT IsValidAddr[world, pp] THEN { IO.PutF1[put, "invalid address: %bB", [integer[pp]]]; RETURN}; card _ WorldVM.Read[world, pp]; lo _ LOOPHOLE[card, Pair].lo; SELECT width FROM 1 => { a: Array1 _ LOOPHOLE[lo]; card _ a[offset MOD 16]}; 2 => { a: Array2 _ LOOPHOLE[lo]; card _ a[offset MOD 8]}; 4 => { a: Array4 _ LOOPHOLE[lo]; card _ a[offset MOD 4]}; 8 => { a: Array8 _ LOOPHOLE[lo]; card _ a[offset MOD 2]}; 16 => {}; 32 => { IF safetyCheck AND NOT IsValidAddr[world, pp+1] THEN { IO.PutF1[put, "invalid address: %bB", [integer[pp + 1]]]; RETURN}; LOOPHOLE[card, Pair].hi _ WorldVM.Read[world, pp+1]; }; ENDCASE => ERROR; IF pos = poslim THEN { pos _ 0; IF base = 1 THEN IO.PutChar[put, '"]; IO.PutChar[put, '\n]}; IF pos = 0 THEN { IO.PutF1[put, "%bB: ", [integer[pp]]]; IF base = 1 THEN IO.PutChar[put, '"]; } ELSE IF base # 1 THEN IO.PutChar[put, ' ]; pos _ pos + 1; SELECT base FROM 10 => IO.Put[put, [cardinal[card]]]; 8 => IO.PutF1[put, "%bB", [cardinal[card]]]; 1 => { -- print the ASCII value short: CARDINAL _ card; IF short IN [40B..176B] THEN { c: CHAR _ LOOPHOLE[short]; IF c = '" OR c = '\\ THEN IO.PutChar[put, '\\]; put.PutChar[c]} ELSE IO.PutF1[put, "\\%bB", [integer[card]]]}; ENDCASE => put.PutRope[Convert.RopeFromCard[from: card, base: base]]; offset _ offset + 1; len _ len - 1; ENDLOOP; IF base = 1 THEN IO.PutChar[put, '"]; IO.PutChar[put, '\n]; }; OctalReadShort: PROC [ addr: CARDINAL _ 0, len: CARDINAL _ 4, width: CARDINAL _ 16, base: CARDINAL _ 8, offset: CARDINAL _ 0] = { p: Pair _ [lo: addr, hi: ShortAddrHack]; OctalRead[LOOPHOLE[p], len, width, base, offset]; }; OctalWrite: PROC [addr: CARD _ 0, word: CARDINAL _ 0, len: INT _ 1] = TRUSTED { world: WorldVM.World _ GetDefaultWorld[]; pair: Pair _ LOOPHOLE[addr]; p: WorldVM.Address _ LOOPHOLE[addr]; fault: WorldVM.Address _ 0; SELECT pair.hi FROM 0 => { <> p _ WorldVM.Long[world, p]}; ShortAddrHack => { <> pair.hi _ 0; p _ LOOPHOLE[pair]; }; ENDCASE; IF addr = 0 OR p = 0 THEN { put: STREAM _ GetSTREAM[]; IO.PutRope[put, "can't write through NIL"]; }; FOR i: INT IN [0..len) DO ENABLE { ABORTED => GO TO abort; RuntimeError.UNCAUGHT => {fault _ p+i; EXIT}; }; WorldVM.Write[world, p+i, word]; ENDLOOP; IF fault # 0 THEN { put: STREAM _ GetSTREAM[]; IO.PutF1[put, "invalid address: %bB", [integer[fault]]]; }; EXITS abort => ERROR ABORTED; }; OctalWriteShort: PROC [addr: CARDINAL _ 0, word: CARDINAL _ 0, len: INT _ 1] = { p: Pair _ [lo: addr, hi: ShortAddrHack]; OctalWrite[LOOPHOLE[p], word]; }; AsciiRead: PROC [addr: CARD _ 0, bytes: NAT _ 8] = { IF addr = 0 THEN RETURN; OctalRead[addr, bytes, 8, 1, 0]; }; AsciiReadShort: PROC [addr: CARDINAL _ 0, bytes: NAT _ 8] = { p: Pair _ [lo: addr, hi: ShortAddrHack]; OctalRead[LOOPHOLE[p], bytes, 8, 1, 0]; }; OctalReadCode: PROC [gf,pc: CARDINAL, bytes: CARDINAL _ 8] = TRUSTED { OctalRead[GetCodeBase[GetDefaultWorld[], gf], bytes, 8, 8, pc]; }; OctalFindCode: PROC [ gf: CARDINAL, pc: CARDINAL _ 0, b0,b1,b2,b3,b4,b5,b6,b7,b8,b9: CARDINAL _ 0] = TRUSTED { put: STREAM _ GetSTREAM[]; addr: WorldVM.Address _ 0; world: WorldVM.World _ GetDefaultWorld[]; { ENABLE InvalidAddress => {IO.PutF1[put, "invalid address: %bB", [integer[bad]]]; GOTO bye}; target: ARRAY [0..10) OF CARDINAL = [b0,b1,b2,b3,b4,b5,b6,b7,b8,b9]; len: CARDINAL _ 10; addr _ GetCodeBase[world, gf]; WHILE len > 0 DO IF target[len-1] # 0 THEN EXIT; len _ len - 1; ENDLOOP; IF len = 0 THEN RETURN; DO IF ReadByte[world, addr, pc] = b0 THEN { found: BOOL _ TRUE; FOR i: CARDINAL IN [1..len) WHILE found DO found _ ReadByte[world, addr, pc+i] = target[i]; ENDLOOP; IF found THEN EXIT}; pc _ pc + 1; ENDLOOP; IO.PutF1[put, "pc = %bB", [cardinal[pc]]]; OctalRead[addr + (pc/2), len, 8, 8, pc MOD 2] }; EXITS bye => {}; }; DiagRef: PROC [addr: CARD] RETURNS [Allocator.NormalHeader] = TRUSTED { world: WorldVM.World _ GetDefaultWorld[]; RETURN [LOOPHOLE[WorldVM.LongRead[world, addr-SIZE[Allocator.NormalHeader]]]]; }; AddressHelper: EvalQuote.EvalQuoteProc = TRUSTED { <<[head: InterpreterOps.EvalHead, tree: InterpreterOps.Tree, target: Type _ nullType, data: REF _ NIL] RETURNS [return: TV]>> arg: InterpreterOps.Tree = InterpreterOps.GetArg[tree, 1]; address: CARD _ 0; tv: TV _ InterpreterOps.Eval[arg, head, target]; WITH tv SELECT FROM tvr: REF TypedVariableRec => WITH tvr.head SELECT FROM ref: reference TypedVariableHead => address _ LOOPHOLE[ref.ref]; rr: remoteReference TypedVariableHead => address _ LOOPHOLE[rr.remoteRef.ref]; ptr: pointer TypedVariableHead => address _ LOOPHOLE[ptr.ptr]; rp: remotePointer TypedVariableHead => address _ LOOPHOLE[rp.remotePointer.ptr]; gfh: gfh TypedVariableHead => address _ LOOPHOLE[LONG[gfh.gfh]]; rgfh: remoteGFH TypedVariableHead => address _ LOOPHOLE[WorldVM.Long[rgfh.remoteGlobalFrameHandle.world, rgfh.remoteGlobalFrameHandle.gfh]]; fh: fh TypedVariableHead => address _ LOOPHOLE[LONG[fh.fh]]; rfh: remoteFH TypedVariableHead => address _ LOOPHOLE[WorldVM.Long[rfh.remoteFrameHandle.world, rfh.remoteFrameHandle.fh]]; ENDCASE => GO TO none; ENDCASE => GO TO none; WITH tv SELECT FROM emTV: REF embedded TypedVariableRec => address _ address + emTV.fd.wordOffset; entire: REF entire TypedVariableRec => {}; ENDCASE => GO TO none; RETURN [AMBridge.TVForReferent[NEW[CARD _ address], readOnly]]; EXITS none => RETURN [AMTypes.GetEmptyTV[]]; }; HelpHelper: EvalQuote.EvalQuoteProc = TRUSTED { <<[head: InterpreterOps.EvalHead, tree: InterpreterOps.Tree, target: Type _ nullType, data: REF _ NIL] RETURNS [return: TV]>> arg: InterpreterOps.Tree _ InterpreterOps.GetArg[tree, 1]; rope: ROPE _ InterpreterOps.TreeToName[arg]; IF rope = NIL THEN WITH arg SELECT FROM lit: PPLeaves.LTIndex => WITH lit.value SELECT FROM ropeVal: ROPE => rope _ ropeVal; ENDCASE; ENDCASE; Help[rope]; RETURN [AMTypes.GetEmptyTV[]]; }; FindMatchingHelper: EvalQuote.EvalQuoteProc = TRUSTED { <<[head: InterpreterOps.EvalHead, tree: InterpreterOps.Tree, target: Type _ nullType, data: REF _ NIL] RETURNS [return: TV]>> arg: InterpreterOps.Tree _ InterpreterOps.GetArg[tree, 1]; rope: ROPE _ InterpreterOps.TreeToName[arg]; IF rope = NIL THEN WITH arg SELECT FROM lit: PPLeaves.LTIndex => WITH lit.value SELECT FROM ropeVal: ROPE => rope _ ropeVal; ENDCASE; ENDCASE; FindMatching[rope]; RETURN [AMTypes.GetEmptyTV[]]; }; InvalidAddress: ERROR [bad: WorldVM.Address] = CODE; ReadByte: PROC [world: WorldVM.World, addr: WorldVM.Address, pc: CARDINAL] RETURNS [Bit8] = TRUSTED { card: CARDINAL _ 0; addr _ addr + (pc / 2); IF safetyCheck AND NOT IsValidAddr[world, addr] THEN ERROR InvalidAddress[addr]; pc _ pc MOD 2; card _ WorldVM.Read[world, addr]; RETURN [LOOPHOLE[card, Array8][pc]]; }; SetOctalBreak: PUBLIC PROC [gf,pc: CARDINAL] = TRUSTED { world: WorldVM.World _ GetDefaultWorld[]; put: STREAM _ GetSTREAM[]; id: AMEvents.BreakID _ NIL; msg: ROPE _ NIL; inner: PROC = TRUSTED { tv: TV _ IF world = WorldVM.LocalWorld[] THEN AMBridge.TVForGFHReferent[LOOPHOLE[gf]] ELSE AMBridge.TVForRemoteGFHReferent [[world, WorldVM.CurrentIncarnation[world], gf]]; id _ NewBreak[tv, gf, pc]; }; ShowBreak[put, gf, pc]; msg _ BackStop.Call[inner]; IF id # NIL THEN IO.PutRope[put, " set.\n"] ELSE { IO.PutF1[put, " NOT set (%g).\n", [rope[IF msg = NIL THEN "duplicate" ELSE msg]] ]; }; }; localBreakList: LocalBreakList; LocalBreakList: TYPE = LIST OF LocalBreakEntry; LocalBreakEntry: TYPE = RECORD [ id: AMEvents.BreakID, world: WorldVM.World, gf,pc: CARDINAL]; NewBreak: ENTRY PROC [tv: TV, gf,pc: CARDINAL] RETURNS [id: AMEvents.BreakID _ NIL] = TRUSTED { <<... adds a new break to the local list of octal breaks. It will get a private error out of AMEventsImpl if FrameBreak can't handle setting the break, including the case where there are duplicate breaks. This means that the caller has to be able to handle ANY error (sigh).>> ENABLE UNWIND => NULL; world: WorldVM.World _ AMBridge.GetWorld[tv]; FOR list: LocalBreakList _ localBreakList, list.rest UNTIL list = NIL DO IF pc = list.first.pc AND gf = list.first.gf AND world = list.first.world THEN RETURN; ENDLOOP; id _ AMEvents.SetBreak[world, GetCodeBase[world, gf], pc, $OctalCommands]; localBreakList _ CONS[[id: id, world: world, gf: gf, pc: pc], localBreakList]; }; GetCodeBase: PROC [world: WorldVM.World, gfh: CARDINAL] RETURNS [addr: WorldVM.Address] = TRUSTED { <<... gets the code base for the octal gfh, clearing out the code trap bit to be safe.>> ENABLE UNWIND => NULL; addr _ WorldVM.Long[world, gfh] + 1; addr _ WorldVM.LongRead[world, addr]; -- code base LOOPHOLE[addr, PrincOps.FrameCodeBase].out _ FALSE; -- stupid code traps! }; FindBreak: ENTRY PROC [tv: TV, gf,pc: CARDINAL, delete: BOOL _ FALSE] RETURNS [id: AMEvents.BreakID _ NIL] = TRUSTED { <> ENABLE UNWIND => NULL; lag: LocalBreakList _ NIL; world: WorldVM.World _ AMBridge.GetWorld[tv]; FOR list: LocalBreakList _ localBreakList, list.rest UNTIL list = NIL DO IF pc = list.first.pc AND gf = list.first.gf AND world = list.first.world THEN { id _ list.first.id; IF delete THEN { IF lag = NIL THEN localBreakList _ list.rest ELSE lag.rest _ list.rest; AMEvents.ClearBreak[id]; }; RETURN; }; lag _ list; ENDLOOP; }; ClearOctalBreak: PUBLIC PROC [gf,pc: CARDINAL] = TRUSTED { world: WorldVM.World _ GetDefaultWorld[]; put: STREAM _ GetSTREAM[]; id: AMEvents.BreakID _ NIL; msg: ROPE _ NIL; inner: PROC = TRUSTED { tv: TV _ IF world = WorldVM.LocalWorld[] THEN AMBridge.TVForGFHReferent[LOOPHOLE[gf]] ELSE AMBridge.TVForRemoteGFHReferent [[world, WorldVM.CurrentIncarnation[world], gf]]; id _ FindBreak[tv, gf, pc, TRUE] }; ShowBreak[put, gf, pc]; msg _ BackStop.Call[inner]; IF id # NIL THEN { IO.PutRope[put, " cleared.\n"] } ELSE { IO.PutF1[put, " NOT cleared (%g).\n", [rope[IF msg = NIL THEN "not found" ELSE msg]] ]; }; }; ListOctalBreaks: PUBLIC ENTRY PROC = TRUSTED { ENABLE UNWIND => NULL; put: STREAM _ GetSTREAM[]; IF localBreakList = NIL THEN { IO.PutRope[put, "No current octal breaks.\n"]; RETURN}; IO.PutRope[put, "Current octal breaks:\n"]; FOR list: LocalBreakList _ localBreakList, list.rest UNTIL list = NIL DO IO.PutRope[put, " "]; ShowBreak[put, list.first.gf, list.first.pc, "\n"]; ENDLOOP; }; PrintLocalFrame: PROC [lf: CARDINAL] = TRUSTED { put: STREAM _ GetSTREAM[]; tv: TV = TrustLocalFrame[lf]; oct: CARDINAL _ 0; PrintTV.Print[tv: tv, put: put, verbose: TRUE]; }; PrintGlobalFrame: PROC [gf: CARDINAL] = TRUSTED { put: STREAM _ GetSTREAM[]; tv: TV = TrustGlobalFrame[gf]; PrintTV.Print[tv: tv, put: put, verbose: TRUE]; }; TrustLocalFrame: PROC [lf: CARDINAL] RETURNS [tv: TV] = TRUSTED { world: WorldVM.World _ GetDefaultWorld[]; IF world = WorldVM.LocalWorld[] THEN tv _ AMBridge.TVForFrame[fh: LOOPHOLE[lf]] ELSE tv _ AMBridge.TVForRemoteFrame[[ world: world, worldIncarnation: WorldVM.CurrentIncarnation[world], fh: LOOPHOLE[lf]]]; }; TrustGlobalFrame: PROC [gf: CARDINAL] RETURNS [tv: TV] = TRUSTED { world: WorldVM.World _ GetDefaultWorld[]; IF world = WorldVM.LocalWorld[] THEN tv _ AMBridge.TVForGFHReferent[gfh: LOOPHOLE[gf]] ELSE tv _ AMBridge.TVForRemoteGFHReferent[[ world: world, worldIncarnation: WorldVM.CurrentIncarnation[world], gfh: LOOPHOLE[gf]]]; }; TrustLocalFrameHelper: EvalQuote.EvalQuoteProc = TRUSTED { <<[head: InterpreterOps.EvalHead, tree: InterpreterOps.Tree, target: Type _ nullType, data: REF _ NIL] RETURNS [return: TV]>> arg: InterpreterOps.Tree _ InterpreterOps.GetArg[tree, 1]; tv: TV _ InterpreterOps.Eval[arg, head, target]; RETURN [TrustLocalFrame[AMBridge.TVToCardinal[tv]]]; }; TrustGlobalFrameHelper: EvalQuote.EvalQuoteProc = TRUSTED { <<[head: InterpreterOps.EvalHead, tree: InterpreterOps.Tree, target: Type _ nullType, data: REF _ NIL] RETURNS [return: TV]>> arg: InterpreterOps.Tree _ InterpreterOps.GetArg[tree, 1]; tv: TV _ InterpreterOps.Eval[arg, head, target]; RETURN [TrustGlobalFrame[AMBridge.TVToCardinal[tv]]]; }; IsValidAddr: PROC [world: WorldVM.World, addr: WorldVM.Address] RETURNS [BOOL] = TRUSTED { <> [] _ WorldVM.Read[world, addr ! ABORTED => GO TO abort; RuntimeError.UNCAUGHT => GO TO bad]; RETURN [TRUE]; EXITS bad => RETURN [FALSE]; abort => ERROR ABORTED; }; GetDefaultWorld: PROC RETURNS [WorldVM.World] = TRUSTED { head: InterpreterOps.EvalHead = NARROW[ProcessProps.GetProp[$EvalHead]]; RETURN[InterpreterOps.WorldFromHead[head]]; }; GetSTREAM: PROC RETURNS [stream: STREAM] = TRUSTED { WITH ProcessProps.GetProp[$CommanderHandle] SELECT FROM command: Commander.Handle => { stream _ command.out; }; ENDCASE; IF stream = NIL THEN ERROR; }; ShowBreak: PROC [st: STREAM, gf: CARDINAL, pc: CARDINAL, suffix: ROPE _ NIL] = { IO.PutF[st, "Break at (gf: %bB, pc: %bB)%g", [cardinal[gf]], [cardinal[pc]], [rope[suffix]] ]; }; LoopholeOfGlobalFrame: PROC [gfTV: TV] RETURNS [CARD] = TRUSTED { IF AMBridge.IsRemote[gfTV] THEN RETURN [LOOPHOLE[AMBridge.RemoteGFHFromTV[gfTV].gfh, CARDINAL]] ELSE RETURN [LOOPHOLE[AMBridge.GFHFromTV[gfTV], CARDINAL]]; }; RegisterCommands: PROC = { RegisterOne[OctalRead, "&or[ptr,len]\tOctal Read"]; RegisterOne[OctalReadShort, "&ors[ptr,len]\tOctal Read Short"]; RegisterOne[OctalWrite, "&ow[ptr,word,len]\tOctal Write"]; RegisterOne[OctalWriteShort, "&ows[ptr,word,len]\tOctal Write Short"]; RegisterOne[AsciiRead, "&ar[ptr,len]\tAscii Read"]; RegisterOne[AsciiReadShort, "&ars[ptr,len]\tAscii Read Short"]; RegisterOne[OctalReadCode, "&orc[gf,pc,len]\tOctal Read Code"]; RegisterOne[OctalFindCode, "&ofc[gf,pc,...]\tOctal Find Code"]; RegisterOne[SetOctalBreak, "&sob[gf,pc]\tSet Octal Break"]; RegisterOne[ClearOctalBreak, "&clob[gf,pc]\tCLear Octal Break"]; RegisterOne[ListOctalBreaks, "&lob[]\tList Octal Breaks"]; RegisterOne[Help, "&help[pattern]\tDescribe specified SymbolTable entries"]; RegisterOne[FindMatching, "&fm[pattern]\tFind Matching Global Frames"]; RegisterOne[TrustLocalFrame, "&tlf[lf]\tTrust Local Frame"]; RegisterOne[TrustGlobalFrame, "&tgf[gf]\tTrust Global Frame"]; RegisterOne[PrintLocalFrame, "&plf[lf]\tPrint Local Frame"]; RegisterOne[PrintGlobalFrame, "&pgf[gf]\tPrint Global Frame"]; RegisterOne[DiagRef, "&diagRef[addr]\tDiagnose Ref (show header)"]; EvalQuote.Register["&addr", AddressHelper, NIL]; -- like @ but more forgiving EvalQuote.Register["&help", HelpHelper, NIL]; -- to allow an unquoted arg EvalQuote.Register["&fm", FindMatchingHelper, NIL]; -- to allow an unquoted arg EvalQuote.Register["&tlf", TrustLocalFrameHelper, NIL]; -- to remove a layer of TV EvalQuote.Register["&tgf", TrustGlobalFrameHelper, NIL]; -- to remove a layer of TV }; RegisterOne: PROC [proc: PROC ANY RETURNS ANY _ NIL, help: ROPE _ NIL] = TRUSTED { InterpreterOps.RegisterTV[ name: help.Flatten[0, help.SkipTo[0, "["]], tv: AMBridge.TVForProc[proc], help: help, symTab: InterpreterPrivate.GetGlobalSymTab[]]; }; RegisterCommands[ ! RuntimeError.UNCAUGHT => CONTINUE]; END.