OctalCommands.mesa: wizards debugging aids
Copyright © 1985, 1986 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) April 3, 1986 2:47:49 pm PST
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];
enumerate the global symtab and the local symtab (if one exists)
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 => {
hack to lengthen the pointer
p ← WorldVM.Long[world, p]};
ShortAddrHack => {
special hack for the short octal read
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 => {
hack to lengthen the pointer
p ← WorldVM.Long[world, p]};
ShortAddrHack => {
special hack for the short octal read
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]
};
};
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 {
This procedure just runs around trying to find the given break. If one is found, it removes it if delete is TRUE, and calls AMEvents.ClearBreak to clear the succker. Since AMEvents can barf at this request, we have to be able to handle this problem.
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 {
returns TRUE iff the page map has an entry for the address
[] ← 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];