<> <> <> <> DIRECTORY Alloc: TYPE USING [Notifier, AddNotify, DropNotify], BcdDefs: TYPE USING [Link], ComData: TYPE USING [ bodyIndex, idANY, idATOM, idBOOL, idCARDINAL, idCHAR, idINT, idLOCK, idREAL, idSTRING, idTEXT, idUNWIND, nErrors, outerCtx, seAnon, sourceTokens, table, textIndex, tC0, tC1, typeATOM, typeAtomRecord, typeBOOL, typeCARDINAL, typeCHAR, typeCONDITION, typeINT, typeLOCK, typeREAL, typeRefANY, typeListANY, typeSTRING, typeStringBody], CompilerUtil: TYPE USING [AcquireStream, ReleaseStream], ConvertUnsafe: TYPE USING [SubString], IO: TYPE USING [STREAM], LiteralOps: TYPE USING [Find], P1: TYPE USING [InstallParseTable, Parse], PrincOps: TYPE USING [GFTNull], Symbols: TYPE USING [ Base, BitAddress, ByteLength, WordLength, SERecord, Name, Type, ISEIndex, CSEIndex, RecordSEIndex, CTXIndex, codeANY, codeINT, codeCHAR, typeANY, typeTYPE, nullName, ISENull, RecordSENull, CTXNull, CBTNull, lZ, ctxType, seType], SymbolOps: TYPE USING [ EnterExtension, EnterString, FillCtxSe, NewCtx, MakeNonCtxSe, MakeSeChain, NextSe, SetSeLink], Tree: TYPE USING [Link, Null]; Pass1: PROGRAM IMPORTS Alloc, CompilerUtil, LiteralOps, P1, SymbolOps, dataPtr: ComData EXPORTS CompilerUtil, P1 = { OPEN SymbolOps, Symbols; <> seb: Symbols.Base; -- semantic entry base ctxb: Symbols.Base; -- context table base P1Notify: Alloc.Notifier = {seb _ base[seType]; ctxb _ base[ctxType]}; <> InstallParseTables: PUBLIC PROC [table: LONG POINTER] = { P1.InstallParseTable[table]}; <> SubString: TYPE = ConvertUnsafe.SubString; MakeBasicType: PROC [code: [0..16), ordered: BOOL, nBits: CARDINAL] RETURNS [sei: CSEIndex] = { sei _ MakeNonCtxSe[SERecord.cons.basic.SIZE]; seb[sei] _ [mark3: TRUE, mark4: TRUE, body: cons[basic[ordered:ordered, code:code, length:nBits]]]; RETURN}; MakeRecordType: PROC [nBits: CARDINAL, default, refField: BOOL_FALSE] RETURNS [rSei: RecordSEIndex] = { rSei _ LOOPHOLE[MakeNonCtxSe[SERecord.cons.record.notLinked.SIZE]]; seb[rSei] _ [mark3: TRUE, mark4: TRUE, body: cons[record[ machineDep: TRUE, argument: FALSE, monitored: FALSE, painted: TRUE, hints: [ comparable: FALSE, assignable: FALSE, variant: FALSE, unifield: FALSE, privateFields: FALSE, refField: refField, default: default, voidable: ~refField AND ~default], fieldCtx: NewCtx[lZ], length: nBits, linkPart: notLinked[]]]]; RETURN}; MakeRefType: PROC [refType: Type, counted, list: BOOL_FALSE] RETURNS [sei: CSEIndex] = { sei _ MakeNonCtxSe[SERecord.cons.ref.SIZE]; seb[sei] _ [mark3: TRUE, mark4: TRUE, body: cons[ref[ counted: counted, var: FALSE, readOnly: FALSE, ordered: FALSE, list: list, basing: FALSE, refType: refType]]]; RETURN}; MakeLongType: PROC [rangeType: Type] RETURNS [sei: CSEIndex] = { sei _ MakeNonCtxSe[SERecord.cons.long.SIZE]; seb[sei] _ [mark3: TRUE, mark4: TRUE, body: cons[long[rangeType: rangeType]]]; RETURN}; MakeSubrangeType: PROC [origin: INTEGER, range: CARDINAL, empty: BOOL] RETURNS [sei: CSEIndex] = { sei _ MakeNonCtxSe[SERecord.cons.subrange.SIZE]; seb[sei] _ [mark3: TRUE, mark4: TRUE, body: cons[subrange[ filled: TRUE, empty: empty, rangeType: dataPtr.idINT, origin: origin, range: range]]]; RETURN}; 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: CARDINAL] = { desc: SubString; hash: Name; IF name # NIL THEN { desc _ [base:name, offset:0, length:name.length]; hash _ EnterString[desc]} ELSE hash _ nullName; FillCtxSe[sei, hash, FALSE]; seb[sei].idType _ type; seb[sei].idValue _ offset; seb[sei].idInfo _ nBits; SetIdAttr[sei, FALSE]}; FillConstant: PROC [sei: ISEIndex, name: STRING, type: Type, value: WORD] = { desc: SubString _ [base:name, offset:0, length:name.length]; FillCtxSe[sei, EnterString[desc], FALSE]; seb[sei].idType _ type; seb[sei].idInfo _ 0; seb[sei].idValue _ value; SetIdAttr[sei, TRUE]}; FillXferConstant: PROC [sei: ISEIndex, name: STRING, type: Type, epN: CARDINAL] = { desc: SubString _ [base:name, offset:0, length:name.length]; FillCtxSe[sei, EnterString[desc], FALSE]; seb[sei].idType _ type; seb[sei].idInfo _ CBTNull; seb[sei].idValue _ BcdDefs.Link[procedure[gfi: PrincOps.GFTNull, ep: epN, tag: TRUE]]; SetIdAttr[sei, TRUE]}; FillNamedType: PROC [sei: ISEIndex, s: STRING, type: Type] = { desc: SubString _ [base:s, offset:0, length:s.length]; FillCtxSe[sei, EnterString[desc], FALSE]; SetIdAttr[sei, TRUE]; seb[sei].idType _ typeTYPE; seb[sei].idInfo _ type; seb[sei].idValue _ Tree.Null; SetIdAttr[sei, TRUE]}; MakeTreeLiteral: PROC [val: WORD] RETURNS [Tree.Link] = { RETURN [[literal[LiteralOps.Find[val]]]]}; nOuterSymbols: NAT = 20; -- number of predeclared ids (outer level only) nExtraSymbols: NAT = 3; -- number of new predeclared ids PrefillSymbols: PUBLIC PROC = { OPEN dataPtr; tSei: CSEIndex; rSei: RecordSEIndex; tCtx: CTXIndex; sei, seChain: ISEIndex; outerChain: ISEIndex; NextOuterSe: PROC RETURNS [next: ISEIndex] = { IF outerChain = ISENull THEN ERROR; next _ outerChain; outerChain _ NextSe[outerChain]; RETURN}; idNAT: ISEIndex; (dataPtr.table).AddNotify[P1Notify]; tSei _ MakeBasicType[codeANY, TRUE, WordLength]; -- guaranteed position outerCtx _ NewCtx[lZ]; outerChain _ ctxb[outerCtx].seList _ MakeSeChain[outerCtx, nOuterSymbols, FALSE]; <> {tC0 _ MakeTreeLiteral[0]; tC1 _ MakeTreeLiteral[1]}; idANY _ NextOuterSe[]; FillNamedType[idANY, "UNSPECIFIED"L, tSei]; IF tSei # typeANY THEN ERROR; idINT _ NextOuterSe[]; typeINT _ MakeBasicType[codeINT, TRUE, WordLength]; FillNamedType[idINT, "INTEGER"L, typeINT]; idCHAR _ NextOuterSe[]; typeCHAR _ MakeBasicType[codeCHAR, TRUE, ByteLength]; FillNamedType[idCHAR, "CHARACTER"L, typeCHAR]; idBOOL _ NextOuterSe[]; typeBOOL _ MakeNonCtxSe[SERecord.cons.enumerated.SIZE]; tCtx _ NewCtx[lZ]; seb[typeBOOL] _ [mark3: TRUE, mark4: TRUE, body: cons[enumerated[ ordered: TRUE, machineDep: TRUE, sparse: FALSE, unpainted: FALSE, valueCtx: tCtx, empty: FALSE, nValues: 2]]]; ctxb[tCtx].seList _ seChain _ MakeSeChain[tCtx, 2, FALSE]; FillConstant[seChain, "FALSE"L, idBOOL, 0]; seChain _ NextSe[seChain]; FillConstant[seChain, "TRUE"L, idBOOL, 1]; FillNamedType[idBOOL, "BOOLEAN"L, typeBOOL]; idCARDINAL _ NextOuterSe[]; typeCARDINAL _ MakeSubrangeType[0, 177777b, FALSE]; FillNamedType[idCARDINAL, "CARDINAL"L, typeCARDINAL]; FillNamedType[NextOuterSe[], "WORD"L, typeCARDINAL]; idREAL _ NextOuterSe[]; typeREAL _ MakeNonCtxSe[SERecord.cons.real.SIZE]; seb[typeREAL] _ [mark3:TRUE, mark4:TRUE, body:cons[real[rangeType:idINT]]]; FillNamedType[idREAL, "REAL"L, typeREAL]; idNAT _ sei _ NextOuterSe[]; -- NAT FillNamedType[sei, "NAT"L, MakeSubrangeType[0, 77777b, FALSE]]; idTEXT _ NextOuterSe[]; rSei _ MakeRecordType[nBits:2*WordLength, default:TRUE]; seb[rSei].hints.variant _ TRUE; tCtx _ seb[rSei].fieldCtx; ctxb[tCtx].seList _ seChain _ MakeSeChain[tCtx, 2, FALSE]; FillVariable[seChain, "length"L, idNAT, [wd:0, bd:0], WordLength]; EnterExtension[seChain, default, tC0]; seChain _ NextSe[seChain]; BEGIN tag: ISEIndex = MakeSeChain[CTXNull, 1, FALSE]; seqSei: CSEIndex = MakeNonCtxSe[SERecord.cons.sequence.SIZE]; FillVariable[tag, "maxLength"L, idNAT, [wd:1, bd:0], WordLength]; seb[tag].immutable _ TRUE; seb[seqSei] _ [mark3: TRUE, mark4: TRUE, body: cons[sequence[ packed: TRUE, machineDep: TRUE, controlled: TRUE, tagSei: tag, componentType: idCHAR]]]; FillVariable[seChain, "text"L, seqSei, [wd:1, bd:0], WordLength]; END; FillNamedType[idTEXT, "TEXT"L, rSei]; idSTRING _ NextOuterSe[]; sei _ NextOuterSe[]; -- StringBody typeStringBody _ rSei _ MakeRecordType[nBits:2*WordLength, default:TRUE]; seb[rSei].hints.assignable _ seb[rSei].hints.voidable _ TRUE; -- compatibility tCtx _ seb[rSei].fieldCtx; ctxb[tCtx].seList _ seChain _ MakeSeChain[tCtx, 3, FALSE]; FillVariable[seChain, "length"L, idCARDINAL, [wd:0, bd:0], WordLength]; EnterExtension[seChain, default, tC0]; seChain _ NextSe[seChain]; FillVariable[seChain, "maxlength"L, idCARDINAL, [wd:1, bd:0], WordLength]; seb[seChain].immutable _ TRUE; seChain _ NextSe[seChain]; tSei _ MakeNonCtxSe[SERecord.cons.array.SIZE]; seb[tSei] _ [mark3: TRUE, mark4: TRUE, body: cons[array[ packed: TRUE, indexType: MakeSubrangeType[0, 0, TRUE], componentType: idCHAR]]]; FillVariable[seChain, "text"L, tSei, [wd:2, bd:0], 0]; FillNamedType[sei, "StringBody"L, rSei]; typeSTRING _ MakeRefType[sei]; FillNamedType[idSTRING, "STRING"L, typeSTRING]; idLOCK _ NextOuterSe[]; rSei _ MakeRecordType[nBits:WordLength, default:TRUE]; tCtx _ seb[rSei].fieldCtx; ctxb[tCtx].seList _ seChain _ MakeSeChain[tCtx, 1, FALSE]; FillVariable[seChain, NIL, idANY, [wd:0, bd:0], WordLength]; EnterExtension[seChain, default, MakeTreeLiteral[100000b]]; FillNamedType[idLOCK, "MONITORLOCK"L, rSei]; typeLOCK _ rSei; sei _ NextOuterSe[]; -- CONDITION rSei _ MakeRecordType[nBits:2*WordLength, default:TRUE]; typeCONDITION _ rSei; tCtx _ seb[rSei].fieldCtx; ctxb[tCtx].seList _ seChain _ MakeSeChain[tCtx, 2, FALSE]; FillVariable[seChain, "timeout"L, idCARDINAL, [wd:1, bd:0], WordLength]; EnterExtension[seChain, default, tC0]; seChain _ NextSe[seChain]; FillVariable[seChain, NIL, idANY, [wd:0, bd:0], WordLength]; EnterExtension[seChain, default, tC0]; FillNamedType[sei, "CONDITION"L, rSei]; typeCONDITION _ rSei; sei _ NextOuterSe[]; -- MDSZone tSei _ MakeNonCtxSe[SERecord.cons.zone.SIZE]; seb[tSei] _ [mark3:TRUE, mark4:TRUE, body:cons[zone[counted:FALSE, mds:TRUE]]]; FillNamedType[sei, "MDSZone"L, tSei]; idATOM _ sei _ NextOuterSe[]; typeAtomRecord _ tSei _ MakeNonCtxSe[SERecord.cons.opaque.SIZE]; seb[tSei] _ [mark3: TRUE, mark4: TRUE, body: cons[opaque[ id: NextSe[sei], length: 0, lengthKnown: FALSE]]]; tSei _ MakeRefType[refType: tSei, counted: TRUE]; typeATOM _ MakeLongType[tSei]; FillNamedType[idATOM, "ATOM"L, typeATOM]; seAnon _ NextOuterSe[]; FillVariable[seAnon, "?"L, typeANY, [wd:0, bd:0], WordLength]; FillConstant[NextOuterSe[], "TRUE"L, idBOOL, 1]; -- TRUE FillConstant[NextOuterSe[], "FALSE"L, idBOOL, 0]; -- FALSE idUNWIND _ NextOuterSe[]; tSei _ MakeNonCtxSe[SERecord.cons.transfer.SIZE]; seb[tSei] _ [mark3: TRUE, mark4: TRUE, body: cons[transfer[ mode: error, safe: FALSE, typeIn: RecordSENull, typeOut: RecordSENull]]]; FillXferConstant[idUNWIND, "UNWIND"L, tSei, 1]; FillXferConstant[NextOuterSe[], "ABORTED"L, tSei, 2]; IF outerChain # ISENull THEN ERROR; <> tSei _ MakeNonCtxSe[SERecord.cons.any.SIZE]; seb[tSei] _ [mark3: TRUE, mark4: TRUE, body: cons[any[]]]; typeRefANY _ MakeLongType[MakeRefType[refType: tSei, counted: TRUE]]; <> rSei _ MakeRecordType[nBits: 2*(2*WordLength), refField: TRUE, default: TRUE]; typeListANY _ MakeLongType[MakeRefType[refType: rSei, counted: TRUE, list: TRUE]]; seb[rSei].painted _ FALSE; seb[rSei].hints.comparable _ seb[rSei].hints.assignable _ TRUE; seb[rSei].hints.refField _ TRUE; tCtx _ seb[rSei].fieldCtx; ctxb[tCtx].seList _ seChain _ MakeSeChain[tCtx, 2, FALSE]; FillVariable[seChain, "first"L, typeRefANY, [wd:0, bd:0], 2*WordLength]; seChain _ NextSe[seChain]; FillVariable[seChain, "rest"L, typeListANY, [wd:2, bd:0], 2*WordLength]; <> outerChain _ ctxb[outerCtx].seList _ MakeSeChain[outerCtx, nExtraSymbols, TRUE]; FillNamedType[NextOuterSe[], "BOOL"L, idBOOL]; FillNamedType[NextOuterSe[], "CHAR"L, idCHAR]; sei _ NextOuterSe[]; -- INT tSei _ MakeLongType[idINT]; FillNamedType[sei, "INT"L, tSei]; SetSeLink[sei, idANY]; IF outerChain # ISENull THEN ERROR; (dataPtr.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 [EnterString[desc]]}; <> P1Unit: PUBLIC PROC RETURNS [success: BOOL] = { source: IO.STREAM _ CompilerUtil.AcquireStream[$source]; dataPtr.textIndex _ 0; dataPtr.bodyIndex _ CBTNull; [complete:success, nTokens:dataPtr.sourceTokens, nErrors:dataPtr.nErrors] _ P1.Parse[source, Logger]; EnterHashMark[]; CompilerUtil.ReleaseStream[$source]}; Logger: PROC [inner: PROC [log: IO.STREAM]] = { log: IO.STREAM _ CompilerUtil.AcquireStream[$log]; inner[log]; CompilerUtil.ReleaseStream[$log]}; EnterHashMark: PROC = INLINE { <> desc: SubString _ [base:" "L, offset:1, length:0]; [] _ EnterString[desc]}; }.