[_CD4_]<dragon>Dragoman>DragomanDebug.mesa!2

DragomanDebug.mesa;

Last Edited by: Sweet, November 18, 1985 10:54:37 am PST

DIRECTORY

AMBridge,

AMModel,

AMModelBridge,

AMTypes,

Ascii,

AssociativeCache,

Atom,

Basics,

BasicTime,

Buttons,

CacheModels,

Commander,

CommandTool,

Containers USING [ChildXBound, ChildYBound, Container, Create],

Convert,

DirectMapCache,

Dragoman,

DragomanOpDebug,

DragomanPrivate,

FS,

IO,

Labels,

List,

ListerUtils,

MessageWindow,

PrincOps,

PrincOpsUtils,

Process,

ProcessProps,

Rope,

Rules USING [Create, Rule],

SafeStorage,

TypeScript,

VFonts,

ViewerClasses USING [Viewer, ViewerClassRec],

ViewerIO USING [CreateViewerStreams],

ViewerOps USING [PaintViewer],

ViewerTools USING [GetContents, GetSelectionContents, MakeNewTextViewer, SetContents, SetSelection],

WorldVM;

DragomanDebug: CEDAR MONITOR LOCKS h.LOCK USING h: Handle

IMPORTS AMBridge, AMModel, AMModelBridge, AMTypes, AssociativeCache, Atom, BasicTime, Buttons, Commander, CommandTool, Containers, Convert, DirectMapCache, DragomanOpDebug, DragomanPrivate, IO, Labels, List, MessageWindow, PrincOpsUtils, Process, ProcessProps, Rope, Rules, SafeStorage, TypeScript, VFonts, ViewerIO, ViewerOps, ViewerTools, WorldVM =

BEGIN

The Containers interface is used to create an outer envelope or "container" for the different sections below. For uniformity, we define some standard distances between entries in the tool.

entryHeight: CARDINAL = 15; -- how tall to make each line of items

entryVSpace: CARDINAL = 2; -- vertical leading space between lines

entryHSpace: CARDINAL = 5; -- horizontal space between items in a line

ROPE: TYPE = Rope.ROPE;

STREAM: TYPE = IO.STREAM;

TV: TYPE = AMTypes.TV;

Byte: TYPE = Basics.Byte;

Machine: TYPE = DragomanPrivate.Machine;

FinishedExecution: PUBLIC SIGNAL = CODE;

Handle: TYPE = REF MyRec; -- a REF to the data for a particular instance of the sample tool; multiple instances can be created.

MyRec: TYPE = MONITORED RECORD [ -- the data for a particular tool instance

outer: Containers.Container ← NIL, -- handle for the enclosing container

height: INT ← 0, -- height measured from the top of the container

cmd: CommandViewer, -- the commands

busy, ready: BOOL ← FALSE,

show2Above, traceOps, countOps, recordXfers, modelCache, flushOnCall: REF BOOL,

stopFlag, killCountProcess: BOOL ← FALSE,

running, pauseTime: CONDITION,

m: DragomanPrivate.Machine,

workingDir: Atom.PropList,

parent: Commander.Handle,

rc, mc: CacheModels.Cache,

tsIn, tsOut: STREAM,

ts: ViewerClasses.Viewer ]; -- the typescript

CommandViewer: TYPE = RECORD [

iCount: ViewerClasses.Viewer,

cacheLines, cacheQuads, instCaches, dataCaches: ViewerClasses.Viewer,

pc: ViewerClasses.Viewer,

lf, lfName: ViewerClasses.Viewer,

gf, gfName: ViewerClasses.Viewer,

nextOp: ViewerClasses.Viewer,

stk: ARRAY [0..PrincOps.stackDepth) OF ViewerClasses.Viewer,

lcl: ARRAY [0..PrincOps.stackDepth) OF ViewerClasses.Viewer,

gfiRange: ViewerClasses.Viewer,

breakGF, breakPC: ViewerClasses.Viewer,

initialProc, configName: ViewerClasses.Viewer,

commandLine: ViewerClasses.Viewer

];

PromptRec: TYPE = RECORD [

handle: Handle, viewer: ViewerClasses.Viewer ← NIL, number: BOOL ← FALSE];

BoolRec: TYPE = RECORD [

handle: Handle, flag: REF BOOL];

PromptHandle: TYPE = REF PromptRec;

MakeTool: Commander.CommandProc = TRUSTED BEGIN

rule: Rules.Rule;

my: Handle ← NEW[MyRec];

myCache: DragomanPrivate.CacheInfo;

cpl: Atom.PropList ← ProcessProps.GetPropList[];

wd: ROPE ← NARROW[List.Assoc[$WorkingDirectory, cpl]];

my.parent ← NARROW[List.Assoc[$CommanderHandle, cpl]];

my.workingDir ← Atom.PutPropOnList[propList: NIL, prop: $WorkingDirectory, val: wd];

my.outer ← Containers.Create[[-- construct the outer container

iconic: TRUE, -- so tool will be iconic (small) when first created

column: left, -- initially in the left column

scrollable: FALSE ]]; -- inhibit user from scrolling contents

MakeCommands[my]; -- build each (sub)viewer in turn

rule ← Rules.Create [[parent: my.outer, wy: my.height, ww: my.outer.cw, wh: 2]];

Containers.ChildXBound[my.outer, rule];

my.height ← my.height + entryHeight + 2; -- interline spacing

MakeTypescript[my];

my.rc ← DirectMapCache.NewCache[lines: 512, quadsPerLine: 8]; -- real cache

my.mc ← AssociativeCache.NewCache[lines: 256, quadsPerLine: 4, wordsPerQuad: 1]; -- map cache

myCache ← NEW [DragomanPrivate.CacheInfoRec ← [iCaches: 1, dCaches: 1]];

