[_CDCSL_93-16_]<1>Cedar>release>MimosaOnly>Pass1.mesa

Pass1.mesa

Russ Atkinson (RRA) June 21, 1989 12:25:28 pm PDT

Satterthwaite, June 18, 1986 12:19:56 pm PDT

Sweet June 4, 1986 10:12:24 am PDT

JKF May 25, 1990 5:30:09 pm PDT

DIRECTORY

Alloc USING [AddNotify, DropNotify, Notifier],

CompilerUtil USING [AcquireStream, ReleaseStream],

ConvertUnsafe USING [SubString],

IO USING [STREAM],

LiteralOps USING [Find],

MimData,

MimP1 USING [InstallParseTable, Parse],

MimZones USING [permZone],

MobDefs USING [Link, ProcIndex],

SourceMap USING [Cons],

Symbols USING [Alignment, Base, BitAddress, BitOrder, CBTNull, codeANY, codeCHAR, CSEIndex, CTXIndex, CTXNull, ctxType, ISEIndex, ISENull, lZ, Name, nullName, RecordSEIndex, RecordSENull, SERecord, seType, Type, typeANY, typeTYPE],

SymbolOps USING [BitsForType, EncodeBitAddr, EncodeBti, EncodeCard, EncodeLink, EncodeTreeIndex, EncodeType, EnterExtension, EnterString, FillCtxSe, MakeNonCtxSe, MakeSeChain, NewCtx, NextSe, own, SetSeLink],

Target: TYPE MachineParms USING [AlignmentIndex, Alignments, bitOrder, bitsPerAU, bitsPerChar, bitsPerCondVar, bitsPerLongWord, bitsPerMonLock, bitsPerReal, bitsPerRef, bitsPerSignal, bitsPerStringBound, bitsPerWord, condVarInit, monLockInit, wordsPerCondVar, wordsPerMonLock],

Tree USING [Link, nullIndex];

Pass1: PROGRAM

IMPORTS Alloc, MimData, CompilerUtil, LiteralOps, MimP1, MimZones, SourceMap, SymbolOps

EXPORTS CompilerUtil, MimData, MimP1 = {

OPEN Symbols;

targetBitOrder: Symbols.BitOrder = SELECT Target.bitOrder FROM

msBit => msBit, lsBit => lsBit, ENDCASE => ERROR;

bitsPerAU: NAT = Target.bitsPerAU;

assumedWorstCase: NAT = Target.bitsPerWord;

For now, we really can't handle worst-case alignments over a word, since that can lead to bizarre padding attempts in later modules. This should be fixed, eventually, but for now we can live with it.

Exported variables

bitsToAlignment: PUBLIC REF MimData.BitsToAlign ¬ NIL;

wordAlignment: PUBLIC Symbols.Alignment ¬ none;

worstAlignment: PUBLIC Symbols.Alignment ¬ none;

outerCtx: PUBLIC CTXIndex; -- predefined identifiers

idANY: PUBLIC ISEIndex;

idINTEGER, idINT, idDINT, idINT16, idINT32, idINT64: PUBLIC ISEIndex;

idCARDINAL, idCARD, idDCARD, idCARD16, idCARD32, idCARD64: PUBLIC ISEIndex;

idNAT, idCHAR, idBOOL, idSTRING: PUBLIC ISEIndex;

idREAL, idDREAL, idREAL32, idREAL64: PUBLIC ISEIndex;

idTEXT: PUBLIC ISEIndex;

idLOCK: PUBLIC ISEIndex;

idATOM: PUBLIC ISEIndex;

typeSTRING, typeStringBody: PUBLIC CSEIndex;

typeAtomRecord: PUBLIC CSEIndex;

typeRefANY, typeListANY: PUBLIC CSEIndex;

typeLOCK, typeCONDITION: PUBLIC CSEIndex;

tC0, tC1: PUBLIC Tree.Link;

idUNWIND: PUBLIC ISEIndex;

seAnon: PUBLIC ISEIndex;

symbol table bases

seb: Symbols.Base; -- semantic entry base

ctxb: Symbols.Base; -- context table base

P1Notify: Alloc.Notifier = {seb ¬ base[seType]; ctxb ¬ base[ctxType]};

initialization of parsing tables

InstallParseTables: PUBLIC PROC [table: LONG POINTER] = {

MimP1.InstallParseTable[];

};

construction of predeclared symbols

SubString: TYPE = ConvertUnsafe.SubString;

MakeBasicType: PROC [code: [0..16), ordered: BOOL, nBits: CARDINAL]
RETURNS [sei: CSEIndex] = {

sei ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.basic.SIZE];

seb[sei] ¬ [mark3: TRUE, mark4: TRUE, body: cons[
align: bitsToAlignment[nBits],
typeInfo: basic[ordered: ordered, code: code, length: nBits]]];

};

