-- file Pass1.mesa
-- last modified by Satterthwaite, May 10, 1983 3:33 pm

DIRECTORY
  Alloc: TYPE USING [Notifier, AddNotify, DropNotify],
  BcdDefs: TYPE USING [Link, EPIndex, GFTNull],
  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, AcquireZone, ReleaseStream, ReleaseZone],
  LiteralOps: TYPE USING [Find],
  P1: TYPE USING [InstallParseTable, Parse],
  Stream: TYPE USING [Handle],
  Strings: TYPE USING [SubStringDescriptor],
  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;

 -- 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] = {
    P1.InstallParseTable[table]};
 

 -- construction of predeclared symbols

  SubStringDescriptor: TYPE = Strings.SubStringDescriptor;

  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: SubStringDescriptor;
    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: SubStringDescriptor ← [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: SubStringDescriptor ← [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:BcdDefs.GFTNull, ep:epN, tag:TRUE]];
    SetIdAttr[sei, TRUE]};

  FillNamedType: PROC [sei: ISEIndex, s: STRING, type: Type] = {
    desc: SubStringDescriptor ← [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 = 4;		-- 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];
    -- make some constants
      {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 ← NextOuterSe[];	-- NAT
      FillNamedType[idNAT, "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;

    -- REF ANY
      tSei ← MakeNonCtxSe[SERecord.cons.any.SIZE];
      seb[tSei] ← [mark3: TRUE, mark4: TRUE, body: cons[any[]]];
      typeRefANY ← MakeLongType[MakeRefType[refType: tSei, counted: TRUE]];
    -- LIST OF REF ANY
      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];

   -- predeclared types added for Cedar
    outerChain ← ctxb[outerCtx].seList ← MakeSeChain[outerCtx, nExtraSymbols, TRUE];
    FillNamedType[NextOuterSe[], "BOOL"L, idBOOL];
    FillNamedType[NextOuterSe[], "CHAR"L, idCHAR];
    FillNamedType[NextOuterSe[], "INT"L, MakeLongType[idINT]];
    sei ← NextOuterSe[];		-- NATURAL (for SDD Trinity)
      FillNamedType[sei, "NATURAL"L, idNAT];
    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: SubStringDescriptor ← [base:id, offset:0, length:id.length];
    RETURN [EnterString[@desc]]};


 -- pass 1 control

  P1Unit: PUBLIC PROC RETURNS [success: BOOL] = {
    zone: UNCOUNTED ZONE ← CompilerUtil.AcquireZone[];
    source: Stream.Handle ← CompilerUtil.AcquireStream[$source];
    dataPtr.textIndex ← 0;  dataPtr.bodyIndex ← CBTNull;
    [complete:success, nTokens:dataPtr.sourceTokens, nErrors:dataPtr.nErrors] ←
      P1.Parse[source, zone, Logger];
    EnterHashMark[];
    CompilerUtil.ReleaseStream[$source]; CompilerUtil.ReleaseZone[zone]};

  Logger: PROC [inner: PROC [log: Stream.Handle]] = {
    log: Stream.Handle ← CompilerUtil.AcquireStream[$log];
    inner[log];
    CompilerUtil.ReleaseStream[$log]};

  EnterHashMark: PROC = INLINE {
    -- marks end of symbols from source file in hash table
    desc: SubStringDescriptor ← [base:"  "L, offset:1, length:0];
    [] ← EnterString[@desc]};

  }.