DIRECTORY
CharIO: TYPE USING [NumberFormat, CR, PutChar, PutDecimal, PutLine, PutNumber, PutString],
CIFS: TYPE USING [OpenFile, Close, Delete, Error, GetFC, Open, read],
CommandUtil:
TYPE
USING [
PairList, CommandObject, CommandPtr, CopyString, Echo, Failed,
FreePairList, FreeString, GetNth, ListLength, Parse, SetExtension],
CompilerOps:
TYPE
USING [
LetterSwitches, StreamId, Transaction,
AppendHerald, DefaultSwitches, DoTransaction, Punt, Start, Stop],
ConvertUnsafe: TYPE USING [ToRope],
ExecOps: TYPE USING [Command, Outcome],
Feedback: TYPE USING [Handle, Procs, ProcsHandle],
File: TYPE USING [Capability, nullCapability],
FileParms: TYPE USING [BindingProc, nullActual],
FileParmOps: TYPE USING [ClearAList, Finalize, Initialize, SetAList],
FileStream: TYPE USING [Create, GetLeaderProperties, SetLength],
Heap: TYPE USING [Create, Delete],
Inline: TYPE USING [DIVMOD, LongDivMod],
IO: TYPE USING [UserAborted],
OSMiscOps: TYPE USING [DeleteFile, FindFile],
Stream: TYPE USING [Delete, Handle],
String: TYPE USING [AppendDecimal],
Strings: TYPE USING [String, SubStringDescriptor, AppendChar, AppendString],
TemporarySpecialExecOps: TYPE USING [],
Time: TYPE USING [Packed, AppendCurrent, Current],
TimeStamp: TYPE USING [Null];
log: StreamHandle ← NIL;
GetCompilerLog: PUBLIC PROC RETURNS [StreamHandle] = {RETURN [log]};
SetTypescript: PROC = {IF log = NIL THEN log ← NewOutputStream["Compiler.Log"L]};
NewLine: PROC = {CharIO.PutChar[log, CharIO.CR]};
NewOutputStream:
PROC [s: Strings.String]
RETURNS [stream: StreamHandle] = {
file: File.Capability;
file ← OSMiscOps.FindFile[s, $write];
stream ← FileStream.Create[file];
FileStream.SetLength[stream, 0]};
CIFSInputStream:
PROC [file:
CIFS.OpenFile]
RETURNS [StreamHandle] = {
RETURN [IF file # NIL THEN FileStream.Create[CIFS.GetFC[file]] ELSE NIL]};
WriteHerald:
PROC [s: StreamHandle, id: Strings.String] = {
OPEN CharIO;
herald: STRING ← [60];
CompilerOps.AppendHerald[herald];
PutLine[s, herald];
IF ~feedbackGoing
AND feedback.create #
NIL
THEN
fbh ← feedback.create[system: "Compiler"L, herald: herald];
feedbackGoing ← TRUE;
IF id # NIL THEN {PutString[s, id]; PutString[s, " -- "L]};
herald.length ← 0; Time.AppendCurrent[herald]; PutLine[s, herald]};
WriteTime:
PROC [time:
LONG
CARDINAL] = {
OPEN CharIO;
hr, min, sec: CARDINAL;
f: NumberFormat ← [base: 10, unsigned: TRUE, zerofill: FALSE, columns: 1];
W:
PROC [t:
CARDINAL] = {
IF t # 0
OR f.zerofill
THEN {
PutNumber[log, t, f]; PutChar[log, ':];
f ← [base: 10, unsigned: TRUE, zerofill: TRUE, columns: 2]}};
[min, sec] ← Inline.LongDivMod[time, 60];
[hr, min] ← Inline.DIVMOD[min, 60];
W[hr]; W[min]; PutNumber[log, sec, f]};
ErrorInit:
PROC = {
IF errorStream =
NIL
THEN
IF useLog THEN errorStream ← log
ELSE {
errorName ← MakeErrorName[rootName];
errorStream ← NewOutputStream[errorName];
WriteHerald[errorStream, errorName];
CharIO.PutChar[errorStream, CharIO.CR]}};
MakeErrorName:
PROC [root: Strings.String]
RETURNS [Strings.String] = {
RETURN [CommandUtil.SetExtension[
CommandUtil.CopyString[root, 2+("errlog"L).length],
"errlog"L]]};
GetStream:
PROC [id: CompilerOps.StreamId]
RETURNS [s: Stream.Handle] = {
SELECT id
FROM
$source => s ← sourceStream;
$object => ERROR; -- should be obtained from CIFSFileParmPack
$log => {IF errorStream = NIL THEN ErrorInit[]; s ← errorStream};
ENDCASE => ERROR;
RETURN};
Initialize:
PROC = {
sourceFile ← CIFS.Open[ConvertUnsafe.ToRope[sourceName], CIFS.read];
parms.sourceStream ← sourceStream ← CIFSInputStream[sourceFile];
parms.source.version ← TimeStamp.Null;
parms.source.version.time ← FileStream.GetLeaderProperties[sourceStream].create};
Finalize:
PROC [started:
BOOL] = {
IF objectStream # NIL THEN Stream.Delete[objectStream];
IF sourceStream # NIL THEN Stream.Delete[sourceStream];
IF errorStream # NIL AND errorStream # log THEN Stream.Delete[errorStream];
objectStream ← sourceStream ← errorStream ← NIL;
IF sourceFile # NIL THEN CIFS.Close[sourceFile];
sourceFile ← NIL;
IF parms.nErrors # 0
AND started
THEN
CIFS.Delete[ConvertUnsafe.ToRope[objectName] ! CIFS.Error => TRUSTED {CONTINUE}];
IF errorName =
NIL
THEN {
errorName ← MakeErrorName[rootName]; OSMiscOps.DeleteFile[errorName]}};
WriteErrlogName:
PROC = {
IF useLog OR log = NIL THEN RETURN;
CharIO.PutString[log, " on "L];
CharIO.PutString[log, rootName]; CharIO.PutString[log, ".errlog"L]};
WriteClosing:
PROC [startTime: Time.Packed] = {
OPEN CharIO;
PutString[log, sourceName]; PutString[log, " -- "L];
IF parms.nErrors # 0
THEN {
errors ← TRUE; PutString[log, "aborted, "L];
PutDecimal[log, parms.nErrors]; PutString[log, " errors"L];
IF parms.nWarnings # 0
THEN {
warnings ← TRUE; PutString[log, " and "L];
PutDecimal[log, parms.nWarnings]; PutString[log, " warnings"L]};
WriteErrlogName[];
PutString[log, ", time: "L];
WriteTime[Time.Current[]-startTime]}
ELSE {
PutString[log, "source tokens: "L];
PutDecimal[log, parms.sourceTokens];
PutString[log, ", time: "L];
WriteTime[Time.Current[]-startTime];
IF parms.objectBytes # 0
THEN {
NewLine[];
PutString[log, " code bytes: "L]; PutDecimal[log, parms.objectBytes];
PutString[log, ", links: "L]; PutDecimal[log, parms.linkCount];
PutString[log, ", frame size: "L];
PutDecimal[log, parms.objectFrameSize];
IF parms.matched THEN PutChar[log, '.]};
IF parms.nWarnings # 0
THEN {
warnings ← TRUE; NewLine[];
PutDecimal[log, parms.nWarnings]; PutString[log, " warnings"L];
WriteErrlogName[]}};
IF feedback.finishItem #
NIL
THEN {
outcome: ExecOps.Outcome =
SELECT
TRUE
FROM
userAbort => aborted,
parms.nErrors # 0 => IF parms.nWarnings # 0 THEN errorsAndWarnings ELSE errors,
parms.nWarnings # 0 => warnings,
ENDCASE => ok;
msg: STRING ← [30];
IF parms.nErrors = 0 THEN Strings.AppendString[msg, "no"L]
ELSE String.AppendDecimal[msg, parms.nErrors];
Strings.AppendString[msg, " errors"L];
IF parms.nWarnings # 0
THEN {
Strings.AppendString[msg, ", "L];
String.AppendDecimal[msg, parms.nWarnings];
Strings.AppendString[msg, " warnings"L]};
feedback.finishItem[fbh, outcome, msg]}};
StopCompiler:
PROC [startTime: Time.Packed] = {
IF feedback.destroy # NIL THEN feedback.destroy[fbh, "End of compilation"L];
IF moduleCount > 1
THEN {
NewLine[]; CharIO.PutString[log, "Total elapsed time: "L];
WriteTime[Time.Current[]-startTime]};
NewLine[]; Stream.Delete[log]; log ← NIL};
transaction: CompilerOps.Transaction;
parms: POINTER TO CompilerOps.Transaction = @transaction;
standardDefaults: CompilerOps.LetterSwitches = CompilerOps.DefaultSwitches[];
switchDefaults: CompilerOps.LetterSwitches;
sourceName, objectName, errorName: Strings.String ← NIL;
rootName: Strings.String ← NIL;
sourceFile: CIFS.OpenFile ← NIL;
sourceStream, objectStream, errorStream: StreamHandle ← NIL;
errors, warnings: BOOL ← FALSE;
moduleCount: CARDINAL;
SetRoot:
PROC [s: Strings.String]
RETURNS [root: Strings.String] = {
root ← CommandUtil.CopyString[s];
FOR i:
CARDINAL
IN [0..s.length)
DO
IF s[i] = '. THEN {root.length ← i; EXIT};
ENDLOOP};
* * * * * * M A I N B O D Y C O D E * * * * * *
Compile:
PUBLIC
PROC [cmd: Command]
RETURNS [outcome: ExecOps.Outcome] = {
fProcs: Feedback.Procs ← []; -- all NIL
RETURN [CompileUsingFeedback[cmd, @fProcs]]};
CompileUsingFeedback:
PUBLIC
PROC [cmd: Command, feedbackProcs: Feedback.ProcsHandle]
RETURNS [ExecOps.Outcome] = {
StartPass:
PROC [pass:
CARDINAL]
RETURNS [goOn:
BOOL] = {
IF feedback.noteProgress #
NIL
THEN
feedback.noteProgress[fbh, pass ! IO.UserAborted => {userAbort ← TRUE; CONTINUE}];
RETURN [~userAbort]};
compilerStartTime, moduleStartTime: Time.Packed;
scratchZone: UNCOUNTED ZONE ← Heap.Create[initial: 8, increment: 8];
fbh ← NIL; feedbackGoing ← FALSE;
switchDefaults ← CompilerOps.DefaultSwitches[];
parms.fileParms ← FileParmOps.Initialize[scratchZone];
CompilerOps.Start[scratchZone];
compilerStartTime ← Time.Current[];
moduleCount ← 0;
userAbort ← FALSE;
do the compilation
SetCommandInput[cmd]; SetTypescript[];
feedback ← feedbackProcs;
WriteHerald[log, NIL]; -- starts feedback stuff also
errors ← warnings ← FALSE;
DO
args, results: CommandUtil.PairList;
switches: Strings.String ← NIL;
localPause: BOOL;
sense: BOOL;
BEGIN OPEN CharIO;
parms.switches ← switchDefaults; parms.switches['p] ← FALSE;
parms.debugPass ← CARDINAL.LAST;
parms.getStream ← GetStream; parms.startPass ← StartPass;
parms.objectBytes ← 0; parms.objectFrameSize ← 0; parms.linkCount ← 0;
parms.nErrors ← 0; parms.nWarnings ← 0;
parms.sourceTokens ← 0;
[sourceName, args, results, switches] ←
CommandUtil.Parse[
s: commandPtr,
opX: 2+("mesa"L).length, resultX: 2+("bcd"L).length
! CommandUtil.Failed => {GO TO badSyntax}];
IF sourceName = NIL AND switches = NIL THEN EXIT;
NewLine[]; PutString[log, "Command: "L];
CommandUtil.Echo[log, sourceName, args, results, switches];
IF CommandUtil.ListLength[results] > 1 THEN GO TO badSemantics;
IF sourceName = NIL THEN GO TO globalSwitches;
rootName ← SetRoot[
IF CommandUtil.ListLength[results] = 1
THEN CommandUtil.GetNth[results, 0]
ELSE sourceName];
IF switches #
NIL
THEN {
sense ← TRUE;
FOR i:
CARDINAL
IN [0..switches.length)
DO
c: CHAR = switches[i];
SELECT c
FROM
'-, '~ => sense ← ~sense;
IN ['a..'z] => {parms.switches[c] ← sense; sense ← TRUE};
IN ['A..'Z] => {
parms.switches[c+('a-'A)] ← sense; sense ← TRUE};
IN ['1..'5] => {parms.debugPass ← c-'0; sense ← TRUE};
ENDCASE;
ENDLOOP;
switches ← CommandUtil.FreeString[switches]};
sourceName ← CommandUtil.SetExtension[sourceName, "mesa"L];
parms.source.locator ← [sourceName, 0, sourceName.length];
IF CommandUtil.ListLength[results] # 0
THEN {
objectName ← CommandUtil.GetNth[list: results, n: 0, delete: TRUE];
results ← CommandUtil.FreePairList[results]}
ELSE objectName ← CommandUtil.CopyString[rootName, 2+("bcd"L).length];
objectName ← CommandUtil.SetExtension[objectName, "bcd"L];
parms.objectName ← CommandUtil.CopyString[objectName];
parms.objectFile ← File.nullCapability;
moduleCount ← moduleCount + 1;
IF feedback.beginItem #
NIL
THEN {
item: Strings.String ← CommandUtil.CopyString[NIL, rootName.length + 12 + 53];
first: BOOL ← TRUE;
Strings.AppendString[item, "Compiling: "L]; Strings.AppendString[item, rootName];
FOR c:
CHAR
IN ['a..'z]
DO
sd: BOOL = IF c = 'p THEN FALSE ELSE standardDefaults[c];
IF parms.switches[c] # sd
THEN {
IF first THEN {first ← FALSE; Strings.AppendChar[item, '/]};
IF sd THEN Strings.AppendChar[item, '-];
Strings.AppendChar[item, c]};
ENDLOOP;
feedback.beginItem[fbh, item];
item ← CommandUtil.FreeString[item]};
useLog ← parms.switches['g]; parms.switches['g] ← FALSE;
localPause ← parms.switches['p]; parms.switches['p] ← FALSE;
Initialize[ ! ANY => {GOTO noSource}];
FileParmOps.SetAList[args];
pattern for replacement
BEGIN
BindPattern: FileParms.BindingProc = {
parms.pattern ← actual;
parms.op ← IF actual = FileParms.nullActual THEN $compile ELSE $replace};
parms.fileParms.Binding[
formalId: ["$"L, 0, 1], formalType: [NIL, 0, 0], binder: BindPattern];
END;
NewLine[]; moduleStartTime ← Time.Current[];
CompilerOps.DoTransaction[parms ! CompilerOps.Punt => {GO TO punt}];
Finalize[TRUE];
FileParmOps.ClearAList[];
WriteClosing[moduleStartTime];
EXITS
globalSwitches => {
objectName ← NIL;
sense ← TRUE;
FOR i:
CARDINAL
IN [0..switches.length)
DO
c: CHAR = switches[i];
SELECT c
FROM
'-, '~ => sense ← ~sense;
IN ['a..'z] => {switchDefaults[c] ← sense; sense ← TRUE};
IN ['A..'Z] => {switchDefaults[c+('a-'A)] ← sense; sense ← TRUE};
ENDCASE => EXIT;
ENDLOOP;
switches ← CommandUtil.FreeString[switches];
args ← CommandUtil.FreePairList[args]};
noSource => {
PutString[log, " -- source not found\n"L];
errors ← TRUE; parms.nErrors ← 1;
WriteClosing[Time.Current[]];
args ← CommandUtil.FreePairList[args]};
badSemantics => {
objectName ← NIL; errors ← TRUE;
PutString[log, " -- Illegal command"L];
args ← CommandUtil.FreePairList[args]};
END;
sourceName ← CommandUtil.FreeString[sourceName];
rootName ← CommandUtil.FreeString[rootName];
objectName ← CommandUtil.FreeString[objectName];
parms.objectName ← CommandUtil.FreeString[parms.objectName];
errorName ← CommandUtil.FreeString[errorName];
results ← CommandUtil.FreePairList[results];
NewLine[];
IF userAbort
THEN {
NewLine[]; CharIO.PutString[log, "... command aborted"L]; NewLine[];
GO TO truncateList};
IF (errors OR warnings) AND localPause THEN GO TO truncateList;
REPEAT
badSyntax => {
NewLine[]; CharIO.PutString[log, "-- Illegal syntax"L]; errors ← TRUE};
truncateList => switchDefaults['p] ← TRUE;
punt => {Finalize[TRUE]; WriteClosing[moduleStartTime]; NewLine[]};
ENDLOOP;
StopCompiler[compilerStartTime];
CompilerOps.Stop[];
FileParmOps.Finalize[];
Heap.Delete[scratchZone];
RETURN [
SELECT
TRUE
FROM
userAbort => aborted,
errors => errors,
warnings => warnings,
ENDCASE => ok]};
}.