myCache.iCache[0] ← AssociativeCache.NewCache[lines: 100, wordsPerQuad: 4, quadsPerLine: 1, lru: FALSE, realCache: my.rc, mapCache: my.mc];

myCache.dCache[0] ← AssociativeCache.NewCache[lines: 100, wordsPerQuad: 4, quadsPerLine: 1, lru: FALSE, realCache: my.rc, mapCache: my.mc];

my.m ← NEW[DragomanPrivate.MachineStateRec ← [

cacheData: myCache,

history: NEW [DragomanPrivate.OpHistoryRec],

opCount: NEW [ARRAY Byte OF INT],

interestingGfi: NEW [DragomanPrivate.BitVector ← ALL[FALSE]]]];

ViewerOps.PaintViewer[my.outer, all]; -- reflect above change

END;

MakeTypescript: PROC [handle: Handle] = BEGIN

handle.height ← handle.height + entryVSpace; -- space down from the top of the viewer

handle.ts ← TypeScript.Create[

info: [name: "Dragoman.ts", wy: handle.height, parent: handle.outer, border: FALSE ]];

[handle.tsIn, handle.tsOut] ← ViewerIO.CreateViewerStreams [

name: "Dragoman.ts", viewer: handle.ts, backingFile: "Dragoman.ts", editedStream: FALSE];

Containers.ChildXBound[handle.outer, handle.ts];

Containers.ChildYBound[handle.outer, handle.ts];

END;

