SoftcardToolQuadIOImpl.mesa
Copyright Ó 1987 by Xerox Corporation. All rights reserved.
Don Curry, March 16, 1987 5:11:02 pm PST
Willie-Sue, March 19, 1987 12:43:24 pm PST
DIRECTORY
AMBridge USING [SomeRefFromTV, TVForReferent],
AMTypes USING [TV],
Buttons USING [Create],
Convert USING [CardFromRope],
FS USING [Error, FileInfo, StreamOpen],
Interpreter USING [Evaluate],
IO,
Labels USING [Create, Set],
Rope,
SoftcardOps,
SoftcardToolPrivate,
SymTab USING [Create, Ref, Store],
ViewerTools USING [GetContents, MakeNewTextViewer, SetSelection];
SoftcardToolQuadIOImpl: CEDAR PROGRAM
IMPORTS
AMBridge, Interpreter,
Buttons, Convert, FS, IO, Labels, Rope, SymTab, ViewerTools,
SoftcardOps, SoftcardToolPrivate
EXPORTS SoftcardToolPrivate =
BEGIN OPEN SoftcardToolPrivate;
Word: TYPE = CARD32;
STREAM: TYPE = IO.STREAM;
ROPE: TYPE = Rope.ROPE;
Memory: TYPE = REF MemoryRec;
MemoryRec: TYPE = RECORD [sym: SymTab.Ref, wds: REF MemWords];
MemWords: TYPE = RECORD [SEQUENCE size: CARDINAL OF MemWord];
MemWord: TYPE = RECORD [addr, value: Word];
quadMemory: Memory;
quadFileNameText: Viewer;
interpAddrWhatText, showInterpAddr: Viewer;
BuildQuadIOButtons: PUBLIC PROC[topViewer, sibx: Viewer] RETURNS[sib: Viewer] = {
sib ← sibx;
Load Quad file (dragon code)
sib ← Buttons.Create[
info: [ name: " LoadQuadFile ", parent: topViewer,
 wx: leftEdge, wy: sib.wy+sib.wh+betweenHeight, wh: entryHeight,
 border: TRUE, scrollable: FALSE],
font: activeFont, proc: LoadQuadFileProc ];
sib ← Buttons.Create[
info: [ name: " fileName: ", parent: topViewer,
 wx: sib.wx+sib.ww+xFudge, wy: sib.wy, wh: entryHeight,
 border: FALSE, scrollable: FALSE],
font: selectFont, proc: QuadFileNameProc ];
sib ← quadFileNameText ← ViewerTools.MakeNewTextViewer[
info: [parent: topViewer, wx: sib.wx+sib.ww+xFudge+6, wy: sib.wy,
 ww: 300, wh: entryHeight, border: FALSE, scrollable: FALSE]];
Interpret symbol for dragon code
sib ← Buttons.Create[
info: [ name: " Interpret ", parent: topViewer,
 wx: leftEdge, wy: sib.wy+sib.wh+betweenHeight, wh: entryHeight,
 border: TRUE, scrollable: FALSE],
font: activeFont, proc: InterpAddrProc ];
sib ← Buttons.Create[
info: [ name: " what: ", parent: topViewer,
 wx: sib.wx+sib.ww+xFudge, wy: sib.wy, wh: entryHeight,
 border: FALSE, scrollable: FALSE],
font: selectFont, proc: InterpAddrWhatProc ];
sib ← interpAddrWhatText ← ViewerTools.MakeNewTextViewer[
info: [parent: topViewer, wx: sib.wx+sib.ww+xFudge+6, wy: sib.wy,
 ww: 200, wh: entryHeight, border: FALSE, scrollable: FALSE]];
sib ← Labels.Create[
info: [ name: " address: ", parent: topViewer,
 wx: sib.wx+sib.ww+xFudge, wy: sib.wy, wh: entryHeight,
 border: FALSE, scrollable: FALSE],
font: labelFont ];
sib ← showInterpAddr ← Labels.Create[
info: [ name: " ", parent: topViewer,
 wx: sib.wx+sib.ww+xFudge, wy: sib.wy, wh: entryHeight,
 border: FALSE, scrollable: FALSE]
];
RETURN[sib];
};
LoadQuadFileProc: ClickProc = {
fName: ROPE ← ViewerTools.GetContents[quadFileNameText];
fullName: ROPE;
numLeft: CARD16 ← 0;
indexThisRound, pushIndex: CARD16 ← 0;
PushAddrVal: PROC RETURNS[addr: SoftcardOps.Addr, value: CARD32] = {
addr ← quadMemory.wds[pushIndex].addr;
value ← quadMemory.wds[pushIndex].value;
pushIndex ← pushIndex + 1;
};
IF fName.Length[] = 0 THEN {
TSOutPutRope["\n**** Please fill in the name of a quad file\n"];
RETURN
};
fullName ← FS.FileInfo[name: fName, remoteCheck: FALSE, wDir: regDir
! FS.Error => {
TSOutPutRope[error.explanation];
TSOutPutChar['\n];
GOTO nogood } ].fullFName;
quadMemory ← ReadQuadFile[fullName];
IF quadMemory = NIL THEN RETURN;  -- some error, already reported
numLeft ← quadMemory.wds.size;
WHILE numLeft > 256 DO
SoftcardOps.WriteMultipleLong[256, PushAddrVal];
numLeft ← numLeft - 256;
ENDLOOP;
IF numLeft > 0 THEN SoftcardOps.WriteMultipleLong[numLeft, PushAddrVal];
TSOutPutF["\n\tQuadFile %g (%g instructions) has been loaded\n\n",
[rope[fullName]], [cardinal[quadMemory.wds.size]] ];
EXITS
nogood => NULL;
};
QuadFileNameProc: ClickProc =
{ ViewerTools.SetSelection[quadFileNameText, NIL] };
InterpAddrProc: ClickProc = {
what: ROPE = ViewerTools.GetContents[interpAddrWhatText];
rp: ROPE;
addr: CARD32;
ok: BOOL;
IF what.Length[] = 0 THEN {
TSOutPutRope["\n Please fill in the Interpret waht field\n"];
RETURN
};
[ok, addr] ← InterpAddr[what, quadMemory];
IF ok = FALSE THEN {
Labels.Set[showInterpAddr, " ??? "];
RETURN;
};
Labels.Set[showInterpAddr, rp ← IO.PutFR["0%xH", [cardinal[addr]]] ];
TSOutPutF["Expression \"%g\" has dragon address %g\n",
[rope[what]], [rope[rp]] ];
};
InterpAddrWhatProc: ClickProc =
{ ViewerTools.SetSelection[interpAddrWhatText, NIL] };
ReadQuadFile: PROC[fileName: ROPE] RETURNS[mem: Memory] = {
quadFile: STREAMFS.StreamOpen[fileName];
count: INT ← 0;
list: LIST OF MemWord ← NIL;
mem ← NEW[MemoryRec ← [sym: SymTab.Create[]]];
DO
Skip: PROC [source: STREAM, c: CHAR] RETURNS[BOOL] ~ {
ch: CHAR;
[] ← source.SkipWhitespace[];
IF (ch ← source.GetChar[]) # c THEN {
TSOutPutF[" Bad char %g (expected %g) at pos %g in quadFile %g - quitting\n",
[character[c]], [character[ch]], [integer[source.GetIndex[]]], [rope[fileName]] ];
RETURN[FALSE];
};
RETURN[TRUE];
};
tokenKind: IO.TokenKind;
token: ROPE;
addr, value: Word;
[tokenKind, token] ← quadFile.GetCedarTokenRope[! IO.EndOfStream => EXIT];
SELECT tokenKind FROM
tokenDECIMAL,
tokenOCTAL,
tokenHEX => {
addr ← Convert.CardFromRope[token];
value ← 0;
IF ~Skip[quadFile, '/] THEN {
quadFile.Close[];
RETURN[NIL];
};
THROUGH [0..4) DO value ← value*100H + quadFile.GetCard[] ENDLOOP;
list ← CONS[[addr, value], list];
count ← count+1
};
tokenID => {
IF ~Skip[quadFile, '=] THEN {
quadFile.Close[];
RETURN[NIL];
};
addr ← quadFile.GetCard[];
[] ← SymTab.Store[mem.sym, token, TVFromRef[NEW[Word ← addr]]]
};
tokenEOF => EXIT;
ENDCASE => {
TSOutPutF["\n****Unknown tokenKind in quadFile %g at pos %g - quitting\n",
[rope[fileName]], [integer[quadFile.GetIndex[]]] ];
quadFile.Close[];
RETURN[NIL];
};
ENDLOOP;
quadFile.Close[];
mem.wds ← NEW[MemWords[count]];
FOR i: INT DECREASING IN [0..count) DO
mem.wds[i] ← list.first;
list ← list.rest
ENDLOOP;
};
InterpAddr: PUBLIC PROC[addRope: ROPE, mem: Memory] RETURNS[ok: BOOL, addr: Word] = {
result: AMTypes.TV;
errorRope: ROPE;
noResult: BOOL;
refCard: REF;
[result, errorRope, noResult] ← Interpreter.Evaluate[addRope, NIL, LIST[mem.sym]];
IF noResult THEN {
addr ← 0;
TSOutPutF["\n*****Could not interpret \"%g\" - quitting\n", [rope[addRope]] ];
RETURN[FALSE, addr]};
refCard ← RefFromTV[result];
WITH refCard SELECT FROM
word: REF Word => {RETURN[TRUE, word^]};
card: REF LONG CARDINAL => {RETURN[TRUE, card^]};
int: REF INT => {
IF int^ < 0 THEN RETURN[FALSE, 0];
RETURN[TRUE, int^]
};
ENDCASE => {
TSOutPutF["\n*****Unknown variant for \"%g\" - quitting\n", [rope[addRope]] ];
RETURN[FALSE, 0];
};
};
TVFromRef: PROC [ref: REF] RETURNS [AMTypes.TV] = TRUSTED
{ RETURN [AMBridge.TVForReferent[ref]] };
RefFromTV: PROC [tv: REF] RETURNS [REF] = {
IF tv = NIL THEN RETURN [NIL];
IF ~ISTYPE [tv, AMTypes.TV] THEN ERROR;
TRUSTED {RETURN [AMBridge.SomeRefFromTV[tv]]}
};
END.