<> <> <> DIRECTORY AMBridge USING [GetWorld, IsStarted, TVForFrame, TVForGFHReferent, TVForProc, 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 [card, int, Put, PutChar, PutF, PutRope, rope, STREAM], List USING [Assoc], PPLeaves USING [LTIndex], PrincOps USING [FrameCodeBase], PrintTV USING [Print], ProcessProps USING [GetPropList], Rope USING [Cat, Fetch, Flatten, Length, Match, ROPE, Size, SkipTo], 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, List, PrintTV, ProcessProps, Rope, WorldVM = BEGIN OPEN Rope; TV: TYPE = AMTypes.TV; STREAM: TYPE = IO.STREAM; Type: TYPE = SafeStorage.Type; 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 _ List.Assoc[$InterpreterSymTab, ProcessProps.GetPropList[]]; <> 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 { put.PutRope[" "]; put.PutRope[name]; put.PutRope[": "]; put.PutRope[IF help # NIL THEN help ELSE "(no help rope)"]; put.PutRope["\n"]; }; 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]; put.PutRope["\n"]; }; msg: ROPE _ BackStop.Call[innerElem]; IF msg # NIL THEN put.PutRope[Rope.Cat["--{", msg, "}--\n"]]; }; 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 {put.PutRope["\n"]; showGF[]; first _ FALSE}; put.PutRope[" "]; put.PutRope[compName]; put.PutRope[": "]; tryElem[glob, i]; ENDLOOP; }; showGF: PROC = TRUSTED { put.PutRope[" "]; PrintTV.Print[gf, put]; IF NOT AMBridge.IsStarted[gf] THEN put.PutRope["~"]; put.PutRope["\n"]; }; 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: LONG CARDINAL _ 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 {put.Put[IO.rope["invalid base: "], IO.int[base]]; RETURN}; SELECT width FROM 1,2,4,8,16,32 => {}; ENDCASE => {put.Put[IO.rope["invalid width: "], IO.int[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: LONG CARDINAL _ 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 { put.PutF["invalid address: %bB", IO.int[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 { put.PutF["invalid address: %bB", IO.int[pp + 1]]; RETURN}; LOOPHOLE[card, Pair].hi _ WorldVM.Read[world, pp+1]; }; ENDCASE => ERROR; IF pos = poslim THEN { pos _ 0; IF base = 1 THEN put.PutChar['"]; put.PutChar['\n]}; IF pos = 0 THEN { put.PutF["%bB: ", IO.int[pp]]; IF base = 1 THEN put.PutChar['"]; } ELSE IF base # 1 THEN put.PutChar[' ]; pos _ pos + 1; SELECT base FROM 10 => put.Put[[cardinal[card]]]; 8 => put.PutF["%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 put.PutChar['\\]; put.PutChar[c]} ELSE put.PutF["\\%bB", IO.int[card]]}; ENDCASE => put.PutRope[Convert.RopeFromCard[from: card, base: base]]; offset _ offset + 1; len _ len - 1; ENDLOOP; IF base = 1 THEN put.PutChar['"]; put.PutChar['\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: LONG CARDINAL _ 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[]; put.PutRope["can't write through NIL"]; }; FOR i: INT IN [0..len) DO ENABLE { ABORTED => GO TO abort; ANY => {fault _ p+i; EXIT}; }; WorldVM.Write[world, p+i, word]; ENDLOOP; IF fault # 0 THEN { put: STREAM _ GetSTREAM[]; put.PutF["invalid address: %bB", IO.int[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: LONG CARDINAL _ 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 => {put.PutF["invalid address: %bB", IO.int[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; put.PutF["pc = %bB", IO.int[pc]]; OctalRead[addr + (pc/2), len, 8, 8, pc MOD 2] }; EXITS bye => {}; }; 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]; }; put.PutF["Break at (gf: %bB", IO.card[gf]]; put.PutF[", pc: %bB", IO.card[pc]]; msg _ BackStop.Call[inner]; IF id # NIL THEN put.PutRope["set.\n"] ELSE { IF msg = NIL THEN msg _ "duplicate break"; put.PutRope["NOT set ("]; put.PutRope[msg]; put.PutRope[").\n"] }; }; 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] }; put.PutF["Break at (gf: %bB", IO.card[gf]]; put.PutF[", pc: %bB", IO.card[pc]]; msg _ BackStop.Call[inner]; IF id # NIL THEN { put.PutRope["cleared.\n"] } ELSE { IF msg = NIL THEN msg _ "not found"; put.PutRope["NOT cleared ("]; put.PutRope[msg]; put.PutRope[").\n"] }; }; ListOctalBreaks: PUBLIC ENTRY PROC = TRUSTED { ENABLE UNWIND => NULL; put: STREAM _ GetSTREAM[]; IF localBreakList = NIL THEN { put.PutRope["No current octal breaks.\n"]; RETURN}; put.PutRope["Current octal breaks:\n"]; FOR list: LocalBreakList _ localBreakList, list.rest UNTIL list = NIL DO put.PutF["Break at (gf: %bB", IO.card[list.first.gf]]; put.PutF[", pc: %bB", IO.card[list.first.pc]]; 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]]]; }; <> <> <> <> <> <> <