MakeRecordType: PROC [nBits: CARD, packed: BOOL ¬ FALSE, painted: BOOL ¬ FALSE]
RETURNS [rSei: RecordSEIndex] = {

rSei ¬ LOOPHOLE[SymbolOps.MakeNonCtxSe[SERecord.cons.record.notLinked.SIZE]];

seb[rSei] ¬ [mark3: TRUE, mark4: TRUE, body: cons[

align: wordAlignment,

typeInfo: record[

machineDep: TRUE, packed: packed, painted: painted,

bitOrder: targetBitOrder,

grain: Target.bitsPerAU,

argument: FALSE, monitored: FALSE, spare: FALSE, list: FALSE,

hints: [

comparable: FALSE, assignable: FALSE,

variant: FALSE, unifield: FALSE, privateFields: FALSE,

refField: FALSE, default: TRUE, voidable: FALSE],

fieldCtx: SymbolOps.NewCtx[lZ],

length: nBits,

linkPart: notLinked[]]]];

};

MakeRefType: PROC [refType: Type, counted, list: BOOL¬FALSE]
RETURNS [sei: CSEIndex] = {

bits: NAT = IF counted THEN Target.bitsPerRef ELSE Target.bitsPerWord;

sei ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.ref.SIZE];

seb[sei] ¬ [mark3: TRUE, mark4: TRUE, body: cons[

align: bitsToAlignment[bits],

typeInfo: ref[

counted: counted,

var: FALSE,

readOnly: FALSE, ordered: FALSE, list: list, basing: FALSE,

refType: refType,

length: bits

]]];

};

MakeSubrangeType: PROC
[origin: INT, range: CARD, rangeType: Type ¬ MimData.idINTEGER]
RETURNS [sei: CSEIndex] = {

sei ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.subrange.SIZE];

seb[sei] ¬ [mark3: TRUE, mark4: TRUE, body: cons[

align: unknown,

typeInfo: subrange[

filled: TRUE,

empty: range = 0,

biased: FALSE,

rangeType: rangeType,

origin: origin, range: range]]];

seb[sei].align ¬ bitsToAlignment[SymbolOps.BitsForType[SymbolOps.own, sei]];

};

SetIdAttr: PROC [sei: ISEIndex, const: BOOL] = {

seb[sei].immutable ¬ seb[sei].constant ¬ const;

seb[sei].extended ¬ seb[sei].public ¬ seb[sei].linkSpace ¬ FALSE;

seb[sei].mark3 ¬ seb[sei].mark4 ¬ TRUE;

};

FillVariable: PROC
[sei: ISEIndex, name: STRING, type: Type, offset: BitAddress, nBits: NAT] = {

desc: SubString;

hash: Name;

IF name # NIL

THEN {

desc ¬ [base:name, offset:0, length:name.length];

hash ¬ SymbolOps.EnterString[desc];

}

ELSE hash ¬ nullName;

SymbolOps.FillCtxSe[sei, hash, FALSE];

seb[sei].idType ¬ type;

seb[sei].idValue ¬ SymbolOps.EncodeBitAddr[offset];

seb[sei].idInfo ¬ SymbolOps.EncodeCard[nBits];

SetIdAttr[sei, FALSE];

};

FillConstant: PROC [sei: ISEIndex, name: STRING, type: Type, value: WORD] = {

desc: SubString ¬ [base: name, offset: 0, length: name.length];

SymbolOps.FillCtxSe[sei, SymbolOps.EnterString[desc], FALSE];

seb[sei].idType ¬ type;

seb[sei].idInfo ¬ SymbolOps.EncodeCard[0];

seb[sei].idValue ¬ SymbolOps.EncodeCard[value];

SetIdAttr[sei, TRUE];

};

FillXferConstant: PROC [sei: ISEIndex, name: STRING, type: Type, epN: MobDefs.ProcIndex] = {

desc: SubString ¬ [base: name, offset: 0, length: name.length];

SymbolOps.FillCtxSe[sei, SymbolOps.EnterString[desc], FALSE];

seb[sei].idType ¬ type;

seb[sei].idInfo ¬ SymbolOps.EncodeBti[CBTNull];

seb[sei].idValue ¬ SymbolOps.EncodeLink[MobDefs.Link[tag: proc, offset: epN]];

SetIdAttr[sei, TRUE];

};

