-- RCompImpl.mesa
-- last edit by Schmidt, May 4, 1982 1:00 pm
-- last edit by Satterthwaite, January 31, 1983 10:19 am
-- Pilot 6.0/ Mesa 7.0
DIRECTORY
CompilerOps: TYPE USING [
AppendHerald, DefaultSwitches, DoTransaction,
LetterSwitches, Start, Stop, StreamId, Transaction],
CWF: TYPE USING [FWF0, FWF1, FWF2, FWF3, FWFC, FWFCR, SetCode, WF0, WF1, WF2],
Dir: TYPE USING [DepSeq, FileInfo],
Directory: TYPE USING [DeleteFile, Error, Handle, Lookup, UpdateDates],
File: TYPE USING [Capability, read],
FileParms: TYPE USING [
ActualId, BindingProc, Name, nullActual, nullSymbolSpace, SymbolSpace],
FileStream: TYPE USING [Create],
Heap: TYPE USING [systemZone],
Inline: TYPE USING [DIVMOD, LongDivMod],
IO: TYPE USING[Handle, PutF, PutChar, rope],
LongString: TYPE USING [
AppendChar, AppendSubString, EqualString, EquivalentString, SubStringDescriptor],
MDComp: TYPE USING [SetVersAndModulename],
MDDB: TYPE USING [GetBcdDepSeq, GetSrcDepSeq],
MDMain: TYPE USING [DebugWP],
MDModel: TYPE USING [
EraseCacheEntry, FoldInParms, GetFileInfo, GetSrcCreate, LISTSymbol, LocForType,
LOCSymbol, LookupFileInfo, MODELSymbol, STRINGSymbol, SymbolSeq, TYPESymbol],
MDUtil: TYPE USING [AcquireMsgLock, IOConfirm, ReleaseMsgLock],
RComp: TYPE USING [],
Rope: TYPE USING [Text],
Runtime: TYPE USING [IsBound, RunConfig],
Stream: TYPE USING [Delete, Handle, PutChar],
Subr: TYPE USING [AbortMyself, NewFile, NewStream, Write],
Time: TYPE USING [Current],
TimeStamp: TYPE USING [Null],
TypeScript: TYPE USING[TS, UserAbort],
ViewerClasses: TYPE USING [Viewer],
ViewerOps: TYPE USING [CreateViewer, FindViewer, OpenIcon, RestoreViewer, SetNewFile],
WindowManager: TYPE USING [WaitCursor, UnWaitCursor];
RCompImpl: PROGRAM
IMPORTS
CompilerOps, CWF, Directory, FileStream, Heap, Inline, IO,
LongString, MDComp, MDDB, MDMain, MDModel, MDUtil, Runtime, Stream, Subr,
Time, TypeScript, ViewerOps, WindowManager
EXPORTS RComp = {
-- MDS Usage!
sourcesh: Stream.Handle ← NIL; -- source input file
logsh: Stream.Handle ← NIL; -- "Compiler.Log"
ttyTypeScript: TypeScript.TS ← NIL;
msgout: IO.Handle ← NIL;
good, warn, err: CARDINAL ← 0;
compilerStarted: BOOL ← FALSE;
timeCompilerStarted: LONG CARDINAL ← 0;
-- endof MDS
Compile: PUBLIC PROC[symbolseq: MDModel.SymbolSeq, sploc: MDModel.LOCSymbol,
tryreplacement: BOOL, oldbcdfilename: LONG STRING,
spmodel: MDModel.MODELSymbol, confirm: REF BOOL, typeScript: TypeScript.TS,
ttyin, ttyout, msgwindow: IO.Handle]
RETURNS[errors, warnings, replaceable, declined: BOOL] = {
t: CompilerOps.Transaction;
cap: File.Capability;
splist: MDModel.LISTSymbol ← sploc.parmlist;
onestarttime: LONG CARDINAL;
dontconfirm: BOOL = (IF confirm = NIL THEN FALSE ELSE ~(confirm↑));
loadedOk: BOOL;
fi: Dir.FileInfo ← NIL;
oldBcdDepSeq: Dir.DepSeq ← NIL;
-- inherits spmodel, sploc, symbolseq
-- splist is initailized once
DirectoryBinding: PROC[
formalId, formalType: FileParms.Name, defaultLocator: LONG STRING,
binder: FileParms.BindingProc] = {
typename: STRING ← [40];
LongString.AppendSubString[typename, @formalType];
WHILE splist ~= NIL AND ~ISTYPE[splist.first, MDModel.TYPESymbol] DO
splist ← splist.rest;
ENDLOOP;
WITH splist.first SELECT FROM
sptype: MDModel.TYPESymbol => {
sptypeloc: MDModel.LOCSymbol;
bcdFileName: STRING ← [40];
fiInner: Dir.FileInfo;
IF ~LongString.EqualString[sptype.typeName, typename] THEN {
CWF.WF2["Error - %s not in correct parameter order (should be %s).\n"L,
typename, sptype.typeName];
RETURN};
sptypeloc ← sptype.LocForType[];
IF sptypeloc = NIL THEN {
CWF.WF1["Error - %s has no value.\n"L, typename]; RETURN};
fiInner ← sptypeloc.GetFileInfo[];
IF fiInner.bcdVers = TimeStamp.Null THEN
MDComp.SetVersAndModulename[sptypeloc];
binder[[
version: fiInner.bcdVers,
locator: [base: fiInner.bcdFileName, offset: 0, length: fiInner.bcdFileName.length]]];
splist ← splist.rest};
ENDCASE => CWF.WF1["Error - %s cannot be found on parameter list.\n"L, typename]};
-- called after DirectoryBinding, unless it is a hidden Directory parameter
-- or is the old bcd in replacement mode
DirectoryAcquire: PROC[type: LongString.SubStringDescriptor, actual: FileParms.ActualId]
RETURNS [ss: FileParms.SymbolSpace] = {
depseq: Dir.DepSeq;
typename: STRING ← [40];
bcdFileName: STRING ← [40];
fiInner: Dir.FileInfo;
{
LongString.AppendSubString[bcdFileName, @actual.locator];
IF bcdFileName[bcdFileName.length-1] = '. THEN
bcdFileName.length ← bcdFileName.length - 1;
IF LongString.EquivalentString[oldbcdfilename, bcdFileName] THEN {
IF oldBcdDepSeq = NIL THEN ERROR;
RETURN[oldBcdDepSeq.symbolSpace]};
ss ← FileParms.nullSymbolSpace;
LongString.AppendSubString[typename, @type];
FOR plist: MDModel.LISTSymbol ← sploc.parmlist, plist.rest UNTIL plist = NIL DO
WITH plist.first SELECT FROM
sptype: MDModel.TYPESymbol => {
sptypeloc: MDModel.LOCSymbol = sptype.LocForType[];
IF
sptypeloc ~= NIL
AND (fiInner ← sptypeloc.GetFileInfo[]) ~= NIL
AND fiInner.bcdVers = actual.version
AND LongString.EqualString[fiInner.bcdFileName, bcdFileName]
THEN GOTO foundIt};
ENDCASE => NULL;
ENDLOOP;
-- compiler can discover hidden definitions and not call DirectoryBinding,
-- so we must be prepared to add it at this point
CWF.FWF3[
MDMain.DebugWP,
"Looking up directory entry (type %s, file %s) for %s.\n"L,
typename, bcdFileName, fi.bcdFileName];
fiInner ← MDModel.LookupFileInfo[bcdFileName, actual.version];
IF fiInner = NIL THEN {
CWF.WF2["Error - cannot find %s of %v in model.\n"L, bcdFileName, @actual.version];
RETURN[FileParms.nullSymbolSpace]};
EXITS
foundIt => NULL;
};
depseq ← MDDB.GetBcdDepSeq[fiInner, 0];
IF depseq = NIL THEN {
CWF.FWF1[MDMain.DebugWP, "DirectoryAcquire: Can't open %s.\n"L, bcdFileName];
RETURN};
IF actual.version = TimeStamp.Null THEN
CWF.FWF1[
MDMain.DebugWP, "DirectoryAcquire: Version of %s is null.\n"L, bcdFileName]
ELSE IF actual.version ~= depseq.bcdVers THEN
CWF.FWF3[
MDMain.DebugWP,
"DirectoryAcquire: Versions don't match %s: cache says %v, compiler wants %v\n"L,
bcdFileName, @depseq.bcdVers, @actual.version];
IF depseq.symbolSpace = FileParms.nullSymbolSpace THEN ERROR;
RETURN[depseq.symbolSpace]};
DeleteBadBcd: PROC = {
IF t.objectName ~= NIL THEN Directory.DeleteFile[t.objectName];
t.objectName ← NIL;
MDModel.EraseCacheEntry[fi: fi, src: FALSE]};
Cleanup: PROC = {
IF t.sourceStream ~= NIL THEN Stream.Delete[t.sourceStream];
t.sourceStream ← sourcesh ← NIL};
{
ENABLE
UNWIND => {DeleteBadBcd[]; Cleanup[]};
explicitSortSwitch: BOOL ← FALSE;
srcDepSeq: Dir.DepSeq;
msgout ← msgwindow;
ttyTypeScript ← typeScript;
errors ← warnings ← declined ← TRUE;
replaceable ← FALSE;
t.sourceStream ← NIL;
t.objectName ← NIL;
fi ← sploc.GetFileInfo[];
IF AskTheUser[fi.srcFileName, ttyin, ttyout, dontconfirm] THEN RETURN;
declined ← FALSE;
-- make sure the compiler is loaded, etc.
IF ~compilerStarted THEN {
loadedOk ← StartBatchCompile[];
IF ~loadedOk THEN RETURN};
-- set up Transaction record contents
t.op ← IF tryreplacement THEN $replace ELSE $compile;
t.source ← [
version: [net: 0, host: 0, time: MDModel.GetSrcCreate[fi]],
locator: [base: fi.srcFileName, offset: 0, length: fi.srcFileName.length]];
cap ← Directory.UpdateDates[fi.srcCap, File.read];
sourcesh ← t.sourceStream ← FileStream.Create[cap];
t.fileParms ← [DirectoryBinding, DirectoryAcquire, DirectoryRelease, DirectoryForget];
t.switches ← CompilerOps.DefaultSwitches[];
srcDepSeq ← MDDB.GetSrcDepSeq[fi, t.source.version.time];
IF ~srcDepSeq.isdefns THEN {
-- switches only matter for implementors
FOR plist: MDModel.LISTSymbol ← sploc.parmlist, plist.rest WHILE plist ~= NIL DO
WITH plist.first SELECT FROM
spstr: MDModel.STRINGSymbol =>
[t.switches, explicitSortSwitch] ← MDModel.FoldInParms[spstr.strval];
ENDCASE => NULL;
ENDLOOP;
IF ~explicitSortSwitch THEN t.switches['s] ← FALSE};
IF tryreplacement THEN {
IF fi.bcdVers = TimeStamp.Null THEN ERROR;
t.pattern ← [
version: fi.bcdVers,
locator: [base: oldbcdfilename, offset: 0, length: oldbcdfilename.length]];
oldBcdDepSeq ← fi.bcdDepSeq; -- will get old BCD!
IF oldBcdDepSeq = NIL THEN ERROR;
-- if there is old bcd, and the user did not specify explicitly /s or /-s
-- then sort as the old bcd was sorted
IF ~explicitSortSwitch THEN t.switches['s] ← oldBcdDepSeq.switches['s]}
ELSE t.pattern ← FileParms.nullActual;
t.objectName ← fi.bcdFileName;
t.objectFile ← Subr.NewFile[fi.bcdFileName, Subr.Write, 10];
t.debugPass ← LAST[CARDINAL];
t.getStream ← LogGetStream;
t.startPass ← CompilerPass;
PrintStartOne[@t];
onestarttime ← Time.Current[];
-- these are here to hide them from the user
t.switches['d] ← TRUE; -- debugging
t.switches['g] ← FALSE; -- log is always Compiler.Log
MDUtil.AcquireMsgLock[];
-- actually call the Compiler!
CompilerOps.DoTransaction[@t ! UNWIND => MDUtil.ReleaseMsgLock[]];
MDUtil.ReleaseMsgLock[];
PrintStopOne[@t, onestarttime];
replaceable ← tryreplacement AND t.matched;
errors ← t.nErrors # 0;
warnings ← t.nWarnings # 0;
IF errors THEN err ← err + 1;
IF warnings THEN warn ← warn + 1;
IF ~errors AND ~warnings THEN good ← good + 1;
IF ~errors THEN fi.bcdVers ← t.objectVersion
ELSE DeleteBadBcd[];
Cleanup[];
}};
StopBatchCompile: PUBLIC PROC RETURNS[nOk, nWarn, nErr: CARDINAL] = {
log: ViewerClasses.Viewer;
IF ~compilerStarted THEN RETURN[0, 0, 0]; -- noop call; compiler not running
IF good # 0 THEN CWF.FWF1[LogWP, " %u successful; "L, @good];
IF warn # 0 THEN CWF.FWF1[LogWP, " %u w/warnings; "L, @warn];
IF err # 0 THEN CWF.FWF1[LogWP, " %u w/errors; "L, @err];
timeCompilerStarted ← Time.Current[] - timeCompilerStarted;
CWF.FWF1[LogWP, "\nTotal elapsed time %y.\n"L, @timeCompilerStarted];
Stream.Delete[logsh]; logsh ← NIL;
CompilerOps.Stop[];
compilerStarted ← FALSE;
log ← ViewerOps.FindViewer["Compiler.Log"];
IF log ~= NIL THEN ViewerOps.RestoreViewer[log];
IF warn > 0 OR err > 0 THEN {
IF log ~= NIL THEN ViewerOps.OpenIcon[log]
ELSE CreateANewViewer["Compiler.log"]};
msgout ← NIL;
RETURN[good, warn, err]};
-- local procedures
CreateANewViewer: PROC [name: Rope.Text] = {
viewer: ViewerClasses.Viewer;
WindowManager.WaitCursor[];
viewer ← ViewerOps.CreateViewer[
flavor: $Text,
info: [name: name, file: LOOPHOLE[name], iconic: FALSE, column: left]];
MDUtil.AcquireMsgLock[];
msgout.PutF["\nCreated Viewer: %s\n", IO.rope[name]
! UNWIND => {MDUtil.ReleaseMsgLock[]}];
MDUtil.ReleaseMsgLock[];
ViewerOps.SetNewFile[viewer];
WindowManager.UnWaitCursor[]};
StartBatchCompile: PROC RETURNS[loadedOk: BOOL] = {
herald: STRING ← [100];
good ← warn ← err ← 0;
logsh ← NIL;
loadedOk ← LoadCompiler[];
timeCompilerStarted ← Time.Current[];
IF ~loadedOk THEN RETURN;
Directory.DeleteFile["Compiler.Log"L
! Directory.Error => {CONTINUE}];
[] ← LogGetStream[log]; -- creates new log
CompilerOps.AppendHerald[herald];
CWF.WF2["%s\n%lt\n"L, herald, @timeCompilerStarted];
CWF.FWF2[LogWP, "%s\n%lt\n"L, herald, @timeCompilerStarted];
CompilerOps.Start[Heap.systemZone];
compilerStarted ← TRUE};
AskTheUser: PROC[filename: LONG STRING, ttyin, ttyout: IO.Handle, dontconfirm: BOOL]
RETURNS[declined: BOOL ← TRUE] = {
ch: CHAR;
-- ask the user if he really wants it compiled
CWF.WF1["Compile %s ... "L, filename];
ch ← IF dontconfirm THEN 'y ELSE MDUtil.IOConfirm['y, ttyin, ttyout];
IF ch = 'q THEN {
CWF.WF0["Quit.\n"L]; SIGNAL Subr.AbortMyself};
IF ch = 'y THEN {
declined ← FALSE; CWF.WF0["Yes.\n"L]}
ELSE CWF.WF0["No.\n"L]};
DirectoryRelease: PROC[ss: FileParms.SymbolSpace] = {};
DirectoryForget: PROC[actual: FileParms.ActualId] = {};
PrintStartOne: PROC[t: POINTER TO CompilerOps.Transaction] = {
swstr: STRING ← [30];
CWF.FWF1[MsgWP, "Compiling: %s"L, t.source.locator.base];
CWF.FWF1[LogWP, "\nCommand: %s"L, t.source.locator.base];
ProduceDifferentialSwitches[swstr, t.switches];
CWF.FWF1[LogWP, "%s\n"L, swstr];
CWF.FWF0[MsgWP, swstr]};
ProduceDifferentialSwitches: PROC[swstr: LONG STRING, sw: CompilerOps.LetterSwitches] = {
standardSwitches: CompilerOps.LetterSwitches ← CompilerOps.DefaultSwitches[];
first: BOOL ← TRUE;
swstr.length ← 0;
FOR c: CHAR IN ['a .. 'z] DO
sd: BOOL = (IF c = 'p THEN FALSE ELSE standardSwitches[c]);
IF sw[c] ~= sd THEN {
IF first THEN {first ← FALSE; LongString.AppendChar[swstr, '/]};
IF sd THEN LongString.AppendChar[swstr, '-];
LongString.AppendChar[swstr, c]};
ENDLOOP};
PrintStopOne: PROC[
t: POINTER TO CompilerOps.Transaction, oneStartTime: LONG CARDINAL] = {
-- first MsgSW
IF t.nErrors > 0 THEN
CWF.FWF1[MsgWP, "%u errors"L, @t.nErrors]
ELSE CWF.FWF0[MsgWP, "no errors"L];
IF t.nWarnings > 0 THEN CWF.FWF1[MsgWP, ", %u warnings"L, @t.nWarnings];
CWF.FWFCR[MsgWP];
-- now log
CWF.FWF1[LogWP, "%s -- "L, t.source.locator.base];
IF t.nErrors > 0 THEN {
CWF.FWF1[LogWP, " aborted, %u errors"L, @t.nErrors];
IF t.nWarnings > 0 THEN CWF.FWF1[LogWP, " and %u warnings"L, @t.nWarnings];
oneStartTime ← Time.Current[] - oneStartTime;
CWF.FWF1[LogWP, ", time: %y.\n\n"L, @oneStartTime]}
ELSE {
oneStartTime ← Time.Current[] - oneStartTime;
CWF.FWF2[LogWP, "source tokens: %u, time: %y"L, @t.sourceTokens, @oneStartTime];
IF t.objectBytes > 0 THEN
CWF.FWF3[LogWP, "\n code bytes: %u, links: %u, global frame words: %u"L,
@t.objectBytes, @t.linkCount, @t.objectFrameSize];
IF t.nWarnings > 0 THEN CWF.FWF1[LogWP, "\n%u warnings"L, @t.nWarnings];
CWF.FWF0[LogWP, "\n\n"L]}};
LoadCompiler: PROC RETURNS[success: BOOL ← TRUE] = {
cap: File.Capability;
success ← TRUE;
IF Runtime.IsBound[CompilerOps.Start] THEN RETURN; -- already loaded
CWF.WF0["Loading Compiler ... "L];
{
ENABLE ANY => { CWF.WF0["failed.\n"L]; GOTO out};
cap ← Directory.Lookup["compiler.bcd"L];
Runtime.RunConfig[file: cap, offset: 1, codeLinks: TRUE];
CWF.WF0["done.\n"L];
EXITS
out => success ← FALSE;
}};
LogGetStream: PROC[sid: CompilerOps.StreamId] RETURNS[sh: Stream.Handle] = {
IF sid = source THEN RETURN[sourcesh]; -- temporary
IF sid ~= log THEN ERROR;
IF logsh = NIL THEN logsh ← Subr.NewStream["Compiler.Log"L, Subr.Write];
sh ← logsh};
CompilerPass: PROC[p: CARDINAL] RETURNS[goOn: BOOL] = {
goOn ← ~TypeScript.UserAbort[ttyTypeScript];
CWF.FWFC[MsgWP, '.]};
MsgWP: PROC[ch: CHAR] = {msgout.PutChar[ch]};
LogWP: PROC[ch: CHAR] = {logsh.PutChar[ch]};
CWFYRoutine: PROC[uns: LONG POINTER, form: LONG STRING, wp: PROC[CHAR]] = {
time: LONG CARDINAL = LOOPHOLE[uns, LONG POINTER TO LONG CARDINAL]↑;
hr, min, sec: CARDINAL;
[min, sec] ← Inline.LongDivMod[time, 60];
[hr, min] ← Inline.DIVMOD[min, 60];
IF hr > 0 THEN CWF.FWF3[wp, "%u:%02u:%02u"L, @hr, @min, @sec]
ELSE IF min > 0 THEN CWF.FWF2[wp, "%u:%02u"L, @min, @sec]
ELSE CWF.FWF1[wp, "%u"L, @sec]};
CWF.SetCode['y, CWFYRoutine];
}.