-- 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.