FillNamedType: PROC [sei: ISEIndex, s: STRING, type: Type] = {

desc: SubString ¬ [base: s, offset: 0, length: s.length];

SymbolOps.FillCtxSe[sei, SymbolOps.EnterString[desc], FALSE];

SetIdAttr[sei, TRUE];

seb[sei].idType ¬ typeTYPE;

seb[sei].idInfo ¬ SymbolOps.EncodeType[type];

seb[sei].idValue ¬ SymbolOps.EncodeTreeIndex[Tree.nullIndex];

SetIdAttr[sei, TRUE];

};

MakeTreeLiteral: PROC [val: CARD] RETURNS [Tree.Link] = {

RETURN [[literal[LiteralOps.Find[either, SymbolOps.EncodeCard[val]]]]];

};

nOuterSymbols: NAT = 44;

number of predeclared ids (outer level only)

Add 1 to this for every new outer-level identifier

nExtraSymbols: NAT = 3;

number of predeclared errors & signals (e.g. - UNWIND, ABORTED, UNCAUGHT)

Add 1 to this for every new predeclared signal/error

PrefillSymbols: PUBLIC PROC = {

OPEN MimData;

tSei: CSEIndex;

rSei: RecordSEIndex;

tCtx: CTXIndex;

sei, seChain: ISEIndex ¬ ISENull;

outerChain: ISEIndex;

outerEntries: NAT ¬ 0;

lastOuter: ISEIndex ¬ ISENull;

NextOuterSe: PROC RETURNS [next: ISEIndex] = {

IF outerChain = ISENull THEN ERROR;

lastOuter ¬ next ¬ outerChain;

outerChain ¬ SymbolOps.NextSe[MimData.ownSymbols, outerChain];

outerEntries ¬ outerEntries + 1;

};

PrefillUnspecified: PROC = {

UNSPECIFIED

idANY ¬ NextOuterSe[];

FillNamedType[idANY, "UNSPECIFIED"L, tSei];

IF tSei # typeANY THEN ERROR;

SELECT Target.bitsPerWord FROM

16 => {

FillNamedType[NextOuterSe[], "UNSPEC16"L, tSei];

tSei ¬ MakeBasicType[codeANY, TRUE, Target.bitsPerWord*2];

FillNamedType[NextOuterSe[], "UNSPEC32"L, idANY];

};

32 => {

FillNamedType[NextOuterSe[], "UNSPEC32"L, idANY];

tSei ¬ MakeSubrangeType[0, 177777B, idANY];

FillNamedType[NextOuterSe[], "UNSPEC16"L, tSei];

};

ENDCASE => ERROR;

};

PrefillIntCardNat: PROC = {

INT*, CARD*, NAT* types

seiINT: CSEIndex;

seiINTEGER: CSEIndex;

seiDINT: CSEIndex;

seiINT16: CSEIndex;

seiINT32: CSEIndex;

seiINT64: CSEIndex;

seiCARD: CSEIndex;

seiCARDINAL: CSEIndex;

seiDCARD: CSEIndex;

seiCARD16: CSEIndex;

seiCARD32: CSEIndex;

seiCARD64: CSEIndex;

seiNAT: CSEIndex;

seiNAT15: CSEIndex;

seiNAT31: CSEIndex;

As of the current compiler there are at least two precisions guaranteed: 64 & 32. It is not yet possible in the compiler to treat INT32 as a subrange of INT64, although such a capability would be desirable.

seiINT64 ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.signed.SIZE];

seb[seiINT64] ¬ [mark3: TRUE, mark4: TRUE, body:
cons[align: bitsToAlignment[64], typeInfo: signed[length: 64]]];

seiCARD64 ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.unsigned.SIZE];

seb[seiCARD64] ¬ [mark3: TRUE, mark4: TRUE, body:
cons[align: bitsToAlignment[64], typeInfo: unsigned[length: 64]]];

seiINT32 ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.signed.SIZE];

seb[seiINT32] ¬ [mark3: TRUE, mark4: TRUE, body:
cons[align: bitsToAlignment[32], typeInfo: signed[length: 32]]];

seiCARD32 ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.unsigned.SIZE];

