<<>> <> <> <> <> <> <> DIRECTORY AMBridge, Ascii, CardTab, C2CInternalAccess, C2CBasics, C2CDefs, C2CCodeDefsPrivate, C2CEmit, C2CMain, C2CNames, Commander, CommandTool, FileNames, FS, IntCodeDefs, IO, MimSysOps, ParseIntCode, PrintTV, Process, ProcessProps, Rope, --RuntimeError, SymTab, UserProfile; C2CDebugging: CEDAR PROGRAM IMPORTS AMBridge, CardTab, C2CInternalAccess, C2CBasics, C2CEmit, C2CMain, C2CNames, Commander, CommandTool, FileNames, FS, IO, MimSysOps, ParseIntCode, PrintTV, Process, ProcessProps, Rope, --RuntimeError,-- UserProfile = BEGIN OPEN IntCodeDefs; ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; failedAndMessaged: ERROR = CODE; icdExtension: ROPE ¬ ".icd"; namesExtension: ROPE ¬ ".names"; outputExtension: ROPE ¬ ".c2c.c"; externProcsExtension: ROPE ¬ ".externProcs"; <<--for c2c command>> defaultSwitches: Rope.ROPE ¬ "-"; documentation: ROPE ¬ "Cedar To C (IntCode to C translator)"; DefineSwitch: PROC [switch: ROPE, sense: BOOL, doc: ROPE ¬ NIL] = { <<--for c2c command>> IF ~sense THEN defaultSwitches ¬ Rope.Concat[defaultSwitches, "~"]; defaultSwitches ¬ Rope.Concat[defaultSwitches, switch]; IF doc#NIL THEN { documentation ¬ IO.PutFR["%g\n%g-%g: %g [%g]", IO.rope[documentation], IO.char[Ascii.TAB], IO.rope[switch], IO.rope[doc], IO.char[IF sense THEN 'T ELSE 'F]]; }; }; ErrStream: PROC [] RETURNS [err: IO.STREAM] = { WITH ProcessProps.GetProp[$ErrOut] SELECT FROM s: IO.STREAM => err ¬ s; ENDCASE => err ¬ IO.noWhereStream; }; OpenViewer: PROC [name: ROPE] = { WITH ProcessProps.GetProp[$CommanderHandle] SELECT FROM handle: Commander.Handle => [] ¬ CommandTool.DoCommandRope[commandLine: Rope.Cat["open ", name], parent: handle]; ENDCASE => {}; }; GenCCommand: Commander.CommandProc = { searchRules: REF ANY ¬ CommandTool.GetProp[cmd, $SearchRules]; filePattern: ROPE ¬ NIL; outerSwitch: BOOL ¬ TRUE; debugSwitch: BOOL ¬ FALSE; floatInlineSwitch: BOOL ¬ FALSE; accessExternalSwitch: BOOL ¬ FALSE; xLFSwitch: BOOL ¬ FALSE; interceptSwitch: BOOL ¬ FALSE; viewSwitch: BOOL ¬ FALSE; sourceSwitch: BOOL ¬ FALSE; externProcSwitch: BOOL ¬ FALSE; minKeep: INT ¬ MAX[UserProfile.Number[key: "C2C.MinKeep", default: 2], 1]; LoadInterceptor: PROC [] = { failed: BOOL ¬ CommandTool.Install["MimosaOnly", cmd].failed; IF failed THEN { IO.PutRope[cmd.out, "== failed loading Mimosa\n"]; ERROR failedAndMessaged }; }; CreateOutput: PROC [outputName: ROPE] RETURNS [output: IO.STREAM] = { IF interceptSwitch THEN { err: ROPE; LoadInterceptor[]; [stream: output, err: err] ¬ MimSysOps.Open[name: outputName, kind: write]; IF err#NIL THEN { IO.PutRope[cmd.out, "== "]; IO.PutRope[cmd.out, err]; IO.PutRope[cmd.out, "\n"]; ERROR failedAndMessaged }; } ELSE { keep: INT ¬ minKeep; keep ¬ FS.FileInfo[name: outputName, remoteCheck: FALSE ! FS.Error => CONTINUE].keep; IF keep CONTINUE] }; output ¬ FS.StreamOpen[fileName: outputName, accessOptions: $create, keep: keep]; }; IF output=NIL THEN { IO.PutRope[cmd.out, "== output file not created\n"]; ERROR failedAndMessaged }; }; OpenInput: PROC [pattern, ext, purpose: ROPE] RETURNS [input: IO.STREAM, name: ROPE] = { FindInputName: PROC [pattern: ROPE, ext: ROPE] RETURNS [fileName: ROPE ¬ NIL] = { IF interceptSwitch THEN { GetRootName: PROC [name: ROPE] RETURNS [root: ROPE] = { dotIndex: INT ¬ Rope.Find[name, "."]; RETURN[IF dotIndex < 0 THEN name ELSE Rope.Substr[name, 0, dotIndex]] }; root: ROPE ¬ GetRootName[pattern]; IF root#NIL THEN fileName ¬ Rope.Cat[root, ext]; } ELSE { fileName ¬ FileNames.FileWithSearchRules[ root: pattern, defaultExtension: ext, requireExtension: TRUE, requireExact: TRUE, searchRules: searchRules].fullPath; } }; Open: PROC [name, purpose: ROPE] RETURNS [input: IO.STREAM] = { IF interceptSwitch THEN { err: ROPE; LoadInterceptor[]; [stream: input, err: err] ¬ MimSysOps.Open[name: name, kind: read]; IF err#NIL THEN { IO.PutRope[cmd.out, "== "]; IO.PutRope[cmd.out, err]; IO.PutRope[cmd.out, "\n"]; ERROR failedAndMessaged }; } ELSE { input ¬ FS.StreamOpen[name, $read ! FS.Error => { IO.PutRope[cmd.out, "== "]; IO.PutRope[cmd.out, purpose]; IO.PutRope[cmd.out, " "]; IO.PutRope[cmd.out, error.explanation]; IO.PutRope[cmd.out, "\n"]; ERROR failedAndMessaged }]; }; }; IF pattern=NIL THEN { IO.PutRope[cmd.out, "== "]; IO.PutRope[cmd.out, purpose]; IO.PutRope[cmd.out, " no name\n"]; ERROR failedAndMessaged }; name ¬ FindInputName[pattern, ext]; IF Rope.IsEmpty[name] THEN { IO.PutRope[cmd.out, "== "]; IO.PutRope[cmd.out, purpose]; IO.PutRope[cmd.out, " not found\n"]; ERROR failedAndMessaged }; input ¬ Open[name, purpose]; IF input=NIL THEN { IO.PutRope[cmd.out, "== "]; IO.PutRope[cmd.out, purpose]; IO.PutRope[cmd.out, " not found\n"]; ERROR failedAndMessaged }; }; MyClose: PROC [stream: STREAM] = { IF stream#NIL THEN IF ~interceptSwitch THEN IO.Close[stream] ELSE { err: ROPE ¬ MimSysOps.Close[stream]; IF err#NIL THEN { IO.PutRope[cmd.out, "== "]; IO.PutRope[cmd.out, err]; IO.PutRope[cmd.out, "\n"]; ERROR failedAndMessaged }; }; }; ProcessSwitches: PROC [arg: ROPE] = { sense: BOOL ¬ TRUE; FOR index: INT IN [0..Rope.Length[arg]) DO SELECT Rope.Fetch[arg, index] FROM '~ => {sense ¬ NOT sense; LOOP}; 'a, 'A => sourceSwitch ¬ sense; 'o, 'O => outerSwitch ¬ sense; 'd, 'D => debugSwitch ¬ sense; 'f, 'F => floatInlineSwitch ¬ sense; 'e, 'E => accessExternalSwitch ¬ sense; 'l, 'L => xLFSwitch ¬ sense; 'x, 'X => externProcSwitch ¬ sense; 'm, 'M => interceptSwitch ¬ sense; 'v, 'V => viewSwitch ¬ sense; ENDCASE; sense ¬ TRUE; ENDLOOP; }; CompileOneFile: PROC [filePattern: ROPE ¬ NIL] = { namesStream, icdStream, externProcStream: STREAM; namesName, icdName, externProcName: ROPE; resultCode: C2CEmit.Code; pleaseDestroyWhenFinished: IntCodeDefs.Node¬NIL; OutputName: PROC [] RETURNS [outputName: ROPE ¬ NIL] = { shortName: ROPE ¬ FileNames.GetShortName[icdName]; outputName ¬ Rope.Replace[ base: shortName, start: Rope.Length[shortName]-Rope.Length[icdExtension], with: outputExtension]; }; innerFailed: BOOL ¬ FALSE; Inner: PROC [state: C2CBasics.State] = { ENABLE { C2CBasics.FatalError => { IO.PutF[cmd.out, " ==fatal error: %g\nat %g ", [rope[what]], [rope[C2CInternalAccess.SourcePosition[state]]]]; IF ~debugSwitch THEN GOTO Oops; }; << comment this back in when the PCedar RuntimeError.Uncaught error is fixed to have the correct spelling RuntimeError.UNCAUGHT => { IO.PutF[cmd.out, " ==uncaught error at %g ", IO.rope[C2CInternalAccess.SourcePosition[state]]]; innerFailed ¬ TRUE; };>> ABORTED => C2CInternalAccess.DestroyNode[pleaseDestroyWhenFinished]; }; names: CardTab.Ref ¬ CardTab.Create[]; labels: CardTab.Ref ¬ CardTab.Create[]; nodes: IntCodeDefs.NodeList; externProcs: SymTab.Ref ¬ NIL; C2CNames.ScanNames[namesStream, names, labels]; IF externProcStream#NIL THEN externProcs ¬ C2CNames.ScanExterns[state, externProcStream]; C2CNames.AssociateNames[state, names, labels, externProcs]; C2CBasics.Report[]; nodes ¬ ParseIntCode.FromStream[icdStream ! ParseIntCode.SyntaxError => { IO.PutRope[cmd.out, " ==failed parsing intcode "]; IO.PutRope[cmd.out, why]; GOTO Oops } ]; IF nodes=NIL OR nodes.rest#NIL THEN C2CBasics.CantHappen; pleaseDestroyWhenFinished ¬ state.rootNode ¬ nodes.first; IF outerSwitch THEN C2CBasics.PutProp[, $OuterInstallation, $yes]; IF accessExternalSwitch THEN C2CBasics.PutProp[, $CedarBootAccessExtern, $yes]; IF floatInlineSwitch THEN C2CBasics.PutProp[, $floatInline, $yes]; C2CBasics.PutProp[, $InitializationExtern, $yes]; IF sourceSwitch THEN C2CBasics.PutProp[, $SourceHack, $yes]; resultCode ¬ C2CMain.C2CRoot[state: state, header: Rope.Cat["from file """, icdName, """"]]; C2CBasics.Report[]; C2CInternalAccess.DestroyNode[pleaseDestroyWhenFinished]; EXITS Oops => { C2CInternalAccess.DestroyNode[pleaseDestroyWhenFinished]; innerFailed ¬ TRUE; result ¬ $Failure }; }; C2CInternalAccess.RegisterWithFrontEnd[]; IO.PutRope[cmd.out, "C2C "]; IO.PutRope[cmd.out, filePattern]; IO.PutRope[cmd.out, " "]; [icdStream, icdName] ¬ OpenInput[filePattern, icdExtension, "intermediate code file" ! failedAndMessaged => GOTO Oops]; [namesStream, namesName] ¬ OpenInput[filePattern, namesExtension, "names file" ! failedAndMessaged => GOTO Oops]; IF externProcSwitch THEN { [externProcStream, externProcName] ¬ OpenInput[filePattern, externProcsExtension, "extern procs file" ! failedAndMessaged => GOTO Oops]; }; innerFailed ¬ FALSE; C2CBasics.DoWithNewState[Inner, cmd.out]; MyClose[namesStream ! failedAndMessaged => GOTO Oops]; MyClose[icdStream ! failedAndMessaged => GOTO Oops]; IF innerFailed AND ~debugSwitch THEN IO.PutRope[cmd.out, "\n"] ELSE { lineChar: CHAR ¬ IF xLFSwitch THEN Ascii.LF ELSE Ascii.CR; outputName: ROPE ¬ OutputName[]; output: STREAM ¬ CreateOutput[outputName ! failedAndMessaged => GOTO Oops]; IF innerFailed THEN resultCode ¬ C2CEmit.Cat["COMPILE TIME ERROR(S)\n", resultCode]; C2CEmit.ProcessAndOutputCode[output, resultCode, lineChar]; MyClose[output ! failedAndMessaged => GOTO Oops]; IF viewSwitch THEN OpenViewer[outputName]; IO.PutRope[cmd.out, "done\n"]; }; EXITS Oops => result ¬ $Failure }; argv: CommandTool.ArgumentVector ¬ CommandTool.Parse[cmd: cmd ! CommandTool.Failed => {msg ¬ errorMsg; GO TO Oops} ]; ProcessSwitches[defaultSwitches]; ProcessSwitches[UserProfile.Token[key: "C2C.DefaultSwitches", default: NIL]]; Process.SetPriority[VAL[1]]; -- Process.priorityBackground in the PrincOps world or Process.priorityUserBackground in the PCedar world result ¬ NIL; FOR i: NAT IN [1..argv.argc) DO arg: ROPE = argv[i]; IF Rope.Length[arg] = 0 THEN LOOP; IF Rope.Fetch[arg, 0] = '- THEN { <> ProcessSwitches[arg]; LOOP; }; <> CompileOneFile[arg]; ENDLOOP; IO.PutRope[cmd.out, "End of compilation\n"]; IF result=NIL THEN result ¬ $Success; IO.PutRope[cmd.out, IF result=$Success THEN "S\n" ELSE "F\n"]; EXITS Oops => result ¬ $Failure }; PrintState: PrintTV.TVPrintProc = TRUSTED { <<--ENABLE RuntimeError.UNCAUGHT => GOTO someErr;>> s: C2CBasics.State ¬ NARROW[AMBridge.SomeRefFromTV[tv]]; stream.PutRope["{"]; stream.PutRope[C2CInternalAccess.SourcePosition[s]]; stream.PutRope["}"]; <<--EXITS someErr => useOld_TRUE>> }; PrintCode: PrintTV.TVPrintProc = TRUSTED { <<--ENABLE RuntimeError.UNCAUGHT => GOTO someErr;>> c: REF C2CCodeDefsPrivate.CodeRec ¬ NARROW[AMBridge.SomeRefFromTV[tv]]; IF c=NIL THEN stream.PutRope[""] ELSE { c0: REF C2CCodeDefsPrivate.CodeRec ¬ c; c1: REF C2CCodeDefsPrivate.CodeRec ¬ NEW[C2CCodeDefsPrivate.CodeRec¬c0­]; c1.usageInhibited ¬ FALSE; c1.delayedX ¬ c1.delayedDeref ¬ c1.delayedCWord ¬ c1.delayedCRef ¬ FALSE; stream.PutChar['{]; IF c0.usageInhibited THEN stream.PutRope[""]; IF c0.delayedX THEN { IF c0.delayedDeref THEN stream.PutRope[""] ELSE IF c0.delayedCRef THEN stream.PutRope[""] ELSE IF c0.delayedCWord THEN stream.PutRope[""] }; C2CEmit.ProcessAndOutputCode[stream, LOOPHOLE[c1], '\n, FALSE]; stream.PutChar['}]; }; <<--EXITS someErr => useOld _ TRUE>> }; RegisterC2C: Commander.CommandProc = { failed: BOOL ¬ CommandTool.Install["MimosaOnly", cmd].failed; IF failed THEN { IO.PutRope[cmd.out, "== failed loading Mimosa\n"]; result ¬ $Failure }; C2CInternalAccess.RegisterWithFrontEnd[] }; <<--these switches are defined for c2c command>> DefineSwitch["a", FALSE, "Andy's wonderfull line number hack"]; DefineSwitch["d", TRUE, "Debugging the compiler"]; DefineSwitch["e", FALSE, "cedarboot access procs External"]; DefineSwitch["f", FALSE, "inline Floating point"]; DefineSwitch["l", TRUE, "LF for linebreaks (instead CR)"]; DefineSwitch["m", FALSE, "use Mimosa file interceptor"]; DefineSwitch["o", TRUE, "Outer (add cedarboot access procs)"]; DefineSwitch["r", FALSE, "exteRnProc file used"]; DefineSwitch["v", FALSE, "open Viewer"]; Commander.Register[key: "C2C", proc: GenCCommand, doc: documentation]; Commander.Register[key: "C2CRegister", proc: RegisterC2C, doc: "registers c2c into mimosa"]; PrintTV.RegisterTVPrintProc[type: CODE[C2CBasics.StateRec], proc: PrintState]; PrintTV.RegisterTVPrintProc[type: CODE[C2CCodeDefsPrivate.CodeRec], proc: PrintCode]; PrintTV.RegisterTVPrintProc[type: CODE[C2CDefs.CodeRep], proc: PrintCode]; C2CInternalAccess.RegisterErrStream[ErrStream]; C2CInternalAccess.RegisterOpenViewer[OpenViewer]; C2CInternalAccess.RegisterWithFrontEnd[]; END.