SetValue: PROC [label: ViewerClasses.Viewer, value: ROPE] = {

IF label # NIL THEN ViewerTools.SetContents[label, value]};

MakeCommands: PROC [handle: Handle] = BEGIN

initialData: Rope.ROPE = NIL;

topY: INT = handle.height;

stkX, lclblX, lclX, tagX, valX, nameX: INT;

trX, opsX, xfrX: INT;

wy: INT ← topY;

wx: INT ← 0;

current: INT = INT.FIRST;

At: PROC [x, row: INT ← current] = {

IF row # current THEN {

wy ← topY + row * (entryHeight + entryVSpace);

handle.height ← MAX[handle.height, wy]};

IF x # current THEN wx ← x};

NewLine: PROC = {

wy ← wy + entryHeight + entryVSpace;

handle.height ← MAX[handle.height, wy];

wx ← entryHSpace};

NamedItem: PROC [label: ROPE, width: INT, data: ROPE ← NIL, number: BOOL ← FALSE]

RETURNS [v: ViewerClasses.Viewer] = {

ph: PromptHandle ← NEW [PromptRec ← [handle: handle]];

t: Buttons.Button ← Buttons.Create[

info: [

wy: wy,

default the width so that it will be computed for us --

wh: entryHeight, -- specify rather than defaulting so line is uniform

wx: wx,

parent: handle.outer,

border: FALSE ],

proc: Prompt,

clientData: ph]; -- this will be passed to our button proc

wx ← wx + t.ww + entryHSpace;

v ← ViewerTools.MakeNewTextViewer[ [

parent: handle.outer,

wx: wx,

wy: wy,

ww: width*VFonts.CharWidth['0]+12,

wh: entryHeight,

data: data,

scrollable: FALSE,

border: FALSE]];

ph.viewer ← v;

wx ← wx + v.ww + entryHSpace};

Label: PROC [value: ROPE, width: INT ← 0] RETURNS [v: ViewerClasses.Viewer] = {

lw: INT ← MAX[

width*VFonts.CharWidth['0],

IF value = NIL THEN 0 ELSE VFonts.StringWidth[value]]+4;

v ← Labels.Create[ [

wx: wx,

wy: wy,

ww: lw,

wh: entryHeight,

parent: handle.outer,

border: FALSE]];

wx ← wx + v.ww + entryHSpace};

Value: PROC [value: ROPE, width: INT ← 0] RETURNS [v: ViewerClasses.Viewer] = {

lw: INT ← MAX[

width*VFonts.CharWidth['0],

IF value = NIL THEN 0 ELSE VFonts.StringWidth[value]]+12;

don't use Label, since the text can't be selected.

v ← ViewerTools.MakeNewTextViewer[ [

data: value, -- initial contents

wx: wx,

wy: wy,

ww: lw,

wh: entryHeight,

scrollable: FALSE,

parent: handle.outer,

border: FALSE]];

wx ← wx + v.ww + entryHSpace};

Cmd: PROC [label: ROPE, proc: Buttons.ButtonProc] = {

t: Buttons.Button ← Buttons.Create[

info: [

wx: wx,

wy: wy,

default the width so that it will be computed for us --

wh: entryHeight, -- specify rather than defaulting so line is uniform

parent: handle.outer,

border: FALSE ],

proc: proc,

clientData: handle]; -- this will be passed to our button proc

wx ← wx + t.ww + entryHSpace};

Bool: PROC [label: ROPE, initial: BOOL] RETURNS [flag: REF BOOL] = {

t: Buttons.Button;

br: REF BoolRec;

flag ← NEW[BOOL ← initial];

br ← NEW[BoolRec ← [handle: handle, flag: flag]];

t ← Buttons.Create[

info: [

wx: wx,

wy: wy,

default the width so that it will be computed for us --

wh: entryHeight, -- specify rather than defaulting so line is uniform

parent: handle.outer,

border: TRUE ],

proc: ToggleBool,

clientData: br]; -- this will be passed to our button proc

Buttons.SetDisplayStyle[
button: t, style: IF initial THEN $WhiteOnBlack ELSE $BlackOnWhite, paint: FALSE];

wx ← wx + t.ww + entryHSpace};

At[row: 0, x: entryHSpace]; Cmd["STOP", StopIt];

Cmd["run", RunProc]; Cmd["step", StepProc]; Cmd["zero", ZeroProc];

[] ← Label["cnt: "]; handle.cmd.iCount ← Value[NIL, 10];

handle.cmd.cacheLines ← NamedItem["lines", 3, "50"];

handle.cmd.cacheQuads ← NamedItem["q/l", 2, "2"];

handle.cmd.instCaches ← NamedItem["inst", 2, "2"];

handle.cmd.dataCaches ← NamedItem["data", 2, "0"];

NewLine[];

[] ← Label["stack: "]; stkX ← wx;

handle.cmd.stk[0] ← Value[NIL, 10]; lclblX ← wx;

[] ← Label["locals: "]; lclX ←wx;

handle.cmd.lcl[0] ← Value[NIL, 8]; tagX ← wx;

[] ← Label["pc: "]; valX ← wx;

handle.cmd.pc ← Value[NIL, 8];

nameX ← wx; handle.modelCache ← Bool["cache", TRUE];

Cmd["print", PrintCache];

NewLine[];

handle.show2Above ← Bool["+2", FALSE];

At[x: lclblX]; [] ← Label["spc"];

At[x: tagX]; [] ← Label["lf:"]; At[x: valX]; handle.cmd.lf ← Value[NIL, 8];

handle.cmd.lfName ← Value[NIL, 20];

Containers.ChildXBound[handle.outer, handle.cmd.lfName];

NewLine[];

handle.flushOnCall ← Bool["flsh", FALSE];

At[x: lclblX]; [] ← Label["ret"]; At[x: tagX]; [] ← Label["gf:"];

At[x: valX]; handle.cmd.gf ← Value[NIL, 8];

At[x: nameX]; handle.cmd.gfName ← Value[NIL, 20];

Containers.ChildXBound[handle.outer, handle.cmd.gfName];

NewLine[];

At[x: tagX]; [] ← Label["op:"]; At[x: valX]; handle.cmd.nextOp ← Value[NIL, 20];

Containers.ChildXBound[handle.outer, handle.cmd.nextOp];

NewLine[];

At[x: tagX]; Cmd["init", SetCommandLine];

handle.cmd.commandLine ← NamedItem["cmd", 20];

Containers.ChildXBound[handle.outer, handle.cmd.commandLine];

NewLine[];

At[x: tagX]; [] ← Label["Interpreted gfi's -"];

Cmd["clear", ClearGfiTable]; Cmd["print", PrintGfiTable];

NewLine[];

At[x: tagX]; Cmd["mark", MarkGfiInTable];

handle.cmd.gfiRange ← NamedItem["numbers", 20];

Containers.ChildXBound[handle.outer, handle.cmd.gfiRange];

NewLine[];

At[x: tagX]; handle.cmd.breakGF ← NamedItem["breakGF", 8, "0"];

trX ← wx; handle.traceOps ← Bool["tr", FALSE];

opsX ← wx; handle.countOps ← Bool["ops", FALSE];

xfrX ← wx; handle.recordXfers ← Bool["xfr", FALSE];

NewLine[];

At[x: tagX]; handle.cmd.breakPC ← NamedItem["breakPC", 8, "0"];

At[x: trX]; Cmd["tr", DumpTrace];

At[x: opsX]; Cmd["ops", DumpCounts];

At[x: xfrX]; Cmd["xfr", DumpXferData];

NewLine[];

At[x: tagX]; Cmd["showGfi", ShowGfiRange];

handle.cmd.configName ← NamedItem["of", 20];

Containers.ChildXBound[handle.outer, handle.cmd.configName];

NewLine[];

At[row: 5, x: lclblX]; [] ← Label["L0"];

FOR i: CARDINAL IN [1..PrincOps.stackDepth) DO

At[row: i+1, x: stkX]; handle.cmd.stk[i] ← Value[NIL, 9];

At[x: lclX]; handle.cmd.lcl[i] ← Value[NIL, 8];

ENDLOOP;

NewLine[];

END;

Prompt: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE] -- = TRUSTED BEGIN

force the selection into the user input field

ph: PromptHandle ← NARROW[clientData];

SELECT mouseButton FROM

blue, red => NULL;

yellow => {

r: ROPE = ViewerTools.GetSelectionContents[];

IF ph.number THEN [] ← Convert.IntFromRope[r ! Convert.Error => GO TO dont];

ViewerTools.SetContents[ph.viewer, r]

EXITS

dont => NULL;

};

ENDCASE;

ViewerTools.SetSelection[ph.viewer]; -- force the selection

END;

ToggleBool: Buttons.ButtonProc = TRUSTED {

br: REF BoolRec ← NARROW [clientData];

switch: REF BOOL ← br.flag;

switch^ ← ~switch^;

Buttons.SetDisplayStyle[

button: NARROW[parent],

style: IF switch^ THEN $WhiteOnBlack ELSE $BlackOnWhite];

UpdateDisplay[br.handle];

};

SetCommandLine: Buttons.ButtonProc = TRUSTED {

h: Handle ← NARROW [clientData];

commandToolGfi: CARDINAL;

gf: PrincOps.GlobalFrameHandle;

gf ← PrincOpsUtils.GlobalFrame[LOOPHOLE[CommandTool.DoCommand]];

commandToolGfi ← gf.gfi;

h.tsOut.PutText["Initializing to run command tool\n"];

Init[h, LOOPHOLE[CallCommandTool]]; -- we're going to push parameters

DragomanPrivate.Push2[h.m, LOOPHOLE[h]];

MarkInteresting[h.m, commandToolGfi];

UpdateDisplay[h]};

SetInitialProc: Buttons.ButtonProc = TRUSTED {

h: Handle ← NARROW [clientData];

ptv: TV;

ptype: AMTypes.Type;

noVal: BOOL;

cmd, error: ROPE;

proc: PROC;

IF h.m # NIL THEN GetParamValues[h];

cmd ← ViewerTools.GetContents[h.cmd.initialProc];

IF cmd = NIL THEN {

MessageWindow.Append[message: "Enter initial proc name", clearFirst: TRUE];

RETURN};

[result: ptv, errorRope: error, noResult: noVal] ← Interpreter.Evaluate[cmd];

IF error # NIL THEN {

MessageWindow.Append[message: "Evaluation problem: ", clearFirst: TRUE];

MessageWindow.Append[message: error, clearFirst: FALSE];

RETURN};

ptype ← AMTypes.TVType[ptv];

IF AMTypes.TypeClass[ptype] # procedure THEN {

MessageWindow.Append[message: "Not a procedure", clearFirst: TRUE];

RETURN};

IF AMTypes.Domain[ptype] # SafeStorage.nullType OR AMTypes.Range[ptype] # SafeStorage.nullType THEN {

MessageWindow.Append[message: "Must be parameterless", clearFirst: TRUE];

RETURN};

proc ← NARROW[AMBridge.TVToProc[ptv]];

h.tsOut.PutText["Initializing to "];

h.tsOut.PutRope[cmd];

h.tsOut.PutText["\n"];

Init[h, proc];

};

