[Pixel]<DragonWare0.1>HandCoding>HandCodingDriver.mesa!1

HandCodingDriver.mesa

Russ Atkinson (RRA) September 11, 1986 1:44:00 pm PDT

McCreight October 27, 1986 3:57:39 pm PST

DIRECTORY

AMModel USING [Context, ContextSection, MostRecentNamedContext, RootContext, SectionVersion],

Basics USING [bytesPerWord],

BasicTime USING [Now],

BcdDefs USING [VersionStamp],

Commander USING [CommandProc, Register],

DragOpsCross USING [Word, ZerosWord],

DragOpsCrossUtils USING [IntToWord],

FS USING [Error, GetName, OpenFile, OpenFileFromStream, StreamOpen],

HandCodingPseudos USING [Label, ShowGlobalLabelTable],

HandCodingSupport USING [Area, Gen1WithArea, GetProc, LoadArea, NewArea, PutProc],

Interpreter USING [Evaluate],

IO USING [Close, EndOfStream, GetTokenRope, IDProc, PutF, PutRope, RIS, SetIndex, STREAM, UnsafeGetBlock],

IOUtils USING [CopyPFProcs, PFCodeProc, PFProcs, SetPFCodeProc, SetPFProcs],

Loader USING [Instantiate, IRItem],

PrincOps USING [ControlModule],

Process USING [CheckForAbort],

Rope USING [Cat, Equal, Fetch, Flatten, Length, Match, Replace, ROPE, Substr],

SparseMemory USING [Base, Create, Fetch, Store],

UserCredentials USING [Get],

WorldVM USING [LocalWorld],

WriteSparseMemory USING [ToStream];

HandCodingDriver: CEDAR PROGRAM

IMPORTS AMModel, BasicTime, Commander, DragOpsCrossUtils, FS, HandCodingPseudos, HandCodingSupport, Interpreter, IO, IOUtils, Loader, Process, Rope, SparseMemory, UserCredentials, WorldVM, WriteSparseMemory

= BEGIN

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;

HandCodingSupport.LoadArea[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;

};

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];

};

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.