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