C2CDebugging.mesa
Copyright Ó 1987, 1988, 1989, 1991 by Xerox Corporation. All rights reserved.
Christian Jacobi, February 23, 1987 11:58:50 am PST
Christian Jacobi, January 20, 1993 1:11 pm PST
Russ Atkinson (RRA) March 23, 1989 6:13:00 am PST
JKF August 2, 1988 7:10:08 am PDT
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<minKeep THEN {
keep ¬ minKeep;
FS.SetKeep[name: outputName, keep: keep ! FS.Error => 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 {
This argument sets switches for the remaining patterns
ProcessSwitches[arg];
LOOP;
};
Now the argument is assumed to be a file pattern.
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["<funny>"]
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["<inhibited>"];
IF c0.delayedX THEN {
IF c0.delayedDeref THEN stream.PutRope["<delayed*>"]
ELSE IF c0.delayedCRef THEN stream.PutRope["<delayed cast ref>"]
ELSE IF c0.delayedCWord THEN stream.PutRope["<delayed cast word>"]
};
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.