
<<file Sequencer.mesa>>
<<last modified by Satterthwaite, June 8, 1983 4:27 pm>>
<<last modified by Russ Atkinson, 10-Dec-80 10:53:50>>
<<Last Edited by: Maxwell, August 2, 1983 3:06 pm>>
<<>>
DIRECTORY
BasicTime: TYPE USING [],
Alloc: TYPE USING [
Handle, Selector, TableInfo, Chunkify, Create, Destroy, Failure, Reset],
CBinary: TYPE USING [DebugTab, ErrorTab, MesaTab],
CompilerOps: TYPE USING [LetterSwitches, StreamId, Transaction],
CompilerUtil: TYPE USING [
TableId,
InstallParseTables, PrefillSymbols, P1Unit, P2Unit, P3Unit, P3Postlude, P4Unit, P5module,
EndObjectFile, PrintBodies, PrintSymbols, PrintTree, StartObjectFile, TableOut],
ComData: TYPE USING [
bcdSeg, codeSeg, compilerVersion, globalFrameSize, interface, linkCount, matched,
nErrors, nWarnings, objectBytes, objectStamp, objectVersion,
ownSymbols, pattern, source, sourceTokens, symSeg, switches, table, textIndex, zone],
Copier: TYPE USING [FileInit, FileReset],
FileIO: TYPE USING [StreamFromOpenFile],
FileParmOps: TYPE USING [AcquireOutput, ReleaseOutput],
IO: TYPE USING [card, Close, Flush, PutChar, Put, PutF, PutRope, rope, SetLength, STREAM, time],
LiteralOps: TYPE USING [Initialize, Finalize],
Log: TYPE USING [Error],
OSMiscOps: TYPE USING [
BcdCreateTime, GenerateUniqueId, GetTableBase, --ImageId,--
MergeStamps, SignalArgs, StampToTime, TimeToStamp],
Rope: TYPE USING [ROPE],
SymLiteralOps: TYPE USING [Finalize, Initialize],
SymbolPack: TYPE,
SymbolOps: TYPE USING [Finalize, Initialize],
SymbolSegment: TYPE USING [Tables, treeType],
SymbolTable: TYPE USING [Forget, anySpan],
TimeStamp: TYPE USING [Stamp],
Tree: TYPE USING [Link],
TreeOps: TYPE USING [Finalize, Initialize, PopTree, Reset];