CallCommandTool: PROC [handle: Handle] = {

parent: Commander.Handle ← NEW[Commander.CommandObject ← [

in: IO.noInputStream, out: handle.tsOut, err: IO.noWhereStream]];

line: ROPE ← ViewerTools.GetContents[handle.cmd.commandLine];

prompt: ROPE ← "%l%% %l";

directory: ROPE ← "///Commands/";

IF Rope.Length[line] = 0 THEN RETURN;

parent.propertyList ← List.PutAssoc[

key: $ErrorInputStream, val: IO.noInputStream, aList: parent.propertyList];

parent.propertyList ← List.PutAssoc[

key: $Prompt, val: prompt, aList: parent.propertyList];

parent.propertyList ← List.PutAssoc[

key: $SearchRules, val: LIST[directory], aList: parent.propertyList];

[] ← CommandTool.DoCommand[line, parent];

};

PrintCache: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE] -- = TRUSTED BEGIN

handle: Handle ← NARROW[clientData]; -- get our data

IF ~EnterTool[handle] THEN RETURN;

BEGIN

ENABLE {

UNWIND => ExitTool[handle];

ABORTED => {handle.tsOut.PutText[" aborted"]; GO TO done}};

DragomanPrivate.PrintCacheStats[handle.tsOut, handle.m];

handle.rc.print[handle.rc, handle.tsOut, "Real cache"];

handle.mc.print[handle.mc, handle.tsOut, "Map cache"];

ExitTool[handle];

EXITS

done => ExitTool[handle];

END;

ShowGfiRange: Buttons.ButtonProc = TRUSTED {

h: Handle ← NARROW [clientData];

wc, cc: AMModel.Context;

NoteMod: PROC [cx: AMModel.Context] RETURNS[stop: BOOL ← FALSE] = TRUSTED {

SELECT AMModel.ContextClass[cx] FROM

model => [] ← AMModel.ContextChildren[cx, NoteMod];

prog => {

tx: TV = AMModelBridge.FrameFromContext[cx];

gf: PrincOps.GlobalFrameHandle = AMBridge.GFHFromTV[tx];

first, last: CARDINAL;

[first, last] ← GfiRange[gf.gfi];

min ← MIN[min, first];

max ← MAX[max, last]};

ENDCASE;

};

min: CARDINAL ← CARDINAL.LAST;

max: CARDINAL ← CARDINAL.FIRST;

config: ROPE ← ViewerTools.GetContents[h.cmd.configName];

wc ← AMModel.RootContext[WorldVM.LocalWorld[]];

IF config = NIL THEN RETURN;

h.tsOut.PutRope[config];

cc ← AMModel.MostRecentNamedContext[config, wc];

IF cc = NIL THEN {h.tsOut.PutText[" not found\n"]; RETURN};

[] ← NoteMod[cc];

h.tsOut.PutF[" has minGfi: %g, and maxGfi: %g\n", IO.card[min], IO.card[max]];

};

GfiRange: PROC [gfi: PrincOps.GFTIndex] RETURNS [first, last: PrincOps.GFTIndex] = TRUSTED {

gfItem: PrincOps.GFTItem ← PrincOps.GFT[gfi];

gf: PrincOps.GlobalFrameHandle;

code: PrincOps.FrameCodeBase;

cb: LONG POINTER TO PrincOps.CSegPrefix;

gfItem.epbias ← 0;

gf ← gfItem.framePtr;

IF gf = NIL THEN RETURN [gfi, gfi];

first ← gf.gfi;

code ← gf.code;

code.out ← FALSE;

cb ← code.longbase;

last ← first + cb.header.info.ngfi - 1};

StopIt: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE] -- = TRUSTED BEGIN

handle: Handle ← NARROW[clientData]; -- get our data

handle.m.singleStep ← TRUE;

END;

RunProc: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE] -- = TRUSTED

BEGIN

handle: Handle ← NARROW[clientData]; -- get our data

RunInContext: SAFE PROC = TRUSTED {DragomanPrivate.Execute[handle.m]};

IF ~EnterTool[handle] THEN RETURN;

BEGIN

ENABLE {

UNWIND => ExitTool[handle];

FinishedExecution => {Finalize[handle]; GO TO done};

ABORTED => {handle.tsOut.PutText[" aborted"]; GO TO done}};

GetParamValues[handle];

handle.m.singleStep ← FALSE;

NotifyRunning[handle];

handle.m.startOps ← handle.m.iCount;

handle.m.startPulses ← BasicTime.GetClockPulses[];

ProcessProps.AddPropList[handle.workingDir, RunInContext];

PrintSpeed[handle];

ExitTool[handle];

EXITS

done => ExitTool[handle];

END;