seb[seiCARD32] ¬ [mark3: TRUE, mark4: TRUE, body:
cons[align: bitsToAlignment[32], typeInfo: unsigned[length: 32]]];

SELECT Target.bitsPerLongWord FROM

64 => {

seiINT ¬ seiINT64;

seiCARD ¬ seiCARD64;

seiDINT ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.signed.SIZE];

seb[seiDINT] ¬ [mark3: TRUE, mark4: TRUE, body:
cons[align: bitsToAlignment[64], typeInfo: signed[length: 128]]];

seiCARD64 ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.unsigned.SIZE];

seb[seiCARD64] ¬ [mark3: TRUE, mark4: TRUE, body:
cons[align: bitsToAlignment[64], typeInfo: unsigned[length: 64]]];

seiDCARD ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.unsigned.SIZE];

seb[seiDCARD] ¬ [mark3: TRUE, mark4: TRUE, body:
cons[align: bitsToAlignment[64], typeInfo: unsigned[length: 128]]];

};

32 => {

seiINT ¬ seiINT32;

seiCARD ¬ seiCARD32;

seiDINT ¬ seiINT64;

seiDCARD ¬ seiCARD64;

};

ENDCASE => ERROR;

seiNAT31 ¬ MakeSubrangeType[0, 17777777777B, seiCARD];

SELECT Target.bitsPerWord FROM

32 => {

seiINTEGER ¬ seiINT32;

seiCARDINAL ¬ seiCARD32;

seiINT16 ¬ MakeSubrangeType[-LONG[100000B], 177777B, seiINT];

seiCARD16 ¬ MakeSubrangeType[0, 177777B, seiCARD];

seiNAT15 ¬ MakeSubrangeType[0, 77777B, seiCARDINAL];

seiNAT ¬ seiNAT31;

};

16 => {

seiINTEGER ¬ seiINT16 ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.signed.SIZE];

seb[seiINT16] ¬ [mark3: TRUE, mark4: TRUE, body:
cons[align: bitsToAlignment[16], typeInfo: signed[length: 16]]];

seiCARDINAL ¬ seiCARD16 ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.unsigned.SIZE];

seb[seiCARD16] ¬ [mark3: TRUE, mark4: TRUE, body:
cons[align: bitsToAlignment[16], typeInfo: unsigned[length: 16]]];

seiNAT ¬ seiNAT15 ¬ MakeSubrangeType[0, 77777B, seiCARDINAL];

};

ENDCASE => ERROR;

FillNamedType[idINT16 ¬ NextOuterSe[], "INT16"L, seiINT16];

FillNamedType[idINT32 ¬ NextOuterSe[], "INT32"L, seiINT32];

FillNamedType[idINT64 ¬ NextOuterSe[], "INT64"L, seiINT64];

FillNamedType[idINT ¬ NextOuterSe[], "INT"L, seiINT];

FillNamedType[idINTEGER ¬ NextOuterSe[], "INTEGER"L, seiINTEGER];

FillNamedType[idDINT ¬ NextOuterSe[], "DINT"L, seiDINT];

FillNamedType[idCARD16 ¬ NextOuterSe[], "CARD16"L, seiCARD16];

FillNamedType[idCARD32 ¬ NextOuterSe[], "CARD32"L, seiCARD32];

FillNamedType[idCARD64 ¬ NextOuterSe[], "CARD64"L, seiCARD64];

FillNamedType[idCARD ¬ NextOuterSe[], "CARD"L, seiCARD];

FillNamedType[idCARDINAL ¬ NextOuterSe[], "CARDINAL"L, seiCARDINAL];

FillNamedType[idDCARD ¬ NextOuterSe[], "DCARD"L, seiDCARD];

SELECT Target.bitsPerStringBound FROM

16 => idStringBound ¬ idCARD16;

32 => idStringBound ¬ idCARD32;

ENDCASE => ERROR;

FillNamedType[NextOuterSe[], "NAT15"L, seiNAT15];

IF Target.bitsPerStringBound = 16 THEN idTextBound ¬ lastOuter;

FillNamedType[NextOuterSe[], "NAT31"L, seiNAT31];

IF Target.bitsPerStringBound = 32 THEN idTextBound ¬ lastOuter;

FillNamedType[idNAT ¬ NextOuterSe[], "NAT"L, seiNAT];

IF Target.bitsPerStringBound = Target.bitsPerWord THEN idTextBound ¬ lastOuter;

FillNamedType[NextOuterSe[], "NATURAL"L, seiNAT];

