<> <> <> 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]>> <> <> <> 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 { <> 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; <> IO.SetIndex[fileStream, SIZE[CARDINAL]*Basics.bytesPerWord]; [] _ IO.UnsafeGetBlock[fileStream, [ base: LOOPHOLE[LONG[@fileVersion]], startIndex: 0, count: SIZE[VersionStamp]*Basics.bytesPerWord]]; <> IF modCtx # NIL THEN ctxVersion _ AMModel.SectionVersion[AMModel.ContextSection[modCtx]]; IF modCtx = NIL OR ctxVersion # fileVersion THEN { <> 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]; <> 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 { <> 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 { <> outputName _ ReplaceSuffix[listOfTokens.first, "quad"]; listOfTokens _ listOfTokens.rest.rest; len _ len - 2; } ELSE { <> outputName _ "Default.quad$"; }; area _ HandCodingSupport.NewArea[$Quad, GetWord, PutWord, mem]; HandCodingSupport.Gen1WithArea[area, inner]; <> IF byteOutput OR wordOutput THEN { <> st: STREAM = FS.StreamOpen[fileName: outputName, accessOptions: create, keep: 2]; IO.PutF[cmd.err, " Quad output to %g", [rope[outputName]]]; SetOutputBase[st, useHex]; <> 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]; <> WriteSparseMemory.ToStream[ st: st, base: mem, byteOutput: byteOutput, displayCode: displayCode]; IO.Close[st]; }; IF execute THEN { <> 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 <> 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 => { <> word _ DragOpsCrossUtils.CardToWord[ LOOPHOLE[Convert.RealFromLiteral[RefText.TrustTextAsRope[buffer]]]]; }; tokenEOF => EXIT; ENDCASE => GO TO syntaxError; IF Peek[] = '= THEN { <> Next[]; definition _ name; LOOP; }; IF definition # NIL THEN { <> card: CARD = HandCodingSupport.GetOutputPC[area]; IF undefined THEN { <> 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 ': => { <> word _ DragOpsCrossUtils.WordAddressToBytePC[word]; HandCodingSupport.SetOutputPC[DragOpsCrossUtils.WordToCard[word], area]; Next[]; wordMode _ TRUE; }; '/ => { <> HandCodingSupport.SetOutputPC[DragOpsCrossUtils.WordToCard[word], area]; Next[]; wordMode _ FALSE; }; ENDCASE => { <> IF wordMode OR DragOpsCrossUtils.WordToCard[word] > 255 THEN HandCodingSupport.OutputWord[area, word] ELSE HandCodingSupport.OutputByte[area, DragOpsCrossUtils.WordToBytes[word][3]] }; IF undefined THEN { <> 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.