PrintSpeed: PROC [h: Handle] = {

et: REAL;

et ← BasicTime.PulsesToSeconds[BasicTime.GetClockPulses[] - h.m.startPulses];

IO.PutF[h.tsOut, "executed %g instr in %g secs (%g/sec)\n",

[cardinal[h.m.iCount - h.m.startOps]],

[real[et]],

[real[(h.m.iCount - h.m.startOps)/et]]]};

NotifyRunning: ENTRY PROC [h: Handle] = {NOTIFY h.running};

StepProc: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE] -- = TRUSTED BEGIN

handle: Handle ← NARROW[clientData]; -- get our data

RunInContext: SAFE PROC = TRUSTED {DragomanPrivate.Execute[handle.m]};

IF ~EnterTool[handle] THEN RETURN;

BEGIN

ENABLE {

UNWIND => ExitTool[handle];

FinishedExecution => {Finalize[handle]; GO TO done};

ABORTED => {handle.tsOut.PutText[" aborted"]; GO TO done}};

GetParamValues[handle];

handle.m.singleStep ← TRUE;

ProcessProps.AddPropList[handle.workingDir, RunInContext];

ExitTool[handle];

EXITS

done => ExitTool[handle];

END;

ViewerValue: PROC [v: ViewerClasses.Viewer, default: INT] RETURNS [n: INT] = {

n ← Convert.IntFromRope[ViewerTools.GetContents[v] !

SafeStorage.NarrowFault => {n ← default; GO TO gub};

Convert.Error => {

MessageWindow.Append[message: "invalid number", clearFirst: TRUE];

n ← default; GO TO gub};

];

EXITS

gub => NULL;

};

GetParamValues: PROC [h: Handle] = {

gfc: CARDINAL;

lines, quads, instr, data: INT;

h.m.breakPC ← ViewerValue[h.cmd.breakPC, 0];

gfc ← ViewerValue[h.cmd.breakGF, 0];

h.m.breakGF ← LOOPHOLE[gfc];

h.m.countOps ← h.countOps^;

h.m.traceOps ← h.traceOps^;

DragomanPrivate.EnableCaches[m: h.m, state: h.modelCache^];

h.m.flushOnCall ← h.flushOnCall^;

h.m.recordXferOut ← h.recordXfers^};

PrintGfiTable: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE] -- = TRUSTED BEGIN

h: Handle ← NARROW[clientData]; -- get our data

igft: REF DragomanPrivate.BitVector;

os: IO.STREAM;

inRun, multiple: BOOL;

first: BOOL ← TRUE;

IF ~EnterTool[h] THEN RETURN;

BEGIN

ENABLE {

UNWIND => ExitTool[h];

ABORTED => {h.tsOut.PutText[" aborted"]; GO TO done}};

igft ← h.m.interestingGfi;

os ← h.tsOut;

h.m.singleStep ← FALSE; -- so STOP button will stop printout

inRun ← multiple ← FALSE;

os.PutRope["\nInteresting gfi's: "];

FOR i: CARDINAL IN [1..PrincOps.GFTIndex.LAST+1] WHILE ~h.m.singleStep DO

IF i <= PrincOps.GFTIndex.LAST AND igft[i] THEN

IF inRun THEN multiple ← TRUE

ELSE {

IF first THEN first ← FALSE ELSE os.PutRope[", "];

os.PutF["%g", [cardinal[i]]]; inRun ← TRUE; multiple ← FALSE}

ELSE {

IF multiple THEN os.PutF["-%g", [cardinal[i-1]]];

inRun ← multiple ← FALSE};

ENDLOOP;

os.PutRope["\n~~~~~~~~~~~~~~~\n"];

ExitTool[h];

EXITS

done => ExitTool[h];

END;

ClearGfiTable: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE] -- = TRUSTED BEGIN

handle: Handle ← NARROW[clientData]; -- get our data

IF ~EnterTool[handle] THEN RETURN;

BEGIN

ENABLE {

UNWIND => ExitTool[handle];

ABORTED => {handle.tsOut.PutText[" aborted"]; GO TO done}};

handle.m.interestingGfi^ ← ALL[FALSE];

ExitTool[handle];

EXITS

done => ExitTool[handle];

END;

MarkGfiByNumber: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE] -- = TRUSTED BEGIN

h: Handle ← NARROW[clientData]; -- get our data

rangeRope, token: ROPE;

gs: IO.STREAM;

sepr: ROPE ← "Marking Gfis:";

NumberScan: IO.BreakProc = TRUSTED {

RETURN [ SELECT char FROM

IN ['0..'9] => other,

',, '- => break,

ENDCASE => sepr]};

number, lower, upper: CARDINAL;

IF ~EnterTool[h] THEN RETURN;

BEGIN

ENABLE {

UNWIND => ExitTool[h];

ABORTED => {h.tsOut.PutText[" aborted"]; GO TO done}};

rangeRope ← ViewerTools.GetContents[h.cmd.gfiRange];

gs ← IO.RIS[rangeRope];

token ← IO.GetTokenRope[gs, NumberScan !IO.EndOfStream => EXIT].token;

number ← Convert.IntFromRope[token !

SafeStorage.NarrowFault, Convert.Error => {

MessageWindow.Append[message: "invalid number", clearFirst: TRUE];

EXIT}];

BEGIN -- find separator

token ← IO.GetTokenRope[gs, NumberScan !IO.EndOfStream => GO TO single].token;

SELECT Rope.Fetch[token, 0] FROM

', => GO TO single;

'- => {

[lower, ] ← GfiRange[number];

token ← IO.GetTokenRope[gs, NumberScan !IO.EndOfStream => EXIT].token;

number ← Convert.IntFromRope[token !

SafeStorage.NarrowFault, Convert.Error => {

MessageWindow.Append[message: "invalid number", clearFirst: TRUE];

EXIT}];

[, upper] ← GfiRange[number];

BEGIN -- eat comma

token ← IO.GetTokenRope[gs, NumberScan !IO.EndOfStream => GO TO ok].token;

