-- file Pass1.Mesa
-- last modified by Satterthwaite, October 30, 1979 3:43 PM
DIRECTORY
AltoDefs: FROM "altodefs" USING [charlength, maxword, wordlength],
ComData: FROM "comdata"
USING [
bodyIndex, errorStream,
idANY, idBOOLEAN, idCARDINAL, idCHARACTER, idFALSE,
idINTEGER, idLOCK, idREAL, idSTRING, idTRUE, idUNWIND,
nErrors, nTypeCodes, outerCtx, seAnon, sourceTokens, sourceStream,
textIndex, tC0, tC1,
typeBOOLEAN, typeCARDINAL,typeCHARACTER, typeCONDITION, typeINTEGER,
typeLOCK, typeREAL, typeSTRING, typeStringBody],
CompilerUtil: FROM "compilerutil"
USING [parse, MakeSwappable, TableSegment],
ControlDefs: FROM "controldefs" USING [ControlLink, EPRange, GFTNull],
LiteralOps: FROM "literalops" USING [Find],
P1: FROM "p1" USING [Parse, Scanner, Parser, Pass1T],
SegmentDefs: FROM "segmentdefs"
USING [FileSegmentHandle, FileSegmentAddress, SwapIn, SwapOut, Unlock],
StringDefs: FROM "stringdefs" USING [SubStringDescriptor],
Symbols: FROM "symbols"
USING [
ctxType, seType,
BitAddress, SERecord,
HTIndex, SEIndex, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex,
codeANY, codeINTEGER, codeCHARACTER, typeANY, typeTYPE,
HTNull, RecordSENull, CBTNull, lZ],
SymbolOps: FROM "symbolops"
USING [
EnterString, FillCtxSe, MakeCtxSe, NewCtx, MakeNonCtxSe,
MakeSeChain, NextSe, ResetCtxList, UnderType],
Table: FROM "table" USING [Base, Notifier, AddNotify, DropNotify],
Tree: FROM "tree" USING [Null];
Pass1: PROGRAM
IMPORTS
CompilerUtil, LiteralOps, P1, SegmentDefs, SymbolOps, Table,
dataPtr: ComData
EXPORTS CompilerUtil, P1 =
BEGIN
OPEN SymbolOps, Symbols;
-- symbol table bases
seb: Table.Base; -- semantic entry base
ctxb: Table.Base; -- context table base
P1Notify: Table.Notifier =
BEGIN seb ← base[seType]; ctxb ← base[ctxType] END;
-- definition of standard symbols
WordLength: CARDINAL = AltoDefs.wordlength;
PrefillSymbols: PROCEDURE =
BEGIN -- called to prefill the compiler's symbol table
OPEN dataPtr;
tSei, ptrSei: CSEIndex;
rSei: RecordSEIndex;
tCtx: CTXIndex;
sei: ISEIndex;
outerCtx ← NewCtx[lZ];
idANY ← MakeBasicType["UNSPECIFIED"L, codeANY, TRUE, WordLength];
IF UnderType[idANY] # typeANY THEN ERROR;
idINTEGER ← MakeBasicType["INTEGER"L, codeINTEGER, TRUE, WordLength];
typeINTEGER ← UnderType[idINTEGER];
idCHARACTER ← MakeBasicType["CHARACTER"L, codeCHARACTER, TRUE, AltoDefs.charlength];
typeCHARACTER ← UnderType[idCHARACTER];
-- make BOOLEAN type
typeBOOLEAN ← MakeNonCtxSe[SIZE[enumerated cons SERecord]];
idBOOLEAN ← MakeNamedType["BOOLEAN"L, typeBOOLEAN];
tCtx ← NewCtx[lZ];
seb[typeBOOLEAN] ← SERecord[mark3: TRUE, mark4: TRUE,
body: cons[
enumerated[ordered: TRUE, valueCtx: tCtx, nValues: 2]]];
[] ← MakeConstant["FALSE"L, tCtx, idBOOLEAN, 0];
[] ← MakeConstant["TRUE"L, tCtx, idBOOLEAN, 1];
ResetCtxList[tCtx];
idCARDINAL ← MakeSubrangeType["CARDINAL"L, 0, AltoDefs.maxword];
typeCARDINAL ← UnderType[idCARDINAL];
[] ← MakeNamedType["WORD"L, UnderType[idCARDINAL]];
-- make REAL type
typeREAL ← MakeNonCtxSe[SIZE[real cons SERecord]];
seb[typeREAL] ← SERecord[mark3: TRUE, mark4: TRUE,
body: cons[real[rangeType: idINTEGER]]];
idREAL ← MakeNamedType["REAL"L, typeREAL];
-- make STRING type
typeStringBody ← rSei ← MakeRecord[nFields:3, nBits:2*WordLength];
[] ← MakeField["length"L, idCARDINAL, [wd:0, bd:0], WordLength];
sei ← MakeField["maxlength"L, idCARDINAL, [wd:1, bd:0], WordLength];
seb[sei].immutable ← TRUE;
tSei ← MakeNonCtxSe[SIZE[array cons SERecord]];
seb[tSei] ← SERecord[mark3: TRUE, mark4: TRUE,
body: cons[array[
oldPacked: TRUE,
indexType: idCARDINAL, -- a fudge
componentType: idCHARACTER,
comparable: FALSE,
lengthUsed: FALSE]]];
sei ← MakeField["text"L, tSei, [wd:2, bd:0], 0];
tSei ← MakePointerType[MakeNamedType["StringBody"L, rSei]];
idSTRING ← MakeNamedType["STRING"L, tSei];
typeSTRING ← UnderType[idSTRING];
-- make LOCK type
rSei ← MakeRecord[nFields:1, nBits:WordLength];
seb[rSei].hints.unifield ← FALSE;
[] ← MakeField[NIL, idANY, [wd:0, bd:0], WordLength];
idLOCK ← MakeNamedType["MONITORLOCK"L, rSei];
typeLOCK ← UnderType[idLOCK];
-- make CONDITION type
rSei ← rSei ← MakeRecord[nFields:2, nBits:2*WordLength];
[] ← MakeField[NIL, idANY, [wd:0, bd:0], WordLength];
[] ← MakeField["timeout"L, idCARDINAL, [wd:1, bd:0], WordLength];
typeCONDITION ← UnderType[MakeNamedType["CONDITION"L, rSei]];
-- make a universal pointer type
ptrSei ← MakePointerType[typeANY];
-- enter the Boolean constants
idTRUE ← MakeConstant["TRUE"L, outerCtx, idBOOLEAN, 1];
idFALSE ← MakeConstant["FALSE"L, outerCtx, idBOOLEAN, 0];
-- make a universal NIL
[] ← MakeConstant["NIL"L, outerCtx, ptrSei, 0];
-- make a neutral entry for error recovery
seAnon ← MakeVariable[
name: "?"L,
ctx: outerCtx,
type: typeANY,
offset: [wd:0, bd:0],
nBits: WordLength];
-- predeclare UNWIND
tSei ← MakeNonCtxSe[SIZE[transfer cons SERecord]];
seb[tSei] ← SERecord[mark3: TRUE, mark4: TRUE,
body: cons[
transfer[
mode: error,
inRecord: RecordSENull,
outRecord: RecordSENull]]];
idUNWIND ← MakeConstant["UNWIND"L, outerCtx, tSei,
ControlDefs.ControlLink[procedure[
gfi: ControlDefs.GFTNull,
ep: ControlDefs.EPRange-1,
tag: procedure]]];
-- make some constants
BEGIN
tC0 ← [literal[info: [word[index: LiteralOps.Find[0]]]]];
tC1 ← [literal[info: [word[index: LiteralOps.Find[1]]]]];
END;
ResetCtxList[outerCtx];
END;
SubStringDescriptor: TYPE = StringDefs.SubStringDescriptor;
MakeNamedType: PROCEDURE [s: STRING, type: SEIndex] RETURNS [sei: ISEIndex] =
BEGIN
desc: SubStringDescriptor ← [base:s, offset:0, length:s.length];
sei ← MakeCtxSe[EnterString[@desc], dataPtr.outerCtx];
BEGIN OPEN seb[sei];
idType ← typeTYPE; idInfo ← type; idValue ← Tree.Null;
immutable ← constant ← TRUE;
extended ← public ← linkSpace ← FALSE;
mark3 ← mark4 ← TRUE;
END;
RETURN
END;
MakeBasicType: PROCEDURE
[s: STRING, code: [0..16), ordered: BOOLEAN, nBits: CARDINAL]
RETURNS [ISEIndex] =
BEGIN -- makes an se entry for a built-in type --
sei: CSEIndex = MakeNonCtxSe[SIZE[basic cons SERecord]];
seb[sei] ← SERecord[mark3: TRUE, mark4: TRUE,
body: cons[basic[ordered:ordered, code:code, length:nBits]]];
RETURN [MakeNamedType [s, sei]]
END;
MakeConstant: PROCEDURE
[name: STRING, ctx: CTXIndex, type: SEIndex, value: UNSPECIFIED]
RETURNS [sei: ISEIndex] =
BEGIN -- makes an se entry for a built-in constant --
desc: SubStringDescriptor ← [base:name, offset:0, length:name.length];
sei ← MakeCtxSe[EnterString[@desc], ctx];
BEGIN OPEN seb[sei];
idType ← type; idInfo ← 0; idValue ← value;
immutable ← constant ← TRUE;
extended ← public ← linkSpace ← FALSE;
mark3 ← mark4 ← TRUE;
END;
RETURN
END;
MakeVariable: PROCEDURE
[name: STRING, ctx: CTXIndex, type: SEIndex, offset: BitAddress, nBits: CARDINAL]
RETURNS [sei: ISEIndex] =
BEGIN
desc: SubStringDescriptor ← [base:name, offset:0, length:name.length];
sei ← MakeCtxSe[EnterString[@desc], ctx];
BEGIN OPEN seb[sei];
idType ← type; idValue ← offset; idInfo ← nBits;
immutable ← constant ← public ← extended ← linkSpace ← FALSE;
mark3 ← mark4 ← TRUE;
END;
RETURN
END;
rCtx: CTXIndex;
seChain: ISEIndex;
MakeRecord: PROCEDURE [nFields, nBits: CARDINAL] RETURNS [rSei: RecordSEIndex] =
BEGIN
rSei ← LOOPHOLE[MakeNonCtxSe[SIZE[notLinked record cons SERecord]]];
rCtx ← NewCtx[lZ];
ctxb[rCtx].seList ← seChain ← MakeSeChain[rCtx, nFields, FALSE];
seb[rSei] ← SERecord[mark3: TRUE, mark4: TRUE,
body: cons[
record[
machineDep: TRUE,
argument: FALSE,
hints: [
variant: FALSE,
unifield: nFields = 1,
comparable: FALSE, privateFields: FALSE],
fieldCtx: rCtx,
length: nBits,
lengthUsed: FALSE,
monitored: FALSE,
linkPart: notLinked[]]]];
RETURN
END;
MakeField: PROCEDURE
[name: STRING, type: SEIndex, offset: BitAddress, nBits: CARDINAL]
RETURNS [sei: ISEIndex] =
BEGIN
desc: SubStringDescriptor;
hti: HTIndex;
IF name # NIL
THEN
BEGIN
desc ← [base:name, offset:0, length:name.length];
hti ← EnterString[@desc];
END
ELSE hti ← HTNull;
sei ← seChain; seChain ← NextSe[seChain];
FillCtxSe[sei, hti, FALSE];
BEGIN OPEN seb[sei];
idType ← type; idValue ← offset; idInfo ← nBits;
immutable ← constant ← public ← extended ← linkSpace ← FALSE;
mark3 ← mark4 ← TRUE;
END;
RETURN
END;
MakePointerType: PROCEDURE [refType: SEIndex] RETURNS [sei: CSEIndex] =
BEGIN
sei ← MakeNonCtxSe[SIZE[pointer cons SERecord]];
seb[sei] ← SERecord[mark3: TRUE, mark4: TRUE,
body: cons[
pointer[
ordered: FALSE,
readOnly: FALSE,
basing: FALSE,
refType: refType,
dereferenced: FALSE]]];
RETURN
END;
MakeSubrangeType: PROCEDURE
[s: STRING, origin: INTEGER, range: CARDINAL]
RETURNS [ISEIndex] =
BEGIN
sei: CSEIndex;
sei ← MakeNonCtxSe[SIZE[subrange cons SERecord]];
seb[sei] ← SERecord[mark3: TRUE, mark4: TRUE,
body: cons[
subrange[
filled: TRUE,
empty: FALSE,
flexible: FALSE,
rangeType: dataPtr.idINTEGER,
origin: origin,
range: range]]];
RETURN [MakeNamedType[s, sei]]
END;
LockId: PUBLIC PROCEDURE RETURNS [HTIndex] =
BEGIN
desc: SubStringDescriptor ← [base:"LOCK"L, offset:0, length:("LOCK"L).length];
RETURN [EnterString[@desc]]
END;
EnterHashMark: PROCEDURE =
BEGIN -- marks end of symbols from source file in hash table
desc: SubStringDescriptor ← [base:" "L, offset:1, length:0];
[] ← EnterString[@desc];
END;
P1Unit: PUBLIC PROCEDURE RETURNS [success: BOOLEAN] =
BEGIN OPEN SegmentDefs;
tableSeg: FileSegmentHandle =
CompilerUtil.TableSegment[CompilerUtil.parse];
Table.AddNotify[P1Notify];
PrefillSymbols[];
SwapIn[tableSeg];
dataPtr.textIndex ← 0; dataPtr.bodyIndex ← CBTNull;
dataPtr.nTypeCodes ← 0;
[complete:success, nTokens:dataPtr.sourceTokens, nErrors:dataPtr.nErrors] ←
P1.Parse[
sourceStream: dataPtr.sourceStream,
messageStream: dataPtr.errorStream,
table: LOOPHOLE[FileSegmentAddress[tableSeg]]];
Unlock[tableSeg]; SwapOut[tableSeg];
EnterHashMark[];
Table.DropNotify[P1Notify];
END;
-- initialization code
CompilerUtil.MakeSwappable[P1.Scanner, pass1];
CompilerUtil.MakeSwappable[P1.Parser, pass1];
CompilerUtil.MakeSwappable[P1.Pass1T, pass1];
END.