HandCodingDriver.mesa
Copyright © 1984 by Xerox Corporation. All rights reserved.
Russ Atkinson (RRA) July 15, 1985 9:54:40 pm PDT
DIRECTORY
AMModel USING [Context, ContextSection, MostRecentNamedContext, RootContext, SectionVersion],
Basics USING [bytesPerWord],
BasicTime USING [Now],
BcdDefs USING [VersionStamp],
Commander USING [CommandProc, Register],
Convert,
DragOpsCross,
DragOpsCrossUtils,
FS,
HandCodingPseudos,
HandCodingSupport,
Interpreter USING [Evaluate],
IO,
IOUtils,
Loader USING [Instantiate, IRItem],
PrincOps USING [ControlModule],
Process USING [CheckForAbort],
RefText,
Rope,
SparseMemory USING [Base, Create, Fetch, Store],
UserCredentials USING [Get],
WorldVM USING [LocalWorld],
WriteSparseMemory USING [ToStream];
HandCodingDriver:
CEDAR
PROGRAM
IMPORTS AMModel, BasicTime, Commander, Convert, DragOpsCrossUtils, FS, HandCodingPseudos, HandCodingSupport, Interpreter, IO, IOUtils, Loader, Process, RefText, Rope, SparseMemory, UserCredentials, WorldVM, WriteSparseMemory
= BEGIN
CARD: TYPE = LONG CARDINAL;
IRList: TYPE = LIST OF Loader.IRItem;
Label: TYPE = HandCodingPseudos.Label;
LORA: TYPE = LIST OF REF ANY;
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
VersionStamp: TYPE = BcdDefs.VersionStamp;
Word: TYPE = DragOpsCross.Word;
HandCodingDriverCommand: Commander.CommandProc = {
[cmd: Handle] RETURNS [result: REF ← NIL, msg: ROPE ← NIL]
CommandObject = [
in, out, err: STREAM, commandLine, command: ROPE,
propertyList: List.AList, procData: CommandProcHandle]
cmdStream: STREAM = IO.RIS[cmd.commandLine];
listOfTokens: LIST OF ROPE ← NIL;
tailOfTokens: LIST OF ROPE ← NIL;
len: INT ← 0;
mem: SparseMemory.Base = SparseMemory.Create[];
area: HandCodingSupport.Area ← NIL;
outputName: ROPE ← NIL;
byteOutput: BOOL ← FALSE;
wordOutput: BOOL ← FALSE;
displayCode: BOOL ← FALSE;
execute: BOOL ← FALSE;
useHex: BOOL ← FALSE;
inner:
PROC =
TRUSTED {
root: AMModel.Context = AMModel.RootContext[WorldVM.LocalWorld[]];
FOR each:
LIST
OF
ROPE ← listOfTokens, each.rest
WHILE each #
NIL
DO
token: ROPE ← each.first;
short: ROPE = ShortName[token];
len: INT = Rope.Length[short];
dot: INT = TrailingDot[short];
procName: ROPE ← IF dot < len THEN Rope.Flatten[short, dot+1] ELSE NIL;
modName: ROPE = Rope.Flatten[short, 0, dot];
modCtx: AMModel.Context ← AMModel.MostRecentNamedContext[modName, root];
errorRope: ROPE ← NIL;
ctxVersion, fileVersion: VersionStamp;
fileName: ROPE ← ReplaceSuffix[token, "bcd"];
fileStream: STREAM;
Process.CheckForAbort[];
IF Rope.Equal[GetSuffix[token], "quad",
FALSE]
THEN {
This is a memory dump file to load, not a bcd to execute!
fileStream ←
FS.StreamOpen[token
!
FS.Error =>
IF error.group # bug
THEN {
IO.PutF[cmd.err, "Warning! Could not open %g\n (%g)\n",
[rope[fileName]], [rope[error.explanation]]];
LOOP}];
fileName ← FS.GetName[FS.OpenFileFromStream[fileStream]].fullFName;
LoadMemory[fileStream, cmd.err];
IO.Close[fileStream];
LOOP;
};
fileStream ←
FS.StreamOpen[fileName
!
FS.Error =>
IF error.group # bug
THEN {
IO.PutF[cmd.err, "Warning! Could not open %g\n (%g)\n",
[rope[fileName]], [rope[error.explanation]]];
LOOP}];
fileName ← FS.GetName[FS.OpenFileFromStream[fileStream]].fullFName;
Read the version stamp of the file to determine if it needs loading since the last time.
IO.SetIndex[fileStream, SIZE[CARDINAL]*Basics.bytesPerWord];
[] ←
IO.UnsafeGetBlock[fileStream, [
base: LOOPHOLE[LONG[@fileVersion]],
startIndex: 0,
count: SIZE[VersionStamp]*Basics.bytesPerWord]];
Get the version stamp of the loaded bcd.
IF modCtx #
NIL
THEN
ctxVersion ← AMModel.SectionVersion[AMModel.ContextSection[modCtx]];
IF modCtx =
NIL
OR ctxVersion # fileVersion
THEN {
We must try to load this file dynamically, since it has either not been loaded, or it
msg: ROPE ← NIL;
unboundImports: IRList ← NIL;
cm: PrincOps.ControlModule;
file: FS.OpenFile = FS.OpenFileFromStream[fileStream];
IO.PutF[cmd.err, "Note: loading %g\n", [rope[fileName]]];
[cm, unboundImports] ← Loader.Instantiate[file];
IF unboundImports #
NIL
THEN {
IO.PutRope[cmd.err, "Warning! Unbound imports:"];
FOR eachIR: IRList ← unboundImports, eachIR.rest
WHILE eachIR #
NIL
DO
IO.PutF[cmd.err, " %g#%g",
[rope[eachIR.first.interfaceName]], [integer[eachIR.first.index]]]
ENDLOOP;
IO.PutRope[cmd.err, "\n"];
};
};
IO.Close[fileStream];
At this point we have found the named module, and we want to find the named procedure in the module, if there is one. If one was not specified, default to "All".
IF Rope.Length[procName] = 0 THEN procName ← "All";
[errorRope: errorRope] ← Interpreter.Evaluate[Rope.Cat[modName, ".", procName, "[]"]];
IF errorRope #
NIL
THEN {
IO.PutF[cmd.err, "Warning! Could not evaluate %g\n (%g)\n",
[rope[token]], [rope[errorRope]]];
};
ENDLOOP;
};
DO
token: ROPE = IO.GetTokenRope[cmdStream, IO.IDProc ! IO.EndOfStream => EXIT].token;
new: LIST OF ROPE = LIST[token];
IF listOfTokens =
NIL
AND Rope.Match["-*", token]
THEN {
If the first name starts with a "-", then it is really an option, not a file name. Options are single characters, but we may have any number of option strings. Negation of options is not allowed, since all of them default to FALSE anyway.
FOR i:
INT
IN [1..Rope.Length[token])
DO
SELECT Rope.Fetch[token, i]
FROM
'b => byteOutput ← TRUE;
'c => displayCode ← byteOutput ← TRUE;
'e, 'x => execute ← TRUE;
'h => useHex ← TRUE;
'w => wordOutput ← TRUE;
ENDCASE;
ENDLOOP;
LOOP;
};
IF tailOfTokens = NIL THEN listOfTokens ← new ELSE tailOfTokens.rest ← new;
tailOfTokens ← new;
len ← len + 1;
ENDLOOP;
IF len = 0
THEN {
msg ← "Usage: Quad list-of-procedures\n OR Quad file ← list-of-procedures\n";
RETURN
};
IF len > 1
AND Rope.Equal[listOfTokens.rest.first, "←"]
THEN {
An output file has been specified
outputName ← ReplaceSuffix[listOfTokens.first, "quad"];
listOfTokens ← listOfTokens.rest.rest;
len ← len - 2;
}
ELSE {
The output file comes from the file name of the first thing
outputName ← "Default.quad$";
};
area ← HandCodingSupport.NewArea[$Quad, GetWord, PutWord, mem];
HandCodingSupport.Gen1WithArea[area, inner];
This causes the named files to be executed.
IF byteOutput
OR wordOutput
THEN {
Dump the contents to the output stream
st: STREAM = FS.StreamOpen[fileName: outputName, accessOptions: create, keep: 2];
IO.PutF[cmd.err, " Quad output to %g", [rope[outputName]]];
SetOutputBase[st, useHex];
First output the header information that identifies how this file was created.
IO.PutF[st, "-- %g\n-- %g at %g\n",
[rope[outputName]], [rope[UserCredentials.Get[].name]], [time[BasicTime.Now[]]]];
IO.PutF[st, "-- input: %g\n", [rope[cmd.commandLine]]];
HandCodingPseudos.ShowGlobalLabelTable[st, TRUE, area];
HandCodingPseudos.ShowGlobalLabelTable[st, FALSE, area];
Finally, dump the memory contents and close the output stream.
WriteSparseMemory.ToStream[
st: st, base: mem, byteOutput: byteOutput, displayCode: displayCode];
IO.Close[st];
};
IF execute
THEN {
Execute the memory
innerExec:
PROC = {
errorRope: ROPE ← NIL;
execCmd: ROPE ← "LizardToolDriver.Exec1[]";
[errorRope: errorRope] ← Interpreter.Evaluate[execCmd];
IF errorRope #
NIL
THEN {
IO.PutF[cmd.err, "Warning! Could not evaluate %g\n (%g)\n",
[rope[execCmd]], [rope[errorRope]]];
};
};
HandCodingSupport.Gen1WithArea[area, innerExec];
};
msg ← "\n";
};
GetWord: HandCodingSupport.GetProc = {
[data: REF, pc: INT] RETURNS [Word]
base: SparseMemory.Base = NARROW[data];
RETURN [SparseMemory.Fetch[base, DragOpsCrossUtils.IntToWord[pc]]];
};
PutWord: HandCodingSupport.PutProc = {
[data: REF, pc: INT, word: Word]
base: SparseMemory.Base = NARROW[data];
SparseMemory.Store[base, DragOpsCrossUtils.IntToWord[pc], word];
};
LoadMemory:
PROC [st:
STREAM, errs:
STREAM] = {
area: HandCodingSupport.Area = HandCodingSupport.GetCurrentArea[];
buffer: REF TEXT ← NEW[TEXT[64]];
kind: IO.TokenKind ← tokenEOF;
pBuffer: REF TEXT ← NEW[TEXT[64]];
pKind: IO.TokenKind ← tokenEOF;
Next:
PROC = {
IF pKind = tokenEOF
THEN {
buffer.length ← 0;
[tokenKind: kind, token: buffer] ← IO.GetCedarToken[st, buffer]}
ELSE {
temp: REF TEXT ← buffer;
buffer ← pBuffer;
pBuffer ← temp;
kind ← pKind;
pKind ← tokenEOF};
};
Peek:
PROC
RETURNS [c:
CHAR ← 0C]= {
IF pKind = tokenEOF
THEN {
pBuffer.length ← 0;
[tokenKind: pKind, token: pBuffer] ← IO.GetCedarToken[st, pBuffer];
};
IF pBuffer.length = 1 THEN c ← pBuffer[0];
};
definition: ROPE ← NIL;
wordMode: BOOL ← TRUE;
DO
name: ROPE ← NIL;
word: Word ← DragOpsCross.ZerosWord;
undefined: BOOL ← FALSE;
Next[];
SELECT kind
FROM
tokenID => {
label: Label ← NIL;
name ← Rope.FromRefText[buffer];
WHILE Peek[] = '.
DO
This is a complex name
Next[]; Next[];
IF kind # tokenID THEN GO TO syntaxError;
name ← Rope.Cat[name, ".", Rope.FromRefText[buffer]];
ENDLOOP;
label ← HandCodingPseudos.GetGlobalLabel[name];
IF label =
NIL
THEN {
undefined ← TRUE;
}
ELSE {
word ← DragOpsCrossUtils.IntToWord[label.offset];
};
};
tokenDECIMAL => {
word ← DragOpsCrossUtils.CardToWord[
Convert.CardFromDecimalLiteral[RefText.TrustTextAsRope[buffer]]];
};
tokenOCTAL => {
word ← DragOpsCrossUtils.CardToWord[
Convert.CardFromOctalLiteral[RefText.TrustTextAsRope[buffer]]];
};
tokenHEX => {
word ← DragOpsCrossUtils.CardToWord[
Convert.CardFromHexLiteral[RefText.TrustTextAsRope[buffer]]];
};
tokenREAL => {
This is a hack for REAL literals. We hope that the bits put out by Cedar are the right bits for the REAL literals (they should be, but floating point is rather hard to get exactly right).
word ← DragOpsCrossUtils.CardToWord[
LOOPHOLE[Convert.RealFromLiteral[RefText.TrustTextAsRope[buffer]]]];
};
tokenEOF => EXIT;
ENDCASE => GO TO syntaxError;
IF Peek[] = '=
THEN {
The preceeding name was a definition
Next[];
definition ← name;
LOOP;
};
IF definition #
NIL
THEN {
Create a label, and make its definition global
card: CARD = HandCodingSupport.GetOutputPC[area];
IF undefined
THEN {
At this point we put out a message about undefined crap. The new label is also not defined!
IO.PutF[errs, "Warning: '%g' is undefined.\n", [rope[name]]];
LOOP;
};
HandCodingSupport.SetOutputPC[DragOpsCrossUtils.WordToCard[word], area];
HandCodingPseudos.MakeLabelGlobal[definition, HandCodingPseudos.GenLabelHere[]];
HandCodingSupport.SetOutputPC[card, area];
definition ← NIL;
LOOP;
};
SELECT Peek[]
FROM
': => {
The preceeding word was a word address
word ← DragOpsCrossUtils.WordAddressToBytePC[word];
HandCodingSupport.SetOutputPC[DragOpsCrossUtils.WordToCard[word], area];
Next[];
wordMode ← TRUE;
};
'/ => {
The preceeding word was a byte address
HandCodingSupport.SetOutputPC[DragOpsCrossUtils.WordToCard[word], area];
Next[];
wordMode ← FALSE;
};
ENDCASE => {
The preceeding word was a byte or word datum. If the item is larger than a byte, output a word anyway (helpful for addresses).
IF wordMode
OR DragOpsCrossUtils.WordToCard[word] > 255
THEN HandCodingSupport.OutputWord[area, word]
ELSE HandCodingSupport.OutputByte[area, DragOpsCrossUtils.WordToBytes[word][3]]
};
IF undefined
THEN {
At this point we put out a message about undefined crap.
IO.PutF[errs, "Warning: '%g' is undefined.\n", [rope[name]]];
};
ENDLOOP;
EXITS syntaxError => {
IO.PutF[errs, "Error: bad syntax near %g, aborting the read.\n",
[integer[IO.GetIndex[st]]]];
};
};
ReplaceSuffix:
PROC [base:
ROPE, suffix:
ROPE]
RETURNS [
ROPE] = {
len: INT ← Rope.Length[base];
pos: INT ← len;
WHILE pos > 0
DO
SELECT Rope.Fetch[base, pos ← pos - 1]
FROM
'. => RETURN [Rope.Replace[base, pos+1, len, suffix]];
'! => RETURN [base];
'], '>, '/ => EXIT;
ENDCASE;
ENDLOOP;
RETURN [Rope.Cat[base, ".", suffix]];
};
GetSuffix:
PROC [base:
ROPE]
RETURNS [
ROPE] = {
len: INT ← Rope.Length[base];
pos: INT ← len;
bang: INT ← len;
WHILE pos > 0
DO
SELECT Rope.Fetch[base, pos ← pos - 1]
FROM
'. => {
pos ← pos + 1;
RETURN [Rope.Substr[base, pos, bang-pos]]};
'! => bang ← pos;
'], '>, '/ => EXIT;
ENDCASE;
ENDLOOP;
RETURN [base];
};
TrailingDot:
PROC [base:
ROPE]
RETURNS [
INT] = {
len: INT ← Rope.Length[base];
pos: INT ← len;
WHILE pos > 0
DO
SELECT Rope.Fetch[base, pos ← pos - 1]
FROM
'. => RETURN [pos];
'!, '], '>, '/ => EXIT;
ENDCASE;
ENDLOOP;
RETURN [len];
};
ShortName:
PROC [base:
ROPE]
RETURNS [
ROPE] = {
len: INT ← Rope.Length[base];
pos: INT ← len;
bang: INT ← len;
WHILE pos > 0
DO
SELECT Rope.Fetch[base, pos ← pos - 1]
FROM
'! => bang ← pos;
'], '>, '/ => RETURN [Rope.Flatten[base, pos+1, bang-pos-1]];
ENDCASE;
ENDLOOP;
RETURN [Rope.Flatten[base, 0, bang]];
};
SetOutputBase:
PROC [st:
STREAM, useHex:
BOOL ←
FALSE] =
TRUSTED {
pfProcs: IOUtils.PFProcs = IOUtils.CopyPFProcs[st];
[] ← IOUtils.SetPFCodeProc[
pfProcs, 'w, IF useHex THEN CodeWHexProc ELSE CodeWOctalProc];
[] ← IOUtils.SetPFProcs[st, pfProcs];
};
CodeWHexProc: IOUtils.PFCodeProc = {
IO.PutF[stream, "0%xH", val];
};
CodeWOctalProc: IOUtils.PFCodeProc = {
IO.PutF[stream, "%bB", val];
};
Commander.Register[
"Quad", HandCodingDriverCommand,
"QUick And Dirty assembler for Dragon"];
END.