Sequencer: MONITOR
IMPORTS
Alloc, CBinary, CompilerUtil, Copier, FileIO, FileParmOps, IO, Log,
LiteralOps, OSMiscOps, SymLiteralOps, SymbolOps, SymbolTable, TreeOps, 
ownSymbols: SymbolPack, dataPtr: ComData
EXPORTS CompilerOps, CompilerUtil = { 

<<scratch region and scratch zone management>>

zone: UNCOUNTED ZONE;
table: Alloc.Handle _ NIL;

AcquireZone: PUBLIC PROC RETURNS [UNCOUNTED ZONE] = {
RETURN [zone]};


<<stream management>>

StreamId: TYPE = CompilerOps.StreamId;
TransactionPtr: TYPE = REF CompilerOps.Transaction;

getStream: PROC [StreamId] RETURNS [IO.STREAM];

streamInfo: ARRAY StreamId[$source .. $log] OF RECORD [
access: {read, write},
stream: IO.STREAM,
status: RECORD [count: NAT, open: BOOL]];

AcquireStream: PUBLIC PROC [id: StreamId] RETURNS [stream: IO.STREAM] = {
IF streamInfo[id].stream = NIL THEN {
streamInfo[id].stream _ getStream[id];
streamInfo[id].status _ [count:0, open:TRUE]};
stream _ streamInfo[id].stream;
IF streamInfo[id].status = [count: 0, open: FALSE] THEN
streamInfo[id].status.open _ TRUE;
streamInfo[id].status.count _ streamInfo[id].status.count + 1};

ReleaseStream: PUBLIC PROC [id: StreamId] = {
streamInfo[id].status.count _ streamInfo[id].status.count - 1;
IF streamInfo[id].status.count = 0 THEN {
IF streamInfo[id].access = $write THEN streamInfo[id].stream.Flush[];
streamInfo[id].status.open _ FALSE}};


<<table segment management>>

tableBase: ARRAY CompilerUtil.TableId [$error..$debug] OF LONG POINTER;

AcquireTable: PUBLIC PROC [id: CompilerUtil.TableId] RETURNS [LONG POINTER] = {
RETURN [tableBase[id]]};

ReleaseTable: PUBLIC PROC [id: CompilerUtil.TableId] = {};


<<compiler inquiries>>

DefaultSwitches: PUBLIC PROC RETURNS [CompilerOps.LetterSwitches] = {
RETURN [[
TRUE , -- A  Address fault for NIL checks
TRUE , -- B  Bounds checking
TRUE , -- C  compile for Cedar (special FORK)
FALSE, -- D  call Debugger on compiler error (FALSE => just log error)
TRUE , -- E  fixed (big Eval stack)
TRUE , -- F  Floating point microcode
TRUE , -- G  TRUE => loG goes to compiler.log, FALSE => use foo.errlog
FALSE, -- H  unused
FALSE, -- I  unused
FALSE, -- J  cross-Jumping optimization
FALSE, -- K  unused
TRUE , -- L  allocate space for code Links
TRUE , -- M  reference counting Microcode
TRUE , -- N  Nil pointer checking
FALSE, -- O  unused
FALSE, -- P  Pause after compilation with errors
FALSE, -- Q  unused
FALSE, -- R  unused
TRUE , -- S  Sort (by static frequency) global vars & entry indexes
FALSE, -- T  unused
FALSE, -- U  uninitialized variable checking
FALSE, -- V  unused
TRUE , -- W  log Warning messages
FALSE, -- X  unused
FALSE, -- Y  complain about KFCB
FALSE  -- Z  unused
]]};

CompilerVersion: PUBLIC PROC RETURNS [TimeStamp.Stamp] = {
RETURN [dataPtr.compilerVersion]};

AppendHerald: PUBLIC PROC [s: IO.STREAM] = {
s.Put[IO.rope["Cedar 4.x Compiler of "], IO.time[OSMiscOps.BcdCreateTime[]]]};


<<compiler sequencing>>

pass: CHARACTER ['1..'5];

ExtendedTables: TYPE = Alloc.Selector[SymbolSegment.Tables.FIRST .. SymbolSegment.Tables.LAST+1];

Initialize: PROC = {
weights: ARRAY ExtendedTables OF Alloc.TableInfo _ [
[30], [20], [4], [4], [4], [2], [4], [1], [2], [1], [2], [2], [20]];    -- empirical
IF table = NIL THEN {
table _ Alloc.Create[weights: DESCRIPTOR[weights]]; 
table.Chunkify[SymbolSegment.treeType];
table.Chunkify[SymbolSegment.Tables.LAST+1]}    -- codeType
ELSE table.Reset[];
SymbolOps.Initialize[table, zone];  LiteralOps.Initialize[table, zone];
TreeOps.Initialize[table, zone]};

Finalize: PROC [parms: TransactionPtr, ownedObject: BOOL] = {
parms.objectVersion _ dataPtr.objectVersion;
parms.interface _ dataPtr.interface;
parms.matched _ dataPtr.matched AND (dataPtr.nErrors = 0);
parms.sourceTokens _ dataPtr.sourceTokens;
parms.nErrors _ dataPtr.nErrors;  parms.nWarnings _ dataPtr.nWarnings;
parms.objectBytes _ dataPtr.objectBytes;
parms.objectFrameSize _ dataPtr.globalFrameSize;  
parms.linkCount _ dataPtr.linkCount;
parms.bcdPages _ [base: dataPtr.bcdSeg.base, pages: dataPtr.bcdSeg.pages];
parms.codePages _ [base: dataPtr.codeSeg.base, pages: dataPtr.codeSeg.pages];
parms.symbolPages _ [base: dataPtr.symSeg.base, pages: dataPtr.symSeg.pages];
CompilerUtil.EndObjectFile[dataPtr.nErrors=0];
IF streamInfo[$object].stream # NIL THEN {
IO.Close[streamInfo[$object].stream]; streamInfo[$object].stream _ NIL};
IF ownedObject AND parms.objectFile # NIL THEN
FileParmOps.ReleaseOutput[parms.objectFile];
TreeOps.Finalize[];  LiteralOps.Finalize[];  SymbolOps.Finalize[];
table.Reset[]};