IF Rope.Fetch[token, 0] # ', THEN {

MessageWindow.Append[message: "missing comma", clearFirst: TRUE];

EXIT};

EXITS

ok => NULL;

END;

};

ENDCASE => {

MessageWindow.Append[message: "bad syntax", clearFirst: TRUE]; EXIT};

EXITS

single => [lower, upper] ← GfiRange[number];

END;

h.tsOut.PutF["%g %g", [rope[sepr]], [integer[lower]]]; sepr ← ",";

IF upper # lower THEN h.tsOut.PutF["-%g", [integer[upper]]];

IF upper > PrincOps.GFTIndex.LAST THEN {

MessageWindow.Append[message: "out of range", clearFirst: TRUE];

ExitTool[h]; RETURN};

FOR i: CARDINAL IN [lower..upper] DO

h.m.interestingGfi[i] ← TRUE;

ENDLOOP;

h.tsOut.PutChar['\n];

ExitTool[h];

EXITS

done => ExitTool[h];

END;

MarkGFIByName: PROC [handle: Handle, name: ROPE] = {

wc, cc: AMModel.Context;

NoteMod: PROC [cx: AMModel.Context] RETURNS [stop: BOOL ← FALSE] = TRUSTED {

SELECT AMModel.ContextClass[cx] FROM

model => [] ← AMModel.ContextChildren[cx, NoteMod];

prog => {

tx: AMTypes.TV = AMModelBridge.FrameFromContext[cx];

gf: PrincOps.GlobalFrameHandle = AMBridge.GFHFromTV[tx];

first, last: CARDINAL;

[first, last] ← GfiRange[gf.gfi];

min ← MIN[min, first];

max ← MAX[max, last]};

ENDCASE;

};

min: CARDINAL ← CARDINAL.LAST;

max: CARDINAL ← CARDINAL.FIRST;

TRUSTED {wc ← AMModel.RootContext[WorldVM.LocalWorld[]]};

IF name = NIL THEN RETURN;

TRUSTED {cc ← AMModel.MostRecentNamedContext[name, wc]};

IF cc = NIL THEN {Output[handle, "*** MarkGFI: ", name, " not found\n"]; RETURN};

[] ← NoteMod[cc];

Output[handle, "MarkGFI: ", name, " gfi's are marked (", Convert.RopeFromInt[min], "-", Convert.RopeFromInt[max], ")\n"];

FOR i: CARDINAL IN [min..max] DO

handle.m.interestingGfi[i] ← TRUE;

ENDLOOP;

};

ZeroProc: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE] -- = TRUSTED BEGIN

handle: Handle ← NARROW[clientData]; -- get our data

IF ~EnterTool[handle] THEN RETURN;

BEGIN

ENABLE {

UNWIND => ExitTool[handle];

ABORTED => {handle.tsOut.PutText[" aborted"]; GO TO done}};

handle.m.iCount ← 0;

SetValue[handle.cmd.iCount, "0"];

ExitTool[handle];

EXITS

done => ExitTool[handle];

END;

EnterTool: ENTRY PROC [h: Handle] RETURNS [BOOL] = {

IF h.busy THEN {

MessageWindow.Append[message: "Already running", clearFirst: TRUE];

RETURN[FALSE]};

IF h.m = NIL THEN {

MessageWindow.Append[message: "Please initialize", clearFirst: TRUE];

RETURN[FALSE]};

h.busy ← TRUE;

RETURN[TRUE];

};

ExitTool: ENTRY PROC [h: Handle] = {UpdateDisplay[h]; h.busy ← FALSE};

Finalize: ENTRY PROC [h: Handle] = {

FinalizeInternal[h];

};

FinalizeInternal: INTERNAL PROC [h: Handle] = {

h.ready ← FALSE;

PrintSpeed[h];

h.killCountProcess ← TRUE;

NOTIFY h.running;

};

Initialize: PUBLIC PROC [handle: REF ANY, topProc: PROC] = {

h: Handle = NARROW[handle];

Init[h, topProc]};

Init: ENTRY PROC [h: Handle, topProc: PROC] = TRUSTED {

link: PrincOps.ControlLink = LOOPHOLE[topProc];

IF h.busy THEN {

MessageWindow.Append[message: "Stop before reinitializing", clearFirst: TRUE];

RETURN};

IF h.ready THEN FinalizeInternal[h];

ResetMachine[h.m];

h.m.opCount^ ← ALL[0];

h.m.history.head ← h.m.history.tail ← 0;

MarkInteresting[h.m, link.gfi];

DragomanPrivate.Xfer[

m: h.m, dst: link, src: DragomanPrivate.MagicReturn, push: FALSE];

h.ready ← TRUE;

h.busy ← FALSE;

UpdateDisplay[h];

h.killCountProcess ← FALSE;

Process.Detach[FORK ShowCount[h]];

};

MarkInteresting: PROC [m: Machine, gfi: PrincOps.GFTIndex] = {

first, last: CARDINAL;

[first, last] ← GfiRange[gfi];

FOR i: CARDINAL IN [first..last] DO m.interestingGfi[i] ← TRUE; ENDLOOP;

};

ResetMachine: PROC [m: Machine] = {

m.sd ← 0;

m.stack ← ALL[[0]];

m.l ← NIL;

m.g ← NIL;

m.cb ← NIL;

m.pc ← 0;

m.iCount ← 0;

m.outCalls ← 0;

m.singleStep ← FALSE;

m.breakGF ← NIL;

m.breakPC ← 0;

m.traceOps ← FALSE;

m.recordXferOut ← FALSE;

m.xferData ← NIL;

m.countOps ← FALSE;

m.flushOnCall ← FALSE;

m.startPulses ← 0;

m.startOps ← 0};

MarkGfiInTable: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE] -- = TRUSTED BEGIN

h: Handle ← NARROW[clientData]; -- get our data

