-- file Sequencer.mesa
-- last modified by Satterthwaite, July 27, 1983 2:51 pm
-- last modified by Russ Atkinson, 10-Dec-80 10:53:50
DIRECTORY
CBinary: TYPE USING [DebugTab, ErrorTab, MesaTab],
Alloc: TYPE USING [
Handle, Selector, TableInfo, Chunkify, Create, Destroy, Failure, Reset],
CharIO: TYPE USING [PutChar, PutOctal, PutString],
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, objectFile, objectStamp, objectVersion,
ownSymbols, pattern, source, sourceTokens, symSeg, switches, table, textIndex, zone],
Copier: TYPE USING [FileInit, FileReset],
File: TYPE USING [nullCapability],
FileParmOps: TYPE USING [AcquireOutput, ReleaseOutput],
FileStream: TYPE USING [Create, SetLength],
LiteralOps: TYPE USING [Initialize, Finalize],
Log: TYPE USING [Error],
OSMiscOps: TYPE USING [
BcdCreateTime, GenerateUniqueId, GetTableBase, --ImageId,--
MergeStamps, SignalArgs, StampToTime, TimeToStamp],
Stream: TYPE USING [Handle, Delete, SendNow],
Strings: TYPE USING [String, AppendString],
SymLiteralOps: TYPE USING [Finalize, Initialize],
SymbolPack: TYPE,
SymbolOps: TYPE USING [Finalize, Initialize],
SymbolSegment: TYPE USING [Tables, treeType],
SymbolTable: TYPE USING [Forget, anySpan],
Time: TYPE USING [Append, Unpack],
TimeStamp: TYPE USING [Stamp],
Tree: TYPE USING [Link],
TreeOps: TYPE USING [Finalize, Initialize, PopTree, Reset];
Sequencer: MONITOR
IMPORTS
Alloc, CBinary, CharIO, CompilerUtil, Copier, FileStream, FileParmOps, Log, LiteralOps,
OSMiscOps, Stream, SymLiteralOps, SymbolOps, SymbolTable, Strings, Time, 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 = POINTER TO CompilerOps.Transaction;
getStream: PROC [StreamId] RETURNS [Stream.Handle];
streamInfo: ARRAY StreamId[$source .. $log] OF RECORD [
access: {read, write},
stream: Stream.Handle,
status: RECORD [count: NAT, open: BOOL]];
AcquireStream: PUBLIC PROC [id: StreamId] RETURNS [stream: Stream.Handle] = {
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.SendNow[];
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: Strings.String] = {
t: STRING = [20];
Time.Append[t, Time.Unpack[[OSMiscOps.BcdCreateTime[]]]];
Strings.AppendString[s, "Cedar 5.0a Compiler of "L];
Strings.AppendString[s, t]};
-- 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 {
Stream.Delete[streamInfo[$object].stream]; streamInfo[$object].stream ← NIL};
IF ownedObject AND parms.objectFile # File.nullCapability 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;
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, 0, parms.objectName.length]],
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, 0, parms.objectName.length]]];
IF parms.objectFile = File.nullCapability THEN {
parms.objectFile ← FileParmOps.AcquireOutput[parms.objectName];
ownedObject ← TRUE}
ELSE SymbolTable.Forget[[parms.objectFile, SymbolTable.anySpan]];
IF parms.objectFile # File.nullCapability THEN {
streamInfo[$object].stream ← FileStream.Create[parms.objectFile];
FileStream.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 => {
OPEN CharIO;
errorStream: Stream.Handle = AcquireStream[$log];
Log.Error[compilerError]; aborted ← TRUE;
PutString[errorStream, "in Pass "L]; PutChar[errorStream, pass];
PutString[errorStream, ", signal = "L]; PutOctal[errorStream, signal];
PutString[errorStream, ", message = "L]; PutOctal[errorStream, msg];
PutChar[errorStream, '\n];
ReleaseStream[$log];
Finalize[parms, ownedObject]; RETURN WITH ERROR Punt[]};
storageFull => StorageProblem["overflow"L];
END;
Finalize[parms, ownedObject]};
StorageProblem: PROC [message: STRING] = {
OPEN CharIO;
errorStream: Stream.Handle = AcquireStream[$log];
dataPtr.nErrors ← dataPtr.nErrors+1;
PutString[errorStream, "\nStorage "L]; PutString[errorStream, message];
PutString[errorStream, " in Pass "L]; PutChar[errorStream, pass];
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: 0F0000005h]; -- Cedar release
CompilerUtil.InstallParseTables[OSMiscOps.GetTableBase[CBinary.MesaTab]] ;
tableBase[$error] ← OSMiscOps.GetTableBase[CBinary.ErrorTab];
tableBase[$debug] ← OSMiscOps.GetTableBase[CBinary.DebugTab];
}.