CHAR, CHARACTER, BIT, BYTE, UNIT, WORD

{

bitType: CSEIndex ¬ MakeSubrangeType[0, 1, idCARD];

byteType: CSEIndex ¬ MakeSubrangeType[0, 255, idCARD];

unitType: CSEIndex ¬ seiCARD;

seiCHAR: CSEIndex;

idCHAR ¬ NextOuterSe[];

seiCHAR ¬ MakeBasicType[codeCHAR, TRUE, Target.bitsPerChar];

FillNamedType[idCHAR, "CHAR"L, seiCHAR];

FillNamedType[NextOuterSe[], "CHARACTER"L, seiCHAR];

FillNamedType[NextOuterSe[], "BIT"L, bitType];

FillNamedType[NextOuterSe[], "BYTE"L, byteType];

SELECT Target.bitsPerAU FROM

1 => unitType ¬ bitType;

8 => unitType ¬ byteType;

16 => unitType ¬ seiCARD16;

32 => unitType ¬ seiCARD32;

64 => unitType ¬ seiCARD64;

ENDCASE => ERROR;

FillNamedType[NextOuterSe[], "UNIT"L, unitType];

FillNamedType[NextOuterSe[], "WORD"L, seiCARDINAL];

FillNamedType[NextOuterSe[], "WORD16"L, seiCARD16];

FillNamedType[NextOuterSe[], "WORD32"L, seiCARD32];

FillNamedType[NextOuterSe[], "DWORD"L,
IF Target.bitsPerWord = Target.bitsPerLongWord
THEN seiDCARD ELSE seiCARD];

};

}; -- PrefillIntCardNat

PrefillBool: PROC = {

BOOL, BOOLEAN

seiBOOL: CSEIndex;

idBOOL ¬ NextOuterSe[];

seiBOOL ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.enumerated.SIZE];

tCtx ¬ SymbolOps.NewCtx[lZ];

seb[seiBOOL] ¬ [mark3: TRUE, mark4: TRUE, body: cons[

align: none,

typeInfo: enumerated[

ordered: TRUE, machineDep: TRUE, sparse: FALSE, painted: TRUE,

valueCtx: tCtx, empty: FALSE, range: 1]]];

ctxb[tCtx].seList ¬ seChain ¬ SymbolOps.MakeSeChain[tCtx, 2, FALSE];

FillConstant[seChain, "FALSE"L, idBOOL, 0];

seChain ¬ SymbolOps.NextSe[MimData.ownSymbols, seChain];

FillConstant[seChain, "TRUE"L, idBOOL, 1];

FillNamedType[idBOOL, "BOOL"L, seiBOOL];

FillNamedType[NextOuterSe[], "BOOLEAN"L, seiBOOL];

}; -- PrefillBool

PrefillDReal: PROC = {

REAL32, REAL64, REAL, DREAL

seiREAL: CSEIndex;

seiDREAL: CSEIndex;

seiREAL32: CSEIndex ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.real.SIZE];

seiREAL64: CSEIndex ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.real.SIZE];

seb[seiREAL32] ¬ [mark3: TRUE, mark4: TRUE, body: cons[
align: bitsToAlignment[32],
typeInfo: real[length: 32]]];

seb[seiREAL64] ¬ [mark3: TRUE, mark4: TRUE, body: cons[
align: bitsToAlignment[64],
typeInfo: real[length: 64]]];

SELECT Target.bitsPerReal FROM

32 => {

seiREAL ¬ seiREAL32;

seiDREAL ¬ seiREAL64;

};

64 => {

seiREAL ¬ seiREAL64;

seiDREAL ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.real.SIZE];

seb[seiDREAL] ¬ [mark3: TRUE, mark4: TRUE, body: cons[
align: bitsToAlignment[64],
typeInfo: real[length: Target.bitsPerReal*2]]];

};

ENDCASE => ERROR;

Can't handle it yet!

FillNamedType[NextOuterSe[], "REAL32"L, seiREAL32];

FillNamedType[NextOuterSe[], "REAL64"L, seiREAL64];

FillNamedType[idREAL ¬ NextOuterSe[], "REAL"L, seiREAL];

FillNamedType[idDREAL ¬ NextOuterSe[], "DREAL"L, seiDREAL];

}; -- PrefillDReal

