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 = {
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 {
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 {
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 {
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 {
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 {
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 {
arg: InterpreterOps.Tree _ InterpreterOps.GetArg[tree, 1];
tv: TV _ InterpreterOps.Eval[arg, head, target];
RETURN [TrustLocalFrame[AMBridge.TVToCardinal[tv]]];
};

TrustGlobalFrameHelper: EvalQuote.EvalQuoteProc = TRUSTED {
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.



°OctalCommands.mesa: wizards debugging aids
Copyright c 1985, 1986 by Xerox Corporation.  All rights reserved.
Russ Atkinson (RRA) April 3, 1986 2:47:49 pm PST
enumerate the global symtab and the local symtab (if one exists)
[name: ROPE, help: ROPE, tv: TV, data: REF] RETURNS [stop: BOOL]
hack to lengthen the pointer
special hack for the short octal read
hack to lengthen the pointer
special hack for the short octal read
[head: InterpreterOps.EvalHead, tree: InterpreterOps.Tree, target: Type _ nullType, data: REF _ NIL] RETURNS [return: TV]
[head: InterpreterOps.EvalHead, tree: InterpreterOps.Tree, target: Type _ nullType, data: REF _ NIL] RETURNS [return: TV]
[head: InterpreterOps.EvalHead, tree: InterpreterOps.Tree, target: Type _ nullType, data: REF _ NIL] RETURNS [return: TV]
... 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).
... gets the code base for the octal gfh, clearing out the code trap bit to be safe.
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. 
[head: InterpreterOps.EvalHead, tree: InterpreterOps.Tree, target: Type _ nullType, data: REF _ NIL] RETURNS [return: TV]
[head: InterpreterOps.EvalHead, tree: InterpreterOps.Tree, target: Type _ nullType, data: REF _ NIL] RETURNS [return: TV]
returns TRUE iff the page map has an entry for the address
Κ˜
codeš
œ*™*Kšœ
Οm
œ7™BK™0K˜š
Οk	˜	Kšœ
žœ˜Kšœ	žœ­
˜»
Kšœ	žœ!˜/Kšœžœ˜Kšœžœ˜0Kšœžœ;žœ
˜TKšœ	žœ˜Kšœ
žœ
˜KšœžœΟc ˜?Kšœ
žœ˜*Kšœžœc˜wKšœžœ˜+Kšžœ
žœ&žœ˜6Kšœ	žœ˜Kšœ	žœ˜Kšœžœ	˜Kšœ
žœ˜Kšœžœ&žœ˜DKšœžœ'˜;Kšœ
žœžœ˜Kšœžœ˜Kšœžœ˜KšœžœO˜\——
headšœžœ
ž˜Kšžœpžœ4˜­
Kšœžœ
žœ˜K˜Kšžœžœžœ
žœ
˜Kšžœžœžœ
˜Kšžœžœžœ
žœ
˜Kšœžœ˜Kšœžœ$˜;Kšœžœ#˜9K˜Kšœžœ˜"K˜Kšœžœžœ˜Kšœžœžœ˜Kšœžœžœ	˜Kšœžœžœ
˜K˜Kš	œžœžœ
žœ	žœ˜,Kš	œžœžœ
žœžœ˜+Kš	œžœžœ
žœžœ˜+Kš	œžœžœ
žœžœ˜+K˜Kšœžœžœ
ž	œ
žœ	žœ˜8K˜Kšœ
žœžœ
˜—K˜šΟnœžœžœ˜Kšœžœ˜Kšœžœ,˜5K™@š
œ"˜"Kš
œžœžœžœžœžœžœ
™@Kš œžœžœžœ
žœžœžœ˜Cšžœžœ
˜#Kšžœžœžœ
žœ˜KKšžœ
žœ-žœžœ
žœžœ˜f—Kšžœ
žœ˜K˜—Kš
œ,˜,šžœžœ
žœ
žœ˜Kšœ:žœ˜VK˜—K˜K˜—š
 œžœžœžœžœ˜GKšœžœ˜Kšœžœ˜Kšœžœ˜(Kšœžœžœ žœ
žœ
žœ˜Tš	œ	žœžœ	žœžœ˜0Kšœžœžœ
˜šœžœžœ˜K˜&K˜Kšžœ˜K˜—Kšœžœ˜%Kšžœžœ
žœ
žœ(˜<K˜—š
œžœžœžœ
Ÿ	œ
žœžœ˜Tšœžœžœ˜Kšœžœ˜K˜&Kšœžœ!˜'Kšœžœžœ
˜šžœžœ
žœž˜Kšœ
žœ$˜2Kš
žœ
žœžœžœ
žœ
˜2Kšžœžœžœ'žœ˜?Kšžœ+˜-K˜Kšžœ
˜—K˜—šœžœžœ˜Kšžœ˜K˜Kšžœ
žœžœ
žœ˜8Kšžœ>˜@K˜—Kšœžœžœ
˜Kš
žœ
žœ
žœžœ
žœ˜1K˜Kšžœžœ
žœ.˜?Kšžœ
žœ˜Kš
œ˜—Kšžœ	žœ
žœ˜1K˜KK˜K˜—š 	œžœ
žœ	žœžœ
žœ
žœžœžœ˜‡
K˜)K˜Kšœžœ˜Kšœžœ˜Kšœžœ˜šžœžœ
žœ	žœ˜Kšžœ1˜3Kšžœ˜—šžœž˜K˜Kšžœžœ4žœ˜J—Kšžœ
žœžœŸ˜4Kšžœ
žœŸ˜,šžœ
žœ
ž˜ š
œ˜Kš
œ™K˜—˜Kš
œ%™%Kšžœ˜K˜—Kšžœ
˜—šžœ	ž˜Kšœžœ˜K˜Kšœžœ˜Kšœžœ˜šžœž˜K˜K˜K˜K˜K˜K˜Kšžœžœ
˜—šžœ
žœ
žœžœ˜4Kšžœ3˜5Kšžœ˜—K˜Kšœžœ˜šžœž˜š
œ˜Kšœžœ˜Kšœžœ˜—š
œ˜Kšœžœ˜Kšœžœ˜—š
œ˜Kšœžœ˜Kšœžœ˜—š
œ˜Kšœžœ˜Kšœžœ˜—K˜	š
œ˜šžœ
žœ
žœžœ˜6Kšžœ7˜9Kšžœ˜—Kšžœ,˜4K˜—Kšžœžœ
˜—šžœžœ˜Kš
œ˜Kšžœ
žœ
žœ˜%Kšžœ˜—šžœ˜
šžœ˜Kšžœ$˜&Kšžœ
žœ
žœ˜%K˜
—Kšžœ
žœ
žœ
žœ˜*—K˜šžœž˜Kšœžœ˜$Kšœžœ%˜,š
œ˜Kš
Ÿ˜Kšœžœ˜šžœžœ˜šžœ˜Kšœžœžœ˜šžœžœ	ž˜Kšžœ˜—Kš
œ˜—Kšžœ
žœ'˜.——Kšžœ>˜E—K˜K˜Kšžœ
˜—Kšžœ
žœ
žœ˜%Kšžœ˜K˜K˜—š œžœ	žœžœ
žœ
žœžœ	˜
Kš
œ(˜(Kšœ
žœ˜1K˜K˜—š 
œžœžœžœžœžœ˜OKš
œ)˜)Kšœ
žœ˜Kšœžœ˜$Kš
œ˜šžœ	ž˜š
œ˜Kš
œ™K˜—˜Kš
œ%™%Kš
œ˜Kšœžœ˜K˜—Kšžœ
˜—šžœ
žœžœ˜Kšœžœ˜Kšžœ)˜+Kš
œ˜—šžœžœ
žœ
ž˜šžœ˜Kšžœžœ
žœ˜Kšœ
žœžœ˜.K˜—Kš
œ ˜ Kšžœ
˜—šžœžœ˜Kšœžœ˜Kšžœ6˜8K˜—Kšžœ
žœ
žœ
˜K˜K˜—š
 œžœžœžœžœ	˜PKš
œ(˜(Kšœžœ˜K˜K˜—š 	œžœžœ
žœ	˜4Kšžœ
žœ
žœ
˜K˜ K˜K˜—š œžœžœ
žœ	˜=Kš
œ(˜(Kšœ
žœ˜'K˜K˜—š
 
œžœ	žœ	žœžœ˜FKš
œ?˜?K˜K˜—š 
œžœžœžœ&žœžœ˜oKšœžœ˜K˜Kš
œ)˜)šœ
žœžœ5žœ˜]Kšœžœ	žœ
žœ#˜DKšœžœ˜Kš
œ˜šžœ	ž˜Kšžœžœ
žœ
˜K˜Kšžœ
˜—Kšžœ	žœ
žœ
˜š
ž˜šžœ žœ˜(Kšœžœžœ
˜š	žœžœ
žœ
žœž˜*K˜0Kšžœ
˜—Kšžœžœ
žœ˜—K˜Kšžœ
˜—Kšžœ(˜*Kšœ'žœ˜-K˜—š
ž˜K˜
—K˜K˜—š
 œžœžœžœžœ˜GKš
œ)˜)Kšžœžœžœ˜NK˜K˜—š 
œžœ˜2Kš	œZžœžœžœ
žœ
™yKš
œ:˜:Kšœ	žœ˜Kšœžœ*˜0šžœžœ
ž˜šœžœ˜šžœ
žœ
ž˜Kšœ.žœ
˜@Kšœ3žœ˜NKšœ,žœ
˜>Kšœ1žœ˜PKšœ(žœ
žœ˜@š
œ$˜$Kšœ
žœU˜g—Kšœ&žœ
žœ	˜<š
œ"˜"Kšœ
žœF˜X—Kšžœžœ
žœ˜——Kšžœžœ
žœ˜—šžœžœ
ž˜KšœžœE˜NKšœžœ˜*Kšžœžœ
žœ˜—Kšžœžœ
žœ˜?Kšžœ	žœ˜,K˜K˜—š 
œžœ˜/Kš	œZžœžœžœ
žœ
™yKš
œ:˜:Kšœžœ"˜,šžœžœ
ž˜šžœžœ
ž˜š
œ˜šžœžœ
ž˜Kšœ	žœ˜ Kšžœ
˜——Kšžœ
˜——Kš
œ˜Kšžœ˜K˜K˜—š œžœ˜7Kš
œy™yKš
œ:˜:Kšœžœ"˜,šžœžœ
ž˜šžœžœ
ž˜š
œ˜šžœžœ
ž˜Kšœ	žœ˜ Kšžœ
˜——Kšžœ
˜——Kš
œ˜Kšžœ˜K˜K˜—Kš œžœžœ
˜4š
 œžœ3žœžœ
žœ˜eKšœžœ˜K˜šžœ
žœ
žœž˜4Kšžœ˜—Kšœžœ˜K˜!Kšžœžœ˜$K˜K˜—š
 
œžœ
žœ	žœžœ˜8K˜)Kšœžœ˜Kšœžœ
˜Kšœžœžœ
˜šœžœžœ˜šœžœ˜	šžœ˜Kšžœžœ˜,šžœ ˜$K˜1———Kš
œ˜K˜—Kš
œ˜K˜šžœž˜Kšžœ
žœ˜šžœ˜Kš
žœ&žœžœ
žœ
žœ	˜SK˜——Kš
œ˜K˜—Kš
œ˜Kšœžœžœ
žœ˜/šœžœžœ˜ Kšœ3žœ˜=—K˜š œžœ
žœžœ	žœžœžœžœ˜_Kš
œ’™’Kšžœ
žœžœ
˜Kš
œ-˜-šžœ2žœžœ
ž˜HKš
žœžœžœžœ
žœ
˜VKšžœ
˜—Kš
œJ˜JKšœžœ9˜NKš
œ˜K˜—š
 œžœžœžœžœ˜cKš
œT™TKšžœ
žœžœ
˜K˜$Kšœ&Ÿ˜2Kšžœ%žœŸ˜IKš
œ˜K˜—š 	œžœ
žœžœ	žœ
žœžœ
žœžœžœ˜vKš
œό
™ό
Kšžœ
žœžœ
˜Kšœžœ
˜Kš
œ-˜-šžœ2žœžœ
ž˜Hšžœžœžœžœ˜PK˜šžœžœ˜Kšžœžœ
žœžœ˜GKš
œ˜K˜—Kšžœ
˜K˜—Kš
œ˜Kšžœ
˜—Kš
œ˜K˜—š
 œžœ
žœ	žœžœ˜:K˜)Kšœžœ˜Kš
œ˜Kšœžœžœ
˜šœžœžœ˜šœžœ˜	šžœ˜Kšžœžœ˜,šžœ ˜$K˜1———Kšœžœ
˜ Kš
œ˜—Kš
œ˜K˜šžœž˜šžœ˜Kšžœ˜K˜
—šžœ˜Kš
žœ*žœžœ
žœ
žœ	˜WK˜——K˜K˜—š
 œžœ
žœ
žœžœ˜.Kšžœ
žœžœ
˜Kšœžœ˜šžœžœ
žœ˜Kšžœ,˜.Kšžœ˜—Kšžœ)˜+šžœ2žœžœ
ž˜HKšžœ˜Kš
œ3˜3Kšžœ
˜—K˜K˜—š œžœžœžœ˜0Kšœžœ˜Kšœžœ˜Kšœžœ˜Kšœ)žœ˜0K˜K˜—š œžœžœžœ˜1Kšœžœ˜Kšœžœ˜Kšœ)žœ˜0K˜K˜—š œžœžœžœžœžœ˜AK˜)šžœ˜Kšžœžœ˜/š
ž˜š
œ ˜ Kš
œ
˜
Kš
œ4˜4Kšœžœ˜———K˜K˜—š œžœžœžœžœžœ˜BK˜)šžœ˜Kšžœ%žœ˜6š
ž˜š
œ&˜&Kš
œ
˜
Kš
œ4˜4Kšœžœ˜———K˜K˜—š œžœ˜:Kš	œZžœžœžœ
žœ
™yKš
œ:˜:Kšœžœ*˜0Kšžœ.˜4K˜K˜—š œžœ˜;Kš	œZžœžœžœ
žœ
™yKš
œ:˜:Kšœžœ*˜0Kšžœ/˜5K˜K˜—š
 œžœ.žœžœžœ˜ZKš
œ:™:š
œ˜Kš
œžœžœ
žœžœžœ
žœ˜>—Kšžœžœ˜š
ž˜Kšœžœžœ˜Kšœ	žœ
žœ˜—K˜K˜—š œžœ
žœžœ˜9Kšœ žœ"˜HKšžœ%˜+K˜K˜—š
 	œžœ
žœ
žœžœ˜4šžœ(žœ
ž˜7š
œ˜Kš
œ˜Kš
œ˜—Kšžœ
˜—Kšžœ
žœ
žœ
žœ
˜K˜K˜—š 	œžœžœžœžœ
žœžœ˜PKšžœ\˜^K˜K˜—š œžœžœžœžœžœ˜Ašžœ˜Kšžœ
žœžœ%žœ˜DKšžœ
žœžœžœ˜;—K˜K˜—š œžœ˜K˜3K˜?K˜:K˜FK˜3K˜?K˜?K˜?K˜;K˜@K˜:Kš
œL˜LK˜GK˜<K˜>K˜<K˜>Kš
œC˜CKšœ+žœŸ˜NKšœ(žœŸ˜IKšœ.žœŸ˜OKšœ2žœŸ˜RKšœ3žœŸ˜TK˜K˜—š œžœžœ
žœ
žœ
žœžœžœžœžœ˜Rš
œ˜Kš
œ+˜+Kš
œ˜Kš
œ˜Kš
œ.˜.—K˜K˜—Kšœ!žœžœ˜7K˜šžœ
˜K˜K˜K˜——…—J:iϊ