rangeRope, token: ROPE;

gs: IO.STREAM;

sepr: ROPE ← "Marking Gfis:";

TokenScan: IO.BreakProc = TRUSTED {

RETURN [ SELECT char FROM

IN ['0..'9], IN ['A..'Z], IN ['a..'z] => other,

',, '- => break,

ENDCASE => sepr]};

number, lower, upper: CARDINAL;

IF ~EnterTool[h] THEN RETURN;

BEGIN

ENABLE {

UNWIND => ExitTool[h];

ABORTED => {h.tsOut.PutText[" aborted"]; GO TO done}};

rangeRope ← ViewerTools.GetContents[h.cmd.gfiRange];

gs ← IO.RIS[rangeRope];

token ← IO.GetTokenRope[gs, TokenScan !IO.EndOfStream => EXIT].token;

SELECT Rope.Fetch[token, 0] FROM

IN ['0..'9] => number ← Convert.IntFromRope[token !

SafeStorage.NarrowFault, Convert.Error => {

MessageWindow.Append[message: "invalid number", clearFirst: TRUE];

EXIT}];

IN ['A..'Z], IN ['a..'z] => {

MarkGFIByName[h, token];

token ← IO.GetTokenRope[gs, TokenScan !IO.EndOfStream => EXIT].token;

IF Rope.Fetch[token, 0] # ', THEN {

MessageWindow.Append[message: "bad syntax", clearFirst: TRUE]; EXIT};

LOOP};

ENDCASE;

BEGIN -- find separator

token ← IO.GetTokenRope[gs, TokenScan !IO.EndOfStream => GO TO single].token;

SELECT Rope.Fetch[token, 0] FROM

', => GO TO single;

'- => {

[lower, ] ← GfiRange[number];

token ← IO.GetTokenRope[gs, TokenScan !IO.EndOfStream => EXIT].token;

number ← Convert.IntFromRope[token !

SafeStorage.NarrowFault, Convert.Error => {

MessageWindow.Append[message: "invalid number", clearFirst: TRUE];

EXIT}];

[, upper] ← GfiRange[number];

BEGIN -- eat comma

token ← IO.GetTokenRope[gs, TokenScan !IO.EndOfStream => GO TO ok].token;

IF Rope.Fetch[token, 0] # ', THEN {

MessageWindow.Append[message: "missing comma", clearFirst: TRUE];

EXIT};

EXITS

ok => NULL;

END;

};

ENDCASE => {

MessageWindow.Append[message: "bad syntax", clearFirst: TRUE]; EXIT};

EXITS

single => [lower, upper] ← GfiRange[number];

END;

h.tsOut.PutF["%g %g", [rope[sepr]], [integer[lower]]]; sepr ← ",";

IF upper # lower THEN h.tsOut.PutF["-%g", [integer[upper]]];

IF upper > PrincOps.GFTIndex.LAST THEN {

MessageWindow.Append[message: "out of range", clearFirst: TRUE];

ExitTool[h]; RETURN};

FOR i: CARDINAL IN [lower..upper] DO

h.m.interestingGfi[i] ← TRUE;

ENDLOOP;