Debug: PROC [tree, symbols: PROC [Alloc.Handle]] = {
tree[table]; symbols[table]};


Punt: PUBLIC ERROR = CODE;


started: BOOL _ FALSE;

Start: PUBLIC ENTRY PROC [scratchZone: UNCOUNTED ZONE] = {
IF started THEN Stop[];
zone _ scratchZone;  table _ NIL;
started _ TRUE};

Stop: PUBLIC ENTRY PROC = {
IF started THEN {
zone _ NIL;
IF table # NIL THEN {Alloc.Destroy[table]; table _ NIL};
started _ FALSE}};

DoTransaction: PUBLIC ENTRY PROC [parms: TransactionPtr] = {
root: Tree.Link;
msg, signal: UNSPECIFIED;
debug: BOOL;
nParseErrors: CARDINAL;
parsed, aborted: BOOL;
ownedObject: BOOL _ FALSE;

PrintTreeRoot: PROC [table: Alloc.Handle] = {
CompilerUtil.PrintTree[table, root]};
PrintSymbols: PROC [table: Alloc.Handle] = {
CompilerUtil.PrintSymbols[table, dataPtr.interface]};

IF ~started THEN RETURN WITH ERROR Punt[];
getStream _ parms.getStream;
dataPtr.source _ parms.source;
<<dataPtr.objectFile _ parms.objectName; -- will this be reference-counted?>>
dataPtr.switches _ parms.switches;
dataPtr.matched _ parms.op = replace;
dataPtr.pattern _ parms.pattern;
debug _ dataPtr.switches['d];  dataPtr.switches['d] _ FALSE;

dataPtr.objectVersion _ OSMiscOps.GenerateUniqueId[];
dataPtr.objectStamp _ OSMiscOps.TimeToStamp[dataPtr.source.version];
<<encode switches, compiler version (see DIRECTORY processing also)>>
dataPtr.objectStamp _ OSMiscOps.MergeStamps[
dataPtr.objectStamp, OSMiscOps.TimeToStamp[[0, 0, LOOPHOLE[dataPtr.switches]]]];
dataPtr.objectStamp _ OSMiscOps.MergeStamps[
dataPtr.objectStamp, OSMiscOps.TimeToStamp[dataPtr.compilerVersion]];

dataPtr.nErrors _ dataPtr.nWarnings _ 0;  aborted _ FALSE;
streamInfo[$source] _
[access: $read, stream: parms.sourceStream, status: [count: 0, open: FALSE]];
streamInfo[$object] _ streamInfo[$log] _
[access: $write, stream: NIL, status: [count: 0, open: FALSE]];
Initialize[];
dataPtr.table _ table;  dataPtr.zone _ zone;

BEGIN
ENABLE { 
Alloc.Failure => {IF ~debug THEN GO TO storageFull};
UNWIND => {Finalize[parms, ownedObject]};
ANY => {
IF ~debug THEN {[msg, signal] _ OSMiscOps.SignalArgs[]; GO TO uncaughtSignal}}};

CompilerUtil.PrefillSymbols[];
dataPtr.textIndex _ 0;

<<first pass>>
IF parms.startPass # NIL AND ~parms.startPass[1] THEN GO TO cancel;
pass _ '1;
parsed _ CompilerUtil.P1Unit[];
nParseErrors _ dataPtr.nErrors;
IF ~parsed THEN GO TO failed;
root _ TreeOps.PopTree[];  TreeOps.Reset[];
IF parms.debugPass <= 1 THEN Debug[PrintTreeRoot, PrintSymbols];

<<second pass>>
IF parms.startPass # NIL AND ~parms.startPass[2] THEN GO TO cancel;
pass _ '2;
root _ CompilerUtil.P2Unit[root];
IF parms.debugPass <= 2 THEN Debug[PrintTreeRoot, PrintSymbols];

<<third and fourth passes>>
IF parms.startPass # NIL AND ~parms.startPass[3] THEN GO TO cancel;
SymLiteralOps.Initialize[table];
Copier.FileInit[
[dataPtr.objectVersion, parms.objectName],
table, zone, parms.fileParms];

BEGIN
ENABLE Alloc.Failure => {GO TO noSpace};

pass _ '3;
root _ CompilerUtil.P3Unit[root];
CompilerUtil.P3Postlude[dataPtr.nErrors <= nParseErrors];

IF parms.debugPass <= 3 THEN Debug[PrintTreeRoot, PrintSymbols];
IF dataPtr.nErrors > nParseErrors THEN GO TO DeleteFiles;

dataPtr.objectVersion _ OSMiscOps.StampToTime[dataPtr.objectStamp];
parms.fileParms.Forget[[dataPtr.objectVersion, parms.objectName]];
IF parms.objectFile = NIL THEN {
parms.objectFile _ FileParmOps.AcquireOutput[parms.objectName];
ownedObject _ TRUE}
ELSE SymbolTable.Forget[[parms.objectFile, SymbolTable.anySpan]];
IF parms.objectFile # NIL THEN {
streamInfo[$object].stream _ FileIO.StreamFromOpenFile[parms.objectFile];
IO.SetLength[streamInfo[$object].stream, 0]};
CompilerUtil.StartObjectFile[AcquireStream[$object], zone];

