-- CIFSInterface.mesa
-- last modified by Satterthwaite, September 15, 1982 9:16 am
-- last modified by Paul Rovner, April 12, 1983 5:14 pm
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];
CIFSInterface: PROGRAM []
IMPORTS
CharIO, CIFS, CommandUtil, CompilerOps, ConvertUnsafe, FileStream,
FileParmOps, Heap, Inline, IO, OSMiscOps, Stream, String, Strings, Time
EXPORTS ExecOps, TemporarySpecialExecOps = {
Command: TYPE = ExecOps.Command;
StreamHandle: TYPE = Stream.Handle;
-- feedback control
feedback: Feedback.ProcsHandle;
fbh: Feedback.Handle ← NIL;
feedbackGoing: BOOL;
userAbort: BOOL; -- set by ↑DEL
useLog: BOOL; -- for compiler.log for error reporting
-- command line input control
commandObject: CommandUtil.CommandObject ← [pos: 0, len: 0, data: NIL];
commandPtr: CommandUtil.CommandPtr ← @commandObject;
SetCommandInput: PROC [cmd: Command] = {
commandObject.pos ← 0;
commandObject.data ← cmd;
FOR i: CARDINAL IN [0..CARDINAL.LAST] DO
c: CHAR = commandObject.data[i];
IF c # 11c AND c < 40c THEN {commandObject.len ← i; RETURN};
ENDLOOP};
-- special output stream control
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};
-- compiler sequencing
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[NOT 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]};
}.