h.tsOut.PutChar['\n];

ExitTool[h];

EXITS

done => ExitTool[h];

END;

ShowCount: ENTRY PROC [h: Handle] = {

m: Machine = h.m;

IF m = NIL THEN RETURN;

TRUSTED {Process.InitializeCondition[@h.pauseTime, Process.MsecToTicks[1000]]};

WHILE ~h.killCountProcess DO

WHILE (~h.busy OR h.m.singleStep) DO

WAIT h.running;

IF h.killCountProcess THEN RETURN;

ENDLOOP;

WAIT h.pauseTime;

SetValue[h.cmd.iCount, Convert.RopeFromInt[m.iCount]];

ENDLOOP;

};

UpdateDisplay: PROC [handle: Handle] = {

m: Machine = handle.m;

IF m = NIL THEN RETURN;

SetValue[handle.cmd.iCount, Convert.RopeFromInt[m.iCount]];

SetValue[handle.cmd.pc, Convert.RopeFromInt[m.pc, 8]];

DisplayStack[handle];

SetValue[handle.cmd.lf, Convert.RopeFromInt[LOOPHOLE[m.l, CARDINAL], 8]];

DisplayLfName[handle];

SetValue[handle.cmd.gf, Convert.RopeFromInt[LOOPHOLE[m.g, CARDINAL], 8]];

DisplayGfName[handle];

DisplayLocals[handle];

DisplayNextOp[handle];

};

DisplayLfName: PROC [handle: Handle] = TRUSTED {

m: Machine = handle.m;

BEGIN ENABLE AMTypes.Error, SafeStorage.NarrowFault => GO TO forgetIt;

ftv: TV ← AMBridge.TVForFrame[fh: LOOPHOLE[m.l]];

ptv: TV ← AMTypes.Procedure[ftv];

name ← AMTypes.TVToName[ptv];

EXITS

forgetIt => name ← NIL;

END;

SetValue[handle.cmd.lfName, name]};

DisplayGfName: PROC [handle: Handle] = TRUSTED {

m: Machine = handle.m;

BEGIN ENABLE AMTypes.Error, SafeStorage.NarrowFault => GO TO forgetIt;

ftv: TV ← AMBridge.TVForGFHReferent[LOOPHOLE[m.g]];

name ← AMTypes.TVToName[ftv];

EXITS

forgetIt => name ← NIL;

END;

SetValue[handle.cmd.gfName, name]};

DisplayStack: PROC [handle: Handle] = {

m: Machine = handle.m;

i: CARDINAL;

FOR i ← 0, i+1 WHILE i < PrincOps.stackDepth AND i < m.sd DO

l: ViewerClasses.Viewer = handle.cmd.stk[i];

SetValue[l, Convert.RopeFromInt[m.stack[i], 8]];

ENDLOOP;

IF handle.show2Above^ THEN

WHILE i < MIN[m.sd+2, PrincOps.stackDepth] DO

l: ViewerClasses.Viewer = handle.cmd.stk[i];

SetValue[l, Rope.Cat["<", Convert.RopeFromInt[m.stack[i], 8], ">"]];

i ← i + 1;

ENDLOOP;

WHILE i < PrincOps.stackDepth DO

l: ViewerClasses.Viewer = handle.cmd.stk[i];

SetValue[l, NIL];

i ← i + 1;

ENDLOOP;

};

DisplayLocals: PROC [handle: Handle] = TRUSTED {

m: Machine = handle.m;

maxShown: CARDINAL = PrincOps.stackDepth;

lSize: CARDINAL;

i: CARDINAL;

fsi: CARDINAL;

local: POINTER TO ARRAY [0..maxShown) OF CARDINAL = LOOPHOLE[m.l];

IF local = NIL OR (LOOPHOLE[local, CARDINAL] MOD 4 # 0) THEN RETURN;

fsi ← LOOPHOLE[local-1, POINTER TO CARDINAL]^;

lSize ← IF fsi IN PrincOps.FrameSizeIndex THEN PrincOps.FrameVec[fsi] ELSE 0;

FOR i ← 0, i+1 WHILE i < maxShown AND i < lSize DO

l: Labels.Label = handle.cmd.lcl[i];

SetValue[l, Convert.RopeFromInt[local[i], 8]];

ENDLOOP;

WHILE i < maxShown DO

l: Labels.Label = handle.cmd.lcl[i];

SetValue[l, NIL];

i ← i + 1;

ENDLOOP;

};

JumpOp: TYPE = [PrincOps.zJ2..PrincOps.zJIW];

DisplayNextOp: PROC [handle: Handle] = TRUSTED {

m: Machine = handle.m;

opData: ListerUtils.OpCodeArray ← DragomanOpDebug.OpData[];

cb: LONG POINTER TO PACKED ARRAY [0..0) OF Byte = m.cb;

op: ARRAY [0..3) OF Byte ← [cb[m.pc], 0, 0];

IF opData # NIL THEN SELECT opData[op[0]].length FROM

2 => op[1] ← cb[m.pc+1];

3 => {op[2] ← cb[m.pc+2]; op[1] ← cb[m.pc+1]};

ENDCASE;

SetValue[handle.cmd.nextOp, DragomanOpDebug.RopeForOperation[op, m.pc]];

};

Output: PUBLIC PROC [handle: Handle, r1, r2, r3, r4, r5, r6, r7, r8: ROPE ← NIL] = {

PR: PROC [r: ROPE] = INLINE {IF r # NIL THEN IO.PutRope[handle.tsOut, r]};

PR[r1]; PR[r2]; PR[r3]; PR[r4]; PR[r5]; PR[r6]; PR[r7]; PR[r8]};

DumpCounts: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE] -- = TRUSTED

BEGIN

h: Handle ← NARROW[clientData]; -- get our data

IF h.m.countOps THEN DragomanPrivate.PrintOpCounts[h.tsOut, h.m]

ELSE h.tsOut.PutRope["\nOpcodes not being counted\n"];

END;

DumpTrace: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE] -- = TRUSTED

BEGIN

handle: Handle ← NARROW[clientData]; -- get our data

PrintHistory[handle.tsOut, handle, TRUE];

UpdateDisplay[handle];

END;

DumpXferData: Buttons.ButtonProc -- [parent: REF ANY, clientData: REF ANY ← NIL, mouseButton: Menus.MouseButton ← red, shift: BOOL ← FALSE, control: BOOL ← FALSE] -- = TRUSTED

BEGIN

h: Handle ← NARROW[clientData]; -- get our data

IF h.m.recordXferOut THEN DragomanPrivate.PrintProcCounts[h.tsOut, h.m]

ELSE h.tsOut.PutRope["\nXfers not being counted\n"];

END;

PrintHistory: PUBLIC PROC [os: IO.STREAM, h: Handle, modNames: BOOL] = {

history: DragomanPrivate.OpHistory ← h.m.history;

Octal: PROC [n: INT] RETURNS [IO.Value] = {

RETURN [[rope[Convert.RopeFromInt[n, 8, n>7]]]]};

ShortOctal: PROC [n: CARDINAL] RETURNS [IO.Value] = {

RETURN [[rope[Convert.RopeFromInt[n, 8, n>7]]]]};

PrintItem: PROC [item: DragomanPrivate.OpHistoryItem] = TRUSTED {

cgf: CARDINAL ← LOOPHOLE[item.gf];

os.PutF["%6g %6g %g",

Octal[cgf], Octal[item.pc],

[rope[DragomanOpDebug.RopeForOperation[item.op, item.pc]]]];

IF item.stkDepth # 0 THEN {

os.PutF["\t%g", ShortOctal[item.stk[0]]];

FOR j: CARDINAL IN [1..item.stkDepth) DO

os.PutF[", %g", ShortOctal[item.stk[j]]];

ENDLOOP;

};

IF modNames THEN {

ENABLE AMTypes.Error, SafeStorage.NarrowFault => GO TO forgetIt;

ftv: AMTypes.TV ← AMBridge.TVForGFHReferent[item.gf];

os.PutF["\t%g\n", [rope[name]]]

EXITS

forgetIt => NULL;

}

ELSE os.PutChar['\n]};

os.PutRope["\n~~~~~~~~~~~~~~~~~~~~~~~~~\n"];

FOR i: CARDINAL ← history.head, (i+1) MOD DragomanPrivate.OpHistorySize WHILE i # history.tail DO

PrintItem[history.data[i]];

ENDLOOP;

RETURN};

Commander.Register[key: "DragomanDebug", proc: MakeTool,

doc: "Create a window interface for Dragoman" ];

END.