IF parms.startPass # NIL AND ~parms.startPass[4] THEN GO TO subCancel;
pass _ '4;
CompilerUtil.P4Unit[root];
IF parms.debugPass <= 4 THEN Debug[CompilerUtil.PrintBodies, PrintSymbols];
GO TO DeleteFiles;

EXITS
DeleteFiles => Copier.FileReset[];
subCancel => {Copier.FileReset[]; GO TO cancel};
noSpace => {Copier.FileReset[]; SymLiteralOps.Finalize[]; GO TO storageFull};
END;

IF dataPtr.nErrors # 0 THEN GO TO failed;

<<fifth pass>>
IF ~dataPtr.interface THEN {
ENABLE UNWIND => {CompilerUtil.EndObjectFile[FALSE]};
IF parms.startPass # NIL AND ~parms.startPass[5] THEN GO TO cancel;
pass _ '5;
CompilerUtil.P5module[]};
SymLiteralOps.Finalize[];

IF parms.startPass # NIL AND ~parms.startPass[6] THEN GO TO cancel;
CompilerUtil.TableOut[table];
<<IF parms.startPass # NIL THEN [] _ parms.startPass[0];>>
IF dataPtr.nErrors # 0 THEN GO TO failed;

EXITS
failed => aborted _ TRUE;
cancel => {Log.Error[aborted];  aborted _ TRUE};
uncaughtSignal => {
errorStream: IO.STREAM = AcquireStream[$log];
Log.Error[compilerError];  aborted _ TRUE;
IO.PutRope[errorStream, "in Pass "];  IO.PutChar[errorStream, pass];
IO.PutF[errorStream, ", signal = %b", IO.card[LOOPHOLE[signal, CARDINAL]]];
IO.PutF[errorStream, ", message = %b", IO.card[LOOPHOLE[msg, CARDINAL]]];
IO.PutChar[errorStream, '\n];
ReleaseStream[$log];
Finalize[parms, ownedObject];  RETURN WITH ERROR Punt[]};
storageFull => StorageProblem["overflow"];
END;

Finalize[parms, ownedObject]};

StorageProblem: PROC [message: Rope.ROPE] = {
errorStream: IO.STREAM = AcquireStream[$log];
dataPtr.nErrors _ dataPtr.nErrors+1;
IO.PutRope[errorStream, "\nStorage "];  IO.PutRope[errorStream, message];
IO.PutRope[errorStream, " in Pass "];  IO.PutChar[errorStream, pass];
IO.PutChar[errorStream, '\n];
ReleaseStream[$log]};


<<* * * * * *  M A I N   B O D Y   C O D E  * * * * * *>>

START dataPtr;     -- initialize STRING variables, etc.
START ownSymbols;
dataPtr.ownSymbols _ ownSymbols;
<<dataPtr.compilerVersion _ OSMiscOps.ImageId[];>>
dataPtr.compilerVersion _ [net: 0Ch, host: 0Ch, time: 0F0010004h]; -- Cedar release

CompilerUtil.InstallParseTables[OSMiscOps.GetTableBase[CBinary.MesaTab]] ;
tableBase[$error] _ OSMiscOps.GetTableBase[CBinary.ErrorTab];
tableBase[$debug] _ OSMiscOps.GetTableBase[CBinary.DebugTab];

}.