PrefillText: PROC = {

TEXT

idTEXT ¬ NextOuterSe[];

rSei ¬ MakeRecordType[nBits: 2*Target.bitsPerStringBound, packed: TRUE];

seb[rSei].align ¬ worstAlignment;

seb[rSei].hints.variant ¬ TRUE;

tCtx ¬ seb[rSei].fieldCtx;

ctxb[tCtx].seList ¬ seChain ¬ SymbolOps.MakeSeChain[tCtx, 2, FALSE];

FillVariable[seChain, "length"L, idTextBound, [bd: 0], Target.bitsPerStringBound];

SymbolOps.EnterExtension[seChain, default, tC0];

seChain ¬ SymbolOps.NextSe[MimData.ownSymbols, seChain];

{

tag: ISEIndex = SymbolOps.MakeSeChain[CTXNull, 1, FALSE];

seqSei: CSEIndex = SymbolOps.MakeNonCtxSe[SERecord.cons.sequence.SIZE];

FillVariable[tag, "maxLength"L, idTextBound, [bd: Target.bitsPerStringBound], Target.bitsPerStringBound];

seb[tag].immutable ¬ TRUE;

seb[seqSei] ¬ [mark3: TRUE, mark4: TRUE, body: cons[

align: worstAlignment,

typeInfo: sequence[

parentType: rSei,

packed: TRUE, machineDep: TRUE,

controlled: TRUE, tagSei: tag,

componentType: idCHAR,

bitOrder: targetBitOrder,

grain: Target.bitsPerAU

]]];

FillVariable[seChain, "text"L, seqSei,
[bd: Target.bitsPerStringBound], Target.bitsPerStringBound];

};

FillNamedType[idTEXT, "TEXT"L, rSei];

}; -- PrefillText

PrefillString: PROC = {

STRING & StringBody

idSTRING ¬ NextOuterSe[];

sei ¬ NextOuterSe[];

typeStringBody ¬ rSei ¬ MakeRecordType[
nBits: 2*Target.bitsPerStringBound, packed: TRUE];

seb[rSei].hints.assignable ¬ seb[rSei].hints.voidable ¬ TRUE; -- compatibility

tCtx ¬ seb[rSei].fieldCtx;

ctxb[tCtx].seList ¬ seChain ¬ SymbolOps.MakeSeChain[tCtx, 3, FALSE];

FillVariable[seChain, "length"L, idStringBound, [bd: 0], Target.bitsPerStringBound];

SymbolOps.EnterExtension[seChain, default, tC0];

seChain ¬ SymbolOps.NextSe[MimData.ownSymbols, seChain];

FillVariable[seChain, "maxlength"L, idStringBound, [bd: Target.bitsPerStringBound], Target.bitsPerStringBound];

seb[seChain].immutable ¬ TRUE;

seChain ¬ SymbolOps.NextSe[MimData.ownSymbols, seChain];

tSei ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.array.SIZE];

seb[tSei] ¬ [mark3: TRUE, mark4: TRUE, body: cons[

align: wordAlignment,

typeInfo: array[

packed: TRUE,

bitOrder: targetBitOrder,

indexType: MakeSubrangeType[0, 0, idINTEGER],

componentType: idCHAR]]];

FillVariable[seChain, "text"L, tSei, [bd: 2*Target.bitsPerStringBound], 0];

FillNamedType[sei, "StringBody"L, rSei];

FillNamedType[idSTRING, "STRING"L, typeSTRING ¬ MakeRefType[sei]];

}; -- PrefillString

PrefillMonitorLock: PROC = {

MONITORLOCK

monWords: NAT = Target.wordsPerMonLock;

idLOCK ¬ NextOuterSe[];

rSei ¬ MakeRecordType[nBits: Target.bitsPerMonLock, painted: TRUE];

tCtx ¬ seb[rSei].fieldCtx;

ctxb[tCtx].seList ¬ seChain ¬ SymbolOps.MakeSeChain[tCtx, monWords, FALSE];

FOR i: NAT IN [0..monWords) DO

initVal: CARD = Target.monLockInit[i];

initTree: Tree.Link ¬ SELECT initVal FROM

0 => tC0, 1 => tC1,

ENDCASE => MakeTreeLiteral[initVal];

FillVariable[seChain, NIL, idANY, [bd: Target.bitsPerWord*i], Target.bitsPerWord];

SymbolOps.EnterExtension[seChain, default, initTree];

seChain ¬ SymbolOps.NextSe[MimData.ownSymbols, seChain];

ENDLOOP;

FillNamedType[idLOCK, "MONITORLOCK"L, rSei];

typeLOCK ¬ rSei;

}; -- PrefillMonitorLock

