-- SMP4Impl.mesa
-- last edit by Schmidt, May 18, 1983 4:12 pm
-- last edit by Satterthwaite, May 26, 1983 5:40 pm
-- code to run the compiler for the Cedar Modeller
DIRECTORY
Atom: TYPE USING [GetPName, MakeAtom],
BcdStamps: TYPE USING [Compute],
CompilerOps: TYPE USING [
AppendHerald, CompilerVersion, DefaultSwitches, DoTransaction,
LetterSwitches, Start, Stop, StreamId, Transaction],
CS: TYPE USING [
Confirm, EndsIn, EqualRope, EquivalentRope, MakeTS, NewFile, NewStream,
SetPFCodes, Write],
Directory: TYPE USING [DeleteFile, Error, Handle, ignore, Lookup, Rename, UpdateDates],
File: TYPE USING [Capability, nullCapability, read],
FileParms: TYPE USING [
ActualId, BindingProc, Name, nullActual, nullSymbolSpace, SymbolSpace],
FileStream: TYPE USING [Create],
Heap: TYPE USING [systemZone],
IO: TYPE USING [
card, CreateProcsStream, CreateRefStreamProcs, Handle, PutChar, PutF, PutFR,
rope, STREAM, string, UserAbort, UserAborted],
List: TYPE USING [Reverse],
Loader: TYPE USING [Instantiate, Start],
LongString: TYPE USING [SubString, SubStringDescriptor],
PrincOps: TYPE USING [ControlModule],
Rope: TYPE USING [Cat, Fetch, Flatten, FromChar, IsEmpty, Length, Lower, ROPE, Text],
RopeInline: TYPE USING [InlineFlatten],
RTOS: TYPE USING [CheckForModuleReplacement],
Runtime: TYPE USING [IsBound],
SMEval: TYPE USING [CompMod, CompModRecord, LoadMod],
SMFI: TYPE USING [BcdFileInfo, BcdModuleRecord, SrcFileInfo],
SMFIOps: TYPE USING [
AllocateBcdFileInfo, ConstructFIBcd, EraseCacheEntryForBcd, GetExtFromParse,
LookupBcdFileInfo, NewVersionOfBcd, PutExtInParse],
SMLoad: TYPE USING [ReplaceResult],
SMOps: TYPE USING [MS, PL],
SMP4: TYPE USING [],
SMSrcBcd: TYPE USING [AddBcdInfo],
SMTree: TYPE Tree USING [Handle, Link],
SMTreeOps: TYPE USING [OpName, NthSon, NSons, Scan, ScanSons],
Stream: TYPE USING [Delete, Handle, PutChar],
Time: TYPE USING [Current],
TimeStamp: TYPE USING [Null, Stamp],
ViewerClasses: TYPE USING [Viewer],
ViewerOps: TYPE USING [CreateViewer, FindViewer, OpenIcon, RestoreViewer],
WindowManager: TYPE USING [UnWaitCursor, WaitCursor];
-- this monitor locks the compiler
SMP4Impl: CEDAR MONITOR
IMPORTS
Atom, BcdStamps, CompilerOps, CS, Directory, FileStream, Heap, IO, List, Loader,
Rope, RopeInline, RTOS, Runtime, SMFIOps, SMOps, SMSrcBcd, SMTreeOps,
Stream, Time, ViewerOps, WindowManager
EXPORTS SMP4 ~ {
OPEN Tree~~SMTree, TreeOps~~SMTreeOps;
-- MDS usage
-- all these variables are protected by the monitor
compilerIsLocked: BOOL ← FALSE;
compilerWait: CONDITION;
logsh: IO.STREAM ← NIL; -- out stream to Compiler.Log
logpilotsh: Stream.Handle ← NIL;
sourcesh: Stream.Handle; -- in stream to source file
msgsw: IO.STREAM; -- out stream to print status messages
inputsh: IO.STREAM ← NIL; -- in stream from typescript
good, warn, err: CARDINAL ← 0;
compilerStarted: BOOL ← FALSE;
timeCompilerStarted: LONG CARDINAL ← 0;
-- endof MDS
OuterCompEval: PUBLIC PROC[
ms: SMOps.MS, t: Tree.Link, confirm: REF BOOL, replacement: BOOL]
RETURNS[errors: BOOL] ~ {
ENABLE UNWIND => ReleaseCompilerLock[];
time: LONG CARDINAL;
numberSuccessful, numberOfWarnings, numberOfErrors: CARDINAL;
errors ← FALSE;
AcquireCompilerLock[];
inputsh ← ms.in;
msgsw ← ms.msgOut;
TRUSTED {time ← Time.Current[]};
TraverseTreeForCompile[ms, NARROW[t], confirm, replacement
! UNWIND => {[] ← StopBatchCompile[]}];
[numberSuccessful, numberOfWarnings, numberOfErrors] ← StopBatchCompile[];
TRUSTED {time ← Time.Current[] - time};
IF numberSuccessful = 0 AND numberOfErrors = 0 AND numberOfWarnings = 0 THEN
ms.PL["Nothing was compiled.\n"L]
ELSE {
ms.out.PutF["%d successful; ", IO.card[numberSuccessful]];
IF numberOfErrors > 0 THEN ms.out.PutF["%d w/errors; ", IO.card[numberOfErrors]];
IF numberOfWarnings > 0 THEN
ms.out.PutF["%d w/warnings; ", IO.card[numberOfWarnings]];
ms.PL["\n"L]};
ms.PL["\n"L];
ms.out.PutF["Elapsed time for compile: %r\n", IO.card[time]];
ms.out.PutF["--------------------------------\n"];
ReleaseCompilerLock[];
errors ← numberOfErrors > 0};
AcquireCompilerLock: ENTRY PROC ~ {
ENABLE UNWIND => {NULL};
WHILE compilerIsLocked DO WAIT compilerWait ENDLOOP;
compilerIsLocked ← TRUE};
ReleaseCompilerLock: ENTRY PROC ~ {
ENABLE UNWIND => {NULL};
compilerIsLocked ← FALSE;
NOTIFY compilerWait};
TraverseTreeForCompile: PROC[
ms: SMOps.MS, top: Tree.Handle, confirm: REF BOOL, replacement: BOOL] ~ {
Consider: PROC[anode: Tree.Handle, oldLoadMod: SMEval.LoadMod] ~ {
groupOrBind: Tree.Handle;
firstSon: Tree.Link;
TreeOps.ScanSons[anode, AnalSons];
groupOrBind ← NARROW[TreeOps.NthSon[anode, 2]];
IF TreeOps.OpName[groupOrBind] ~= $bind
AND TreeOps.OpName[groupOrBind] ~= $group THEN
RETURN;
firstSon ← TreeOps.NthSon[anode, 1];
WITH firstSon SELECT FROM
fiSrc: SMFI.SrcFileInfo => {
compMod: SMEval.CompMod ~ PossibleRecomp[
ms, fiSrc, groupOrBind, confirm, replacement, oldLoadMod];
SMFIOps.PutExtInParse[anode, compMod]};
ENDCASE => NULL; -- do nothing
};
-- ms is passed in
AnalSons: TreeOps.Scan ~ {
WITH t SELECT FROM
applyNode: Tree.Handle => {
SELECT applyNode.name FROM
$apply => {
ext: Tree.Link ← SMFIOps.GetExtFromParse[applyNode];
IF ext ~= NIL AND ISTYPE[ext, SMEval.LoadMod] THEN {
-- manages to skip outer loading apply node
AnalSons[TreeOps.NthSon[applyNode, 2]];
Consider[NARROW[TreeOps.NthSon[applyNode, 1]], NARROW[ext]]}
ELSE {
IF ext ~= NIL THEN RETURN; -- already analyzed
Consider[applyNode, NIL]};
};
ENDCASE => TreeOps.ScanSons[applyNode, AnalSons]};
ENDCASE => NULL;
};
TreeOps.ScanSons[top, AnalSons]};
PossibleRecomp: PROC[
ms: SMOps.MS, fiSrc: SMFI.SrcFileInfo,
groupOrBind: Tree.Handle, confirm: REF BOOL, replacement: BOOL,
oldLoadMod: SMEval.LoadMod]
RETURNS[compMod: SMEval.CompMod] ~ TRUSTED {
fiBcd: SMFI.BcdFileInfo;
errors, declined: BOOL;
directoryList: LIST OF REF FormalActual;
bcdVers: TimeStamp.Stamp;
switches: CompilerOps.LetterSwitches;
expSortSwitch: BOOL;
compMod ← NEW[SMEval.CompModRecord ← [fiSrc: fiSrc]];
[bcdVers, directoryList, switches, expSortSwitch] ←
ConstructBcdStampFromBinding[ms, fiSrc, groupOrBind];
compMod.fiBcd ← SMFIOps.LookupBcdFileInfo[fiSrc.srcFileName, bcdVers];
-- first scan existing projection database
ms.out.PutF["Considering compilation of %s ..\n", IO.rope[compMod.fiSrc.srcFileName]];
IF compMod.fiBcd ~= NIL THEN RETURN; -- already exists
-- see if on disk
fiBcd ← SMFIOps.ConstructFIBcd[compMod.fiSrc.shortname, bcdVers];
IF fiBcd.bcdPresent AND bcdVers = fiBcd.bcdVers THEN {
compMod.fiBcd ← fiBcd; RETURN};
IF ~fiBcd.bcdPresent THEN
ms.out.PutF["Must compile %g since there is no .Bcd on the disk.\n",
IO.rope[compMod.fiSrc.srcFileName]]
ELSE
ms.out.PutF["Must compile because bcd on disk is stamped %a, and the newer version will be stamped %a.\n",
CS.MakeTS[fiBcd.bcdVers], CS.MakeTS[bcdVers]];
-- bcd is not ok or doesn't exist, must recompile
[errors, declined] ← ArrangeForCompile[
ms, compMod.fiSrc, groupOrBind, replacement,
fiBcd, switches, directoryList, confirm, expSortSwitch, oldLoadMod];
IF ~declined THEN {
IF errors THEN {
-- there were errors, remove any capabilities for it
SMFIOps.EraseCacheEntryForBcd[fi: fiBcd];
compMod ← NIL}
ELSE {
-- record new version and update cache
[] ← SMFIOps.NewVersionOfBcd[fi: fiBcd];
compMod.fiBcd ← fiBcd};
}
ELSE compMod ← NIL};
ArrangeForCompile: PROC[
ms: SMOps.MS, fiOuter: SMFI.SrcFileInfo, groupOrBind: Tree.Handle,
tryreplacement: BOOL, fiBcd: SMFI.BcdFileInfo, switches: CompilerOps.LetterSwitches,
directoryList: LIST OF REF FormalActual, confirm: REF BOOL, expSortSwitch: BOOL,
oldLoadMod: SMEval.LoadMod]
RETURNS[errors, declined: BOOL] ~ TRUSTED {
warnings, replaceable: BOOL;
errors ← declined ← warnings ← replaceable ← FALSE;
IF oldLoadMod ~= NIL
AND oldLoadMod.loadInfoSeq ~= NIL
AND oldLoadMod.loadInfoSeq.size = 1 THEN {
-- try for replacement
oldBcdFileName: Rope.Text ~ GenUniqueBcdName[fiBcd.bcdFileName];
replaceResult: SMLoad.ReplaceResult ← (SELECT TRUE FROM
CS.EquivalentRope[oldBcdFileName, fiBcd.bcdFileName] => $cantCopyOldBcd,
~RTOS.CheckForModuleReplacement[oldLoadMod.loadInfoSeq[0].frame] =>
$checkForMRFailed,
ENDCASE => $ok);
IF replaceResult ~= $ok THEN {
ms.out.PutF["%s cannot be replaced because %s.\n",
IO.rope[fiBcd.bcdFileName],
IO.rope[SELECT replaceResult FROM
$cantCopyOldBcd => "can't copy old bcd",
$checkForMRFailed => "RT check for module replacement failed",
ENDCASE => ERROR]];
declined ← TRUE;
GOTO skip};
Directory.Rename[
newName~LOOPHOLE[oldBcdFileName], oldName~LOOPHOLE[fiBcd.bcdFileName]];
fiBcd.bcdCap ← File.nullCapability;
ms.out.PutF["Old version of %s renamed to %s.\n",
IO.rope[fiBcd.bcdFileName], IO.rope[oldBcdFileName]];
[errors, warnings, replaceable, declined] ← CompileIt[
ms, fiOuter, groupOrBind, oldBcdFileName, TRUE,
fiBcd, switches, directoryList, confirm, expSortSwitch];
IF ~replaceable THEN replaceResult ← $compilerSaysNo;
IF replaceable AND ~errors AND ~declined THEN {
ms.out.PutF["%s passes compiler's test for replaceability.\n", IO.rope[fiBcd.bcdFileName]];
oldLoadMod.loadInfoSeq.mustreplace ← TRUE}
ELSE {
oldLoadMod.loadInfoSeq.mustreplace ← FALSE;
IF declined OR errors THEN {
-- new version has to be deleted
Directory.Rename[
newName: LOOPHOLE[fiBcd.bcdFileName], oldName: LOOPHOLE[oldBcdFileName]];
ms.out.PutF["Old, loaded version of %s has been left on disk.\n",
IO.rope[fiBcd.bcdFileName]]}
ELSE ms.out.PutF[
"%s is not replaceable%s, new version has been left on disk, \n\told loaded version is called %s.\n",
IO.rope[fiBcd.bcdFileName],
IO.rope[IF replaceResult = $compilerSaysNo THEN " (Compiler refuses)" ELSE ""],
IO.rope[oldBcdFileName]]};
EXITS
skip => NULL;
}
ELSE {
[errors, warnings, , declined] ← CompileIt[
ms, fiOuter, groupOrBind, NIL, FALSE,
fiBcd, switches, directoryList, confirm, expSortSwitch]};
};
FormalActual: TYPE ~ RECORD[
id: ATOM,
actual: FileParms.ActualId,
compMod: SMEval.CompMod];
ConstructBcdStampFromBinding: PROC[
ms: SMOps.MS, fiSrc: SMFI.SrcFileInfo, groupOrBind: Tree.Handle]
RETURNS[
bcdVers: TimeStamp.Stamp, directoryList: LIST OF REF FormalActual,
switches: CompilerOps.LetterSwitches, expSortSwitch: BOOL] ~ {
inx: CARDINAL ← 1;
ForEachFormal: TreeOps.Scan ~ {
WITH t SELECT FROM
declElem: Tree.Handle => {
SELECT declElem.name FROM
$declElem => { -- id, compMod are passed in
ForEachActual: TreeOps.Scan ~ {
WITH t SELECT FROM
bindElem: Tree.Handle => {
SELECT bindElem.name FROM
$bindElem =>
IF TreeOps.NthSon[bindElem, 1] = id THEN {
innerApply: Tree.Link ← TreeOps.NthSon[bindElem, 2];
IF ISTYPE[innerApply, Rope.Text] THEN {
[switches, expSortSwitch] ← InterpolateSwitches[NARROW[innerApply]];
RETURN};
compMod ← NARROW[SMFIOps.GetExtFromParse[innerApply]];
IF compMod = NIL THEN {
-- consider this is the loading apply, try the compiling apply
first: Tree.Link ← TreeOps.NthSon[innerApply, 1];
IF ISTYPE[first, Tree.Handle]
AND TreeOps.OpName[first] = $apply THEN
compMod ← NARROW[SMFIOps.GetExtFromParse[first]]; -- innerApply
};
};
ENDCASE => NULL};
ENDCASE => NULL;
};
id: ATOM;
compMod: SMEval.CompMod;
IF TreeOps.OpName[TreeOps.NthSon[declElem, 2]] ~= $type THEN RETURN;
id ← NARROW[TreeOps.NthSon[declElem, 1]];
compMod ← NIL;
IF TreeOps.OpName[groupOrBind] = $group THEN {
innerApply: Tree.Link;
DO
IF inx > TreeOps.NSons[groupOrBind] THEN EXIT;
innerApply ← TreeOps.NthSon[groupOrBind, inx];
WITH innerApply SELECT FROM
innerApplyNode: Tree.Handle => {
IF TreeOps.OpName[innerApplyNode] = $apply THEN {
compMod ← NARROW[SMFIOps.GetExtFromParse[innerApply]];
IF compMod = NIL THEN {
-- consider this is the loading apply, try the compiling apply
first: Tree.Link ← TreeOps.NthSon[innerApply, 1];
IF TreeOps.OpName[first] = $apply THEN
compMod ← NARROW[SMFIOps.GetExtFromParse[first]];
};
EXIT};
-- else goes to next item
};
str: Rope.Text => [switches, expSortSwitch] ← InterpolateSwitches[str];
ENDCASE => NULL;
inx ← inx + 1;
ENDLOOP;
inx ← inx + 1; -- bump for next iteration
IF compMod = NIL THEN {
ms.out.PutF["No compMod for formal '%s'.\n", IO.rope[Atom.GetPName[id]]];
RETURN}
}
ELSE TreeOps.ScanSons[groupOrBind, ForEachActual];
IF compMod = NIL THEN
ms.out.PutF["can't find %s in actual tree.\n", IO.rope[Atom.GetPName[id]]]
ELSE {
actual: FileParms.ActualId;
fiInner: SMFI.BcdFileInfo ~ compMod.fiBcd;
actual ← [
version~fiInner.bcdVers,
locator~[
base~LOOPHOLE[fiInner.bcdFileName],
offset~0, length~fiInner.bcdFileName.Length]];
directoryList ← CONS[NEW[FormalActual ← [id, actual, compMod]], directoryList]};
};
ENDCASE => NULL};
ENDCASE => NULL;
};
domain: Tree.Handle ~ NARROW[TreeOps.NthSon[fiSrc.type, 1]];
stampList: LIST OF REF TimeStamp.Stamp;
TRUSTED {switches ← CompilerOps.DefaultSwitches[]};
expSortSwitch ← FALSE;
TreeOps.ScanSons[domain, ForEachFormal];
FOR l: LIST OF REF FormalActual ← directoryList, l.rest UNTIL l = NIL DO
stampList ← CONS[NEW[TimeStamp.Stamp ← l.first.actual.version], stampList];
ENDLOOP;
-- stampList is now reversed in the correct order!!!
TRUSTED {directoryList ← LOOPHOLE[List.Reverse[LOOPHOLE[directoryList]]]};
switches['s] ← expSortSwitch; -- prefer not sorted
TRUSTED {bcdVers ← BcdStamps.Compute[
fiSrc.srcCreate, switches, CompilerOps.CompilerVersion[], stampList]};
ms.out.PutF[
"For %s, the version stamp is %a\n", IO.rope[fiSrc.shortname], CS.MakeTS[bcdVers]];
};
CompileIt: UNSAFE PROC[
ms: SMOps.MS, fiOuter: SMFI.SrcFileInfo, groupOrBind: Tree.Handle,
oldBcdFileName: Rope.Text, tryreplacement: BOOL, fiBcd: SMFI.BcdFileInfo,
switches: CompilerOps.LetterSwitches,
directoryList: LIST OF REF FormalActual, confirm: REF BOOL, expSortSwitch: BOOL]
RETURNS[errors, warnings, replaceable, declined: BOOL] ~ UNCHECKED {
t: CompilerOps.Transaction;
cap: File.Capability;
onestarttime: LONG CARDINAL;
loadedOk: BOOL;
DirectoryBinding: PROC[
formalId, formalType: FileParms.Name, defaultLocator: LONG STRING,
binder: FileParms.BindingProc] ~ TRUSTED {
desiredName: Rope.Text ~ SubStringToRope[@formalId];
desiredId: ATOM ~ Atom.MakeAtom[desiredName];
FOR l: LIST OF REF FormalActual ← directoryList, l.rest UNTIL l = NIL DO
IF l.first.id = desiredId THEN {
fiInner: SMFI.BcdFileInfo ~ l.first.compMod.fiBcd;
binder[l.first.actual];
ms.out.PutF["match %g with %g of %a\n", IO.rope[desiredName],
IO.rope[fiInner.bcdFileName], CS.MakeTS[fiInner.bcdVers]];
RETURN};
ENDLOOP;
ms.out.PutF["\nError - '%s' not found on any parameter list.\n", IO.rope[desiredName]]};
-- called after DirectoryBinding, except for hidden directory entries
DirectoryAcquire: PROC[
type: LongString.SubStringDescriptor, actual: FileParms.ActualId]
RETURNS[ss: FileParms.SymbolSpace] ~ TRUSTED {
bcdFileName: Rope.Text;
fiInner: SMFI.BcdFileInfo;
FOR l: LIST OF REF FormalActual ← directoryList, l.rest UNTIL l = NIL DO
IF l.first.actual.version = actual.version THEN
RETURN[FindSymbolSpace[ms, l.first.compMod.fiBcd, type]];
ENDLOOP;
-- not found
bcdFileName ← SubStringToRope[@actual.locator];
IF CS.EndsIn[bcdFileName, "."L] THEN
bcdFileName ← bcdFileName.Flatten[len~bcdFileName.Length-1];
fiInner ← SMFIOps.LookupBcdFileInfo[bcdFileName, actual.version];
IF fiInner ~= NIL THEN {
ss ← FindSymbolSpace[ms, fiInner, type];
IF ss = FileParms.nullSymbolSpace THEN
ms.out.PutF["Can't get symbol space for type %s, file %s\n",
IO.rope[SubStringToRope[@type]], IO.rope[bcdFileName]];
RETURN[FindSymbolSpace[ms, fiInner, type]]};
ms.out.PutF["%s of %v not found on parameter list.\n",
IO.rope[bcdFileName], CS.MakeTS[actual.version]];
RETURN[FileParms.nullSymbolSpace]};
DeleteBadBcd: UNSAFE PROC ~ {
IF t.objectName ~= NIL THEN Directory.DeleteFile[t.objectName];
t.objectName ← NIL};
Cleanup: UNSAFE PROC ~ {
IF t.sourceStream ~= NIL THEN Stream.Delete[t.sourceStream];
t.sourceStream ← NIL; sourcesh ← NIL};
{
ENABLE UNWIND => {DeleteBadBcd[]; Cleanup[]};
errors ← warnings ← declined ← TRUE; replaceable ← FALSE;
t.sourceStream ← NIL; t.objectName ← NIL;
t.switches ← switches;
IF AskTheUser[ms, fiOuter.srcFileName, ~confirm↑, t.switches] THEN RETURN;
declined ← FALSE;
-- make sure the compiler is loaded, etc.
IF ~compilerStarted THEN {
loadedOk ← StartBatchCompile[ms];
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~fiOuter.srcCreate],
locator~[
base~LOOPHOLE[fiOuter.srcFileName],
offset~0, length~fiOuter.srcFileName.Length]];
cap ← Directory.UpdateDates[fiOuter.srcCap, File.read];
sourcesh ← t.sourceStream ← FileStream.Create[cap];
t.fileParms ← [DirectoryBinding, DirectoryAcquire, DirectoryRelease, DirectoryForget];
IF tryreplacement THEN {
fiBcdForOld: SMFI.BcdFileInfo;
IF fiBcd.bcdVers = TimeStamp.Null THEN ERROR;
t.pattern ← [
version~fiBcd.bcdVers,
locator~[base: LOOPHOLE[oldBcdFileName], offset~0, length~oldBcdFileName.Length]];
fiBcdForOld ← SMFIOps.AllocateBcdFileInfo[];
fiBcdForOld.bcdFileName ← oldBcdFileName;
SMFIOps.NewVersionOfBcd[fiBcdForOld]}
ELSE t.pattern ← FileParms.nullActual;
t.objectName ← LOOPHOLE[fiBcd.bcdFileName];
t.objectFile ← CS.NewFile[fiBcd.bcdFileName, CS.Write, 10];
t.debugPass ← CARDINAL.LAST;
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
t.switches['s] ← expSortSwitch;
-- actually call the Compiler!
CompilerOps.DoTransaction[@t];
PrintStopOne[ms, @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 NOT warnings THEN good ← good + 1;
IF ~errors THEN fiBcd.bcdVers ← t.objectVersion ELSE DeleteBadBcd[];
Cleanup[]}};
FindSymbolSpace: PROC[
ms: SMOps.MS, fiBcd: SMFI.BcdFileInfo, type: LongString.SubStringDescriptor]
RETURNS[ss: FileParms.SymbolSpace] ~ TRUSTED {
name: Rope.Text ~ SubStringToRope[@type];
-- warning: this is a workaround, SHOULD NOT be calling SMSrcBcd.AddBcdInfo
-- as it is only supposed to be called from SMFIImpl
IF fiBcd.bcdInfo = NIL THEN SMSrcBcd.AddBcdInfo[ms, fiBcd];
-- for replacement when old Bcd is needed
IF name.IsEmpty THEN RETURN[fiBcd.bcdInfo.modules.first.symbolSpace];
FOR mod: LIST OF SMFI.BcdModuleRecord ← fiBcd.bcdInfo.modules, mod.rest UNTIL mod = NIL DO
IF CS.EqualRope[name, mod.first.moduleName] THEN
RETURN[mod.first.symbolSpace];
ENDLOOP;
RETURN[FileParms.nullSymbolSpace]};
-- local procedures
StartBatchCompile: PROC[ms: SMOps.MS] RETURNS[loadedOk: BOOL] ~ TRUSTED {
herald: STRING ← [100];
good ← warn ← err ← 0;
logsh ← NIL;
loadedOk ← LoadCompiler[ms];
timeCompilerStarted ← Time.Current[];
IF ~loadedOk THEN RETURN;
Directory.DeleteFile["Compiler.Log"L ! Directory.Error => {CONTINUE}];
[] ← LogGetStream[log]; -- creates new log
CompilerOps.AppendHerald[herald];
ms.out.PutF["%s\n%t\n", IO.string[herald], IO.card[timeCompilerStarted]];
logsh.PutF["%s\n%t\n", IO.string[herald], IO.card[timeCompilerStarted]];
CompilerOps.Start[Heap.systemZone];
compilerStarted ← TRUE};
StopBatchCompile: 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 logsh.PutF[" %d successful; ", IO.card[good]];
IF warn # 0 THEN logsh.PutF[" %d w/warnings; ", IO.card[warn]];
IF err # 0 THEN logsh.PutF[" %d w/errors; ", IO.card[err]];
TRUSTED {timeCompilerStarted ← Time.Current[] - timeCompilerStarted};
logsh.PutF["\nTotal elapsed time %y.\n", IO.card[timeCompilerStarted]];
TRUSTED {Stream.Delete[logpilotsh]};
logsh ← NIL;
TRUSTED {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 {msgsw.PutChar['\n]; CreateANewViewer["Compiler.log", msgsw]}};
msgsw.PutF["End of compilation\n"];
msgsw ← NIL;
RETURN[good, warn, err]};
CreateANewViewer: PROC [name: Rope.Text, out: IO.STREAM] ~ {
viewer: ViewerClasses.Viewer;
WindowManager.WaitCursor[];
viewer ← ViewerOps.CreateViewer[
flavor~$Text,
info~[name~name, file~name, iconic~FALSE, column~left]];
out.PutF["Created Viewer: %s\n", IO.rope[name]];
WindowManager.UnWaitCursor[]};
AskTheUser: PROC[
ms: SMOps.MS, filename: Rope.Text,
dontconfirm: BOOL, wantsw: CompilerOps.LetterSwitches]
RETURNS[declined: BOOL] ~ {
ch: CHAR;
dif: Rope.ROPE;
declined ← TRUE;
-- ask the user if he really wants it compiled
ms.out.PutF["Compile %s", IO.rope[filename]];
dif ← ProduceDifferentialSwitches[wantsw];
IF ~dif.IsEmpty THEN ms.out.PutF["/%s", IO.rope[dif]];
ms.out.PutF[" ... "];
ch ← IF dontconfirm THEN 'y ELSE 'n;
IF ch = 'n THEN ch ← CS.Confirm['y, ms.in, ms.out] ;
IF ch = 'q THEN {ms.PL["Quit.\n"L]; ERROR IO.UserAborted[]};
IF ch = 'y THEN {declined ← FALSE; ms.PL["Yes.\n"L]}
ELSE ms.PL["No.\n"L]};
ProduceDifferentialSwitches: PROC[sw: CompilerOps.LetterSwitches]
RETURNS[dif: Rope.ROPE] ~ TRUSTED {
standardSwitches: CompilerOps.LetterSwitches ~ CompilerOps.DefaultSwitches[];
FOR c: CHAR IN ['a .. 'z] DO
sd: BOOL ~ (IF c = 'p THEN FALSE ELSE standardSwitches[c]);
IF sw[c] ~= sd THEN {
IF sd THEN dif ← dif.Cat[Rope.FromChar['-]];
dif ← dif.Cat[Rope.FromChar[c]]};
ENDLOOP;
};
DirectoryRelease: UNSAFE PROC[ss: FileParms.SymbolSpace] ~ {};
DirectoryForget: UNSAFE PROC[actual: FileParms.ActualId] ~ {};
PrintStartOne: UNSAFE PROC[t: POINTER TO CompilerOps.Transaction] ~ UNCHECKED {
first: BOOL ← TRUE;
standardSwitches: CompilerOps.LetterSwitches ~ CompilerOps.DefaultSwitches[];
msgsw.PutF["Compiling: %s", IO.string[t.source.locator.base]];
logsh.PutF["\nCommand: %s", IO.string[t.source.locator.base]];
FOR c: CHAR IN ['a .. 'z] DO
sd: BOOL ~ (IF c = 'p THEN FALSE ELSE standardSwitches[c]);
IF t.switches[c] ~= sd THEN {
IF first THEN {first ← FALSE; msgsw.PutChar['/]; logsh.PutChar['/]};
IF sd THEN {msgsw.PutChar['-]; logsh.PutChar['-]};
msgsw.PutChar[c];
logsh.PutChar[c]};
ENDLOOP;
logsh.PutChar['\n]};
PrintStopOne: UNSAFE PROC[
ms: SMOps.MS,
t: POINTER TO CompilerOps.Transaction, oneStartTime: LONG CARDINAL] ~ UNCHECKED {
-- first MsgSW
IF t.nErrors > 0 THEN msgsw.PutF["%d errors", IO.card[t.nErrors]]
ELSE msgsw.PutF["no errors"];
IF t.nWarnings > 0 THEN msgsw.PutF[", %d warnings", IO.card[t.nWarnings]];
msgsw.PutChar['\n];
-- now log
logsh.PutF["%s -- ", IO.string[t.source.locator.base]];
IF t.nErrors > 0 THEN {
logsh.PutF[" aborted, %d errors", IO.card[t.nErrors]];
IF t.nWarnings > 0 THEN logsh.PutF[" and %d warnings", IO.card[t.nWarnings]];
oneStartTime ← Time.Current[] - oneStartTime;
logsh.PutF[", time: %y.\n\n", IO.card[oneStartTime]]}
ELSE {
oneStartTime ← Time.Current[] - oneStartTime;
logsh.PutF["source tokens: %d, time: %y",
IO.card[t.sourceTokens], IO.card[oneStartTime]];
IF t.objectBytes > 0 THEN
logsh.PutF["\n code bytes: %d, links: %d, global frame words: %d",
IO.card[t.objectBytes], IO.card[t.linkCount], IO.card[t.objectFrameSize]];
IF t.nWarnings > 0 THEN
logsh.PutF["\n%d warnings", IO.card[t.nWarnings]];
ms.PL["\n\n"L]};
};
-- not monitored properly
LoadCompiler: PUBLIC PROC[ms: SMOps.MS] RETURNS[success: BOOL] ~ TRUSTED {
cap: File.Capability;
success ← TRUE;
IF Runtime.IsBound[CompilerOps.Start] THEN RETURN[TRUE]; -- already loaded
ms.PL["Loading Compiler ... "L];
{
ENABLE ANY => {ms.PL["failed.\n"L]; GOTO out};
cm: PrincOps.ControlModule;
cap ← Directory.Lookup["compiler.bcd"L];
[cm~cm] ← Loader.Instantiate[file~cap, offset~1, codeLinks~TRUE];
Loader.Start[cm];
ms.PL["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 {
TRUSTED {logpilotsh ← CS.NewStream["Compiler.Log", CS.Write]};
logsh ← IO.CreateProcsStream[IO.CreateRefStreamProcs[putChar~LogStreamPutChar], NIL];
CS.SetPFCodes[logsh]};
sh ← logpilotsh;
IF sh = NIL THEN ERROR};
LogStreamPutChar: PROC[self: IO.STREAM, char: CHAR] ~ TRUSTED {
logpilotsh.PutChar[char]};
CompilerPass: PROC[p: CARDINAL] RETURNS[goOn: BOOL] ~ {
goOn ← ~inputsh.UserAbort;
msgsw.PutChar['.]};
SubStringToRope: PROC[lp: LongString.SubString] RETURNS[rope: Rope.Text] ~ TRUSTED {
r: Rope.ROPE ← NIL;
FOR i: CARDINAL IN [0 .. lp.length) DO
r ← r.Cat[Rope.FromChar[lp.base[lp.offset+i]]];
ENDLOOP;
rope ← r.Flatten[]};
FoldInParms: PROC[parms: Rope.Text]
RETURNS[switches: CompilerOps.LetterSwitches, explicitSortSwitch: BOOL] ~ {
i: CARDINAL ← 0;
on: BOOL;
ch: CHAR;
-- set defaults
TRUSTED {switches ← CompilerOps.DefaultSwitches[]};
-- switches['s] ← FALSE; the modeller defaults to /-s
explicitSortSwitch ← FALSE;
IF parms # NIL THEN
WHILE i < parms.Length DO
on ← TRUE;
IF parms.Fetch[i] = '- THEN {i ← i + 1; on ← FALSE;};
ch ← Rope.Lower[parms.Fetch[i]];
IF ch IN ['a .. 'z] THEN {
switches[ch] ← on;
IF ch = 's THEN explicitSortSwitch ← TRUE};
i ← i + 1;
ENDLOOP;
};
InterpolateSwitches: PROC[parms: Rope.Text]
RETURNS[switches: CompilerOps.LetterSwitches, explicitSortSwitch: BOOL] ~ {
i: CARDINAL ← 0;
on: BOOL;
ch: CHAR;
-- set defaults
TRUSTED {switches ← CompilerOps.DefaultSwitches[]};
-- switches['s] ← FALSE; the modeller defaults to /-s
explicitSortSwitch ← FALSE;
IF parms = NIL THEN RETURN;
WHILE i < parms.Length DO
on ← TRUE;
IF parms.Fetch[i] = '- THEN {i ← i + 1; on ← FALSE};
ch ← Rope.Lower[parms.Fetch[i]];
IF ch IN ['a .. 'z] THEN {
switches[ch] ← on;
IF ch = 's THEN explicitSortSwitch ← TRUE};
i ← i + 1;
ENDLOOP;
};
GenUniqueBcdName: PROC[bcdFileName: Rope.Text]
RETURNS[newName: Rope.Text] ~ TRUSTED {
inx: CARDINAL ← 1;
newName ← bcdFileName;
DO
newName ← RopeInline.InlineFlatten[
IO.PutFR["%s.%d.Bcd$", IO.rope[bcdFileName], IO.card[inx]]];
[] ← Directory.Lookup[fileName: LOOPHOLE[newName], permissions: Directory.ignore
! Directory.Error => {GOTO out}];
inx ← inx + 1;
ENDLOOP;
EXITS
out => NULL;
};
}.