PrefillCondition: PROC = {

CONDITION

condWords: NAT = Target.wordsPerCondVar;

sei ¬ NextOuterSe[];

rSei ¬ MakeRecordType[nBits: Target.bitsPerCondVar, painted: TRUE];

typeCONDITION ¬ rSei;

tCtx ¬ seb[rSei].fieldCtx;

ctxb[tCtx].seList ¬ seChain ¬ SymbolOps.MakeSeChain[tCtx, condWords, FALSE];

FOR i: NAT IN [0..condWords) DO

initVal: CARD = Target.condVarInit[i];

initTree: Tree.Link ¬ SELECT initVal FROM

0 => tC0, 1 => tC1,

ENDCASE => MakeTreeLiteral[initVal];

FillVariable[seChain, NIL, idANY, [bd: Target.bitsPerWord*i], Target.bitsPerWord];

SymbolOps.EnterExtension[seChain, default, initTree];

seChain ¬ SymbolOps.NextSe[MimData.ownSymbols, seChain];

ENDLOOP;

FillNamedType[sei, "CONDITION"L, rSei];

typeCONDITION ¬ rSei;

}; -- PrefillCondition

PrefillMDSZone: PROC = {

MDSZone

sei ¬ NextOuterSe[];

tSei ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.zone.SIZE];

seb[tSei] ¬ [mark3: TRUE, mark4: TRUE, body: cons[
align: worstAlignment,
typeInfo: zone[counted: FALSE, mds: TRUE, length: Target.bitsPerWord]]];

FillNamedType[sei, "MDSZone"L, tSei];

}; -- PrefillMDSZone

PrefillAtom: PROC = {

ATOM

idATOM ¬ sei ¬ NextOuterSe[];

typeAtomRecord ¬ tSei ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.opaque.SIZE];

seb[tSei] ¬ [mark3: TRUE, mark4: TRUE, body: cons[

align: worstAlignment,

typeInfo: opaque[

id: SymbolOps.NextSe[MimData.ownSymbols, sei],

length: 0, lengthKnown: FALSE]]];

FillNamedType[idATOM, "ATOM"L, MakeRefType[refType: tSei, counted: TRUE]];

};

PrefillQuestionMark: PROC = {

?: undefined value

seAnon ¬ NextOuterSe[];

FillVariable[seAnon, "?"L, typeANY, [bd: 0], Target.bitsPerWord];

};

PrefillTrueFalse: PROC = {

TRUE & FALSE constants

FillConstant[NextOuterSe[], "TRUE"L, idBOOL, 1]; -- TRUE

FillConstant[NextOuterSe[], "FALSE"L, idBOOL, 0]; -- FALSE

};

PrefillRefAny: PROC = {

REF ANY

tSei ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.any.SIZE];

seb[tSei] ¬ [mark3: TRUE, mark4: TRUE, body: cons[
align: worstAlignment,
typeInfo: any[]]];

typeRefANY ¬ MakeRefType[refType: tSei, counted: TRUE];

};

PrefillListOfRefAny: PROC = {

LIST OF REF ANY

rSei: RecordSEIndex ¬ MakeRecordType[nBits: 2*Target.bitsPerRef];

link: Type ¬ typeListANY ¬ MakeRefType[refType: rSei, counted: TRUE, list: TRUE];

rPtr: LONG POINTER TO SERecord.cons.record ¬ @seb[rSei];

rPtr.align ¬ worstAlignment;

rPtr.hints.comparable ¬ TRUE;

rPtr.hints.assignable ¬ TRUE;

rPtr.hints.refField ¬ TRUE;

rPtr.list ¬ TRUE;

tCtx ¬ rPtr.fieldCtx;

ctxb[tCtx].seList ¬ seChain ¬ SymbolOps.MakeSeChain[tCtx, 2, FALSE];

FillVariable[seChain, "first"L, typeRefANY, [bd: 0], Target.bitsPerRef];

seChain ¬ SymbolOps.NextSe[MimData.ownSymbols, seChain];

FillVariable[seChain, "rest"L, link, [bd: Target.bitsPerRef], Target.bitsPerRef];

};

PrefillUnwindAbortedUncaught: PROC = {

UNWIND, ABORTED & UNCAUGHT built-in errors

outerChain ¬ ctxb[outerCtx].seList ¬
SymbolOps.MakeSeChain[outerCtx, nExtraSymbols, TRUE];

idUNWIND ¬ sei ¬ NextOuterSe[];

tSei ¬ SymbolOps.MakeNonCtxSe[SERecord.cons.transfer.SIZE];

seb[tSei] ¬ [mark3: TRUE, mark4: TRUE, body: cons[

align: bitsToAlignment[Target.bitsPerSignal],

typeInfo: transfer[

mode: error, safe: FALSE,

typeIn: RecordSENull, typeOut: RecordSENull,

length: Target.bitsPerSignal]]];

See MimDriver.SignalForSei for the proper values for these constants.

FillXferConstant[idUNWIND, "UNWIND"L, tSei, 1];

FillXferConstant[sei ¬ NextOuterSe[], "ABORTED"L, tSei, 2];

FillXferConstant[sei ¬ NextOuterSe[], "UNCAUGHT"L, tSei, 3];

};

idTextBound: ISEIndex;

idStringBound: ISEIndex;

IF bitsToAlignment = NIL THEN {

worstCase: NAT ¬ MIN[assumedWorstCase, Target.Alignments[Target.AlignmentIndex.LAST]];

align: Symbols.Alignment ¬ none;

bitsToAlignment ¬ MimZones.permZone.NEW[MimData.BitsToAlign];

FOR i: NAT IN MimData.BitsToAlignIndex DO

SELECT MIN[i, worstCase] FROM

0, 1 => align ¬ none;

<= bitsPerAU*1 => align ¬ oneAU;

<= bitsPerAU*2 => align ¬ twoAU;

<= bitsPerAU*4 => align ¬ fourAU;

<= bitsPerAU*8 => align ¬ eightAU;

ENDCASE;

bitsToAlignment[i] ¬ align;

ENDLOOP;

wordAlignment ¬ bitsToAlignment[Target.bitsPerWord];

worstAlignment ¬ bitsToAlignment[Target.Alignments[Target.AlignmentIndex.LAST]];

};

(MimData.table).AddNotify[P1Notify];

tSei ¬ MakeBasicType[codeANY, TRUE, Target.bitsPerWord]; -- guaranteed position

outerCtx ¬ SymbolOps.NewCtx[lZ];

outerChain ¬ ctxb[outerCtx].seList ¬
SymbolOps.MakeSeChain[outerCtx, nOuterSymbols, FALSE];

make some constants

tC0 ¬ MakeTreeLiteral[0];

tC1 ¬ MakeTreeLiteral[1];

PrefillUnspecified[];

PrefillIntCardNat[];

PrefillBool[];

PrefillDReal[];

PrefillText[];

PrefillString[];

PrefillMonitorLock[];

PrefillCondition[];

PrefillMDSZone[]; --?

PrefillAtom[];

PrefillQuestionMark[];

PrefillTrueFalse[];

PrefillRefAny[];

PrefillListOfRefAny[];

PrefillUnwindAbortedUncaught[];

SymbolOps.SetSeLink[sei, idANY];

IF outerChain # ISENull THEN ERROR;

(MimData.table).DropNotify[P1Notify];

};

IdOfFirst: PUBLIC PROC RETURNS [Name] = {RETURN [HashForId["first"L]]};

IdOfLock: PUBLIC PROC RETURNS [Name] = {RETURN [HashForId["LOCK"L]]};

IdOfRest: PUBLIC PROC RETURNS [Name] = {RETURN [HashForId["rest"L]]};

HashForId: PROC [id: STRING] RETURNS [Name] = {

desc: SubString ¬ [base: id, offset: 0, length: id.length];

RETURN [SymbolOps.EnterString[desc]];

};

pass 1 control

P1Unit: PUBLIC PROC RETURNS [success: BOOL] = {

desc: SubString ¬ [base: " "L, offset: 1, length: 0];

source: IO.STREAM ¬ CompilerUtil.AcquireStream[$source];

MimData.textIndex ¬ SourceMap.Cons[0];

MimData.bodyIndex ¬ CBTNull;

[complete: success, nTokens: MimData.sourceTokens, nErrors: MimData.nErrors]
¬ MimP1.Parse[source, Logger, TRUE];

[] ¬ SymbolOps.EnterString[desc];

marks end of symbols from source file in hash table

CompilerUtil.ReleaseStream[$source];

};

Logger: PROC [inner: PROC [log: IO.STREAM]] = {

log: IO.STREAM ¬ CompilerUtil.AcquireStream[$log];

inner[log];

CompilerUtil.ReleaseStream[$log];

};