-- Constructor.mesa, modified by Sweet, January 22, 1980  4:35 PM

DIRECTORY
  AltoDefs: FROM "altodefs" USING [BYTE, charlength, wordlength],
  Code: FROM "code" USING [CodeNotImplemented, curctxlvl],
  CodeDefs: FROM "codedefs" USING [
    BoVarIndex, ConsDestination, Lexeme, MaxParmsInStack, NullLex,
    VarComponent, VarIndex, VarNull],
  ComData: FROM "comdata" USING [tC0],
  ControlDefs: FROM "controldefs" USING [FieldDescriptor],
  FOpCodes: FROM "fopcodes" USING [
    qBLT, qBLTL, qDSUB, qGADRB, qLADRB, qLI, qPUSH, qSUB, qWS, qWSD, qWSF],
  InlineDefs: FROM "inlinedefs" USING [BITSHIFT],
  LiteralOps: FROM "literalops" USING [MasterString],
  Literals: FROM "literals" USING [ltType, MSTIndex, stType],
  P5: FROM "p5" USING [
    ConstructOnStack, Exp, GenTempLex, MoveToCodeWord, P5Error, SysCall,
    WriteCodeWord],
  P5L: FROM "p5l" USING [
    AdjustComponent, ComponentForLex, CopyToTemp, CopyVarItem,
    EasilyLoadable, FieldOfComponent, GenAdd, GenVarItem, 
    LoadComponent, LoadVar, MakeBo, ModComponent, OVarItem, ReleaseVarItem, 
    ReusableCopies, TOSLex, VarForLex, VarVarAssign, Words],
  P5U: FROM "p5u" USING [
    FieldAddress, MakeTreeLiteral, NextVar, OperandType,
    Out0, Out1, Out2, 
    PushLitVal, WordAligned, WordsForOperand],
  SDDefs: FROM "sddefs" USING [sStringInit],
  Stack: FROM "stack" USING [Also, Dump, Forget, Mark, Pop, TempStore, Top],
  SymbolOps: FROM "symbolops" USING [
    BitsForType, Cardinality, FnField, NextSe, RecordRoot, UnderType, 
    WordsForType],
  Symbols: FROM "symbols" USING [ ArraySEIndex,
    BitAddress, bodyType, BTIndex, CBTIndex, ContextLevel, CSEIndex, CTXIndex, 
    ctxType, HTIndex, ISEIndex, ISENull, lG, lZ, RecordSEIndex, SEIndex, 
    seType, TypeClass],
  Table: FROM "table" USING [Base, Notifier],
  Tree: FROM "tree" USING [Index, Link, Map, Null, treeType],
  TreeOps: FROM "treeops" USING [FreeNode, ScanList, UpdateList];

Constructor: PROGRAM
    IMPORTS MPtr: ComData, CPtr: Code, InlineDefs, LiteralOps, P5, P5L, P5U, 
      Stack, SymbolOps, TreeOps
    EXPORTS CodeDefs, P5 =
  BEGIN
  OPEN CodeDefs, SymbolOps;

  -- imported definitions

  BYTE: TYPE = AltoDefs.BYTE;
  wordlength: CARDINAL = AltoDefs.wordlength;
  charlength: CARDINAL = AltoDefs.charlength;

  BitAddress: TYPE = Symbols.BitAddress;
  BTIndex: TYPE = Symbols.BTIndex;
  CBTIndex: TYPE = Symbols.CBTIndex;
  ContextLevel: TYPE = Symbols.ContextLevel;
  CSEIndex: TYPE = Symbols.CSEIndex;
  CTXIndex: TYPE = Symbols.CTXIndex;
  HTIndex: TYPE = Symbols.HTIndex;
  ISEIndex: TYPE = Symbols.ISEIndex;
  ISENull: ISEIndex = Symbols.ISENull;
  lZ: ContextLevel = Symbols.lZ;
  lG: ContextLevel = Symbols.lG;
  RecordSEIndex: TYPE = Symbols.RecordSEIndex;
  SEIndex: TYPE = Symbols.SEIndex;
  TypeClass: TYPE = Symbols.TypeClass;


  tb: Table.Base;                -- tree base (local copy)
  seb: Table.Base;                -- semantic entry base (local copy)
  ctxb: Table.Base;                -- context entry base (local copy)
  bb: Table.Base;                -- body entry base (local copy)
  cb: Table.Base;                -- code base (local copy)
  stb: Table.Base;                -- string base (local copy)
  ltb: Table.Base;                -- literal base (local copy)

  ConstructorNotify: PUBLIC Table.Notifier =
    BEGIN  -- called by allocator whenever table area is repacked
    seb _ base[Symbols.seType];
    ctxb _ base[Symbols.ctxType];
    bb _ base[Symbols.bodyType];
    stb _ base[Literals.stType];
    tb _ base[Tree.treeType];
    cb _ LOOPHOLE[tb];
    ltb _ base[Literals.ltType];
    RETURN
    END;

  -- state data and code for construction

  cd: PUBLIC ConsDestination;

  ConstructionError: SIGNAL = CODE;

  SetConsDest: PROCEDURE [r: VarIndex, exp: BOOLEAN _ FALSE]
      RETURNS [rVal: VarIndex] =
    BEGIN
    bor: BoVarIndex;
    base: VarComponent;
    rVal _ VarNull;
    WITH cb[r] SELECT FROM
      o => WITH vv: var SELECT FROM
	frame =>
	  BEGIN
	  IF ~(vv.level = lG OR vv.level = CPtr.curctxlvl) THEN
	    GO TO shouldBo;
	  cd.bd _ vv.bd; cd.fOffset _ vv.wd; cd.fLevel _ vv.level;
	  cd.inFrame _ TRUE;
	  IF exp THEN rVal _ r ELSE P5L.ReleaseVarItem[r];
	  cd.wSize _ vv.wSize;
	  cd.bSize _ vv.bSize;
	  RETURN;
	  EXITS
	    shouldBo => NULL;
	  END;
	frameup => NULL;
	linkup => NULL;
	ENDCASE => ERROR;
      bo, bdo, ind => NULL;
      ENDCASE => ERROR;
    bor _ P5L.MakeBo[r];
    IF bor = VarNull THEN SIGNAL ConstructionError; -- should be caught above
    IF exp THEN 
      BEGIN
      r1: VarIndex;
      [r1, rVal] _ P5L.ReusableCopies[bor, store];
      bor _ P5L.MakeBo[r1];
      END;
    BEGIN
    offset: VarComponent _ cb[bor].offset;
    WITH vv: offset SELECT FROM
      frame =>
	BEGIN
	cd.bd _ vv.bd;
	cd.pDelta _ -INTEGER[vv.wd];
	cd.wSize _ vv.wSize;
	cd.bSize _ vv.bSize;
	END;
      ENDCASE => ERROR;
    END;
    BEGIN
    base _ cb[bor].base;
    P5L.ReleaseVarItem[bor]; -- we're finished with it now
    WITH vv: base SELECT FROM
      frame =>
	BEGIN
	IF vv.bSize # 0 OR ~(vv.level = lG OR vv.level = CPtr.curctxlvl) THEN
	  GO TO loadIt;
	cd.pLevel _ vv.level; cd.pOffset _ vv.wd;
	cd.pLength _ vv.wSize;
	END;
      link => BEGIN cd.pLink _ TRUE; cd.pOffset _ vv.wd; END;
      ENDCASE => GO TO loadIt;
    EXITS
      loadIt =>
	BEGIN
	wS: CARDINAL = P5L.Words[base.wSize, base.bSize];
	P5L.LoadComponent[base];
	cd.pSti _ Stack.Top[wS];
	Stack.Also[n: wS, inLink: FALSE, tLevel: lZ, tOffset: 0]; --forget
	cd.pLoaded _ TRUE;
	cd.pLength _ wS;
	END;
    END;
    END;

  GetPointer: PROCEDURE [owd: CARDINAL]
       RETURNS [avar: VarComponent, newOwd: CARDINAL] =
    BEGIN -- invariant: cd.pLoaded => newOwd + cd.pDelta = owd
    SELECT TRUE FROM
      cd.pLoaded  => avar _ [wSize: cd.pLength, space: stack[sti: cd.pSti]];
      cd.inFrame  => 
        BEGIN
        avar _ [wSize: 1, space: faddr[wd: cd.fOffset+owd, level: cd.fLevel]];
        cd.pLength _ 1; -- to be right if loaded
	cd.pDelta _ owd; -- to be right if loaded
	newOwd _ 0;
	RETURN
        END;
      cd.pLink  => avar _ [wSize: 1, space: link[wd: cd.pOffset]];
      cd.pLevel # lZ  =>
        avar _ [wSize: cd.pLength, space:
          frame[wd: cd.pOffset, level: cd.pLevel, immutable: TRUE]];
      ENDCASE => ERROR;
    IF INTEGER[owd] >= cd.pDelta THEN
      newOwd _ CARDINAL[INTEGER[owd] - cd.pDelta]
    ELSE
      BEGIN
      P5L.LoadComponent[avar];
      P5U.Out1[FOpCodes.qLI, CARDINAL[cd.pDelta] - owd];
      IF cd.pLength # 1 THEN
	BEGIN  P5U.Out1[FOpCodes.qLI, 0]; P5U.Out0[FOpCodes.qDSUB]; END
      ELSE P5U.Out0[FOpCodes.qSUB];
      cd.pDelta _ owd;
      cd.pSti _ Stack.Top[cd.pLength];
      newOwd _ 0; cd.pLink _ FALSE; cd.pLevel _ lZ;
      avar _ [wSize: cd.pLength, space: stack[sti: cd.pSti]];
      cd.pLoaded _ TRUE;
      RETURN
      END;
    IF newOwd > LAST[BYTE] THEN
      BEGIN
      P5L.LoadComponent[avar];
      P5L.GenAdd[newOwd, cd.pLength # 1];
      cd.pDelta _ owd;
      cd.pSti _ Stack.Top[cd.pLength];
      newOwd _ 0; cd.pLink _ FALSE; cd.pLevel _ lZ;
      avar _ [wSize: cd.pLength, space: stack[sti: cd.pSti]];
      cd.pLoaded _ TRUE;
      END;
    END;
  
  LoadPointer: PROCEDURE [owd: CARDINAL] RETURNS [newOwd: CARDINAL] =
    BEGIN
    avar: VarComponent;
    [avar, newOwd] _ GetPointer[owd];
    P5L.LoadComponent[avar];
    cd.pSti _ Stack.Top[cd.pLength];
    cd.pLoaded _ TRUE;
    END;
  
  ConsAssign: PROCEDURE [
      atO: POINTER TO frame VarComponent, t: Tree.Link, l: Lexeme _ NullLex] =
    BEGIN
    dest: VarIndex;
    source: VarIndex;
    offset: frame VarComponent _ atO^;
    useFrame: BOOLEAN _ cd.inFrame AND offset.wSize IN [1..2] AND
      offset.bSize = 0 AND (cd.fOffset+offset.wd) IN BYTE;
    useSwapped: BOOLEAN _ ~useFrame AND cd.pLength = 1 AND
      (offset.wSize = 0 OR (offset.bSize = 0 AND offset.wSize IN [1..2]));
    
    offset.bd _ offset.bd + cd.bd;
    IF useFrame AND cd.pLoaded THEN
      BEGIN Stack.Pop[]; cd.pLoaded _ FALSE END;
    IF ~useFrame THEN
      BEGIN
      IF ~useSwapped AND cd.pLoaded THEN
	BEGIN
	IF cd.pLink OR cd.pLevel # lZ THEN Stack.Pop[]
	ELSE
	  BEGIN
	  avar: VarComponent;
	  avar _ Stack.TempStore[cd.pLength];
	  WITH avar SELECT FROM
	    frame => BEGIN cd.pLevel _ level; cd.pOffset _ wd; END;
	    link => BEGIN cd.pLink _ TRUE; cd.pOffset _ wd; END;
	    ENDCASE => ERROR;
	  END;
	cd.pLoaded _ FALSE;
	END;
      END;
    IF useSwapped THEN offset.wd _ LoadPointer[offset.wd];
    source _ P5L.VarForLex[IF l # NullLex THEN l ELSE P5.Exp[t]];
    IF useSwapped THEN
      BEGIN
      base: VarComponent;
      WITH cb[cd.pSti] SELECT FROM
	onStack =>
	  BEGIN
	  WSOp: ARRAY [1..2] OF BYTE = [FOpCodes.qWS, FOpCodes.qWSD];
	  P5L.LoadVar[source];
	  IF offset.bSize = 0 THEN P5U.Out1[WSOp[offset.wSize], offset.wd]
	  ELSE P5U.Out2[FOpCodes.qWSF, offset.wd,
	    LOOPHOLE[ ControlDefs.FieldDescriptor[
	      offset: 0, posn: offset.bd, size: offset.bSize]]];
	  IF cd.remaining # 0 THEN
	    BEGIN
	    P5U.Out0[FOpCodes.qPUSH];
	    cd.pSti _ Stack.Top[];
	    Stack.Also[n: 1, inLink: cd.pLink,
	      tOffset: cd.pOffset, tLevel: cd.pLevel];
	    END
	  ELSE cd.pLoaded _ FALSE;
	  RETURN
	  END;
	inTemp =>
	  BEGIN
	  cd.pLevel _ tLevel; cd.pOffset _ tOffset;
	  base _ [wSize: 1, space: frame[wd: tOffset, level: tLevel,
		  immutable: TRUE]];
	  END;
	inLink =>
	  BEGIN
	  cd.pLink _ TRUE; cd.pOffset _ link;
	  base _ [wSize: 1, space: link[wd: link]];
	  END;
	ENDCASE => ERROR;
      -- would have used swap but pointer got dumped when evaluating field
      Stack.Forget[cd.pSti];
      cd.pLoaded _ FALSE;
      dest _ P5L.GenVarItem[bo];
      cb[dest] _ [body: bo[base: base, offset: offset]];
      END
    ELSE IF useFrame THEN
      BEGIN
      offset.wd _ offset.wd + cd.fOffset;
      offset.level _ cd.fLevel;
      dest _ P5L.OVarItem[offset];
      END
    ELSE
      BEGIN
      base: VarComponent;
      [base, offset.wd] _ GetPointer[offset.wd];
      IF cd.remaining # 0 THEN WITH base SELECT FROM
        stack => IF ~cd.inFrame THEN
          BEGIN -- this is our only copy, save it away
          base _ Stack.TempStore[cd.pLength];
          WITH base SELECT FROM
            frame => BEGIN cd.pLevel _ level; cd.pOffset _ wd; END;
            link => BEGIN cd.pLink _ TRUE; cd.pOffset _ wd; END;
            ENDCASE => ERROR;
          cd.pLoaded _ FALSE;
          END;
        ENDCASE;
      dest _ P5L.GenVarItem[bo];
      cb[dest] _ [body: bo[base: base, offset: offset]];
      END;
    [] _ P5L.VarVarAssign[to: dest, from: source, isexp: FALSE];
    cd.pLoaded _ FALSE;
    END;

  CountDups: Tree.Map =
    BEGIN
    node: Tree.Index;

    IF t = Tree.Null THEN GO TO normalRet;
    WITH t SELECT FROM
      subtree =>
        BEGIN
        node _ index;
        SELECT tb[node].name FROM
          rowcons, construct =>
            IF ~(tb[node].name = rowcons AND tb[node].attr1) THEN
              BEGIN
              tb[node].son[2] _
		TreeOps.UpdateList[tb[node].son[2], CountDups];
              GO TO normalRet
              END;
	  all =>
            BEGIN
	    asei: Symbols.ArraySEIndex = tb[node].info;
	    IF seb[asei].oldPacked AND
		SymbolOps.BitsForType[seb[asei].componentType] <= 8 THEN
	      GO TO packed;
            tb[node].son[1] _ TreeOps.UpdateList[tb[node].son[1], CountDups];
            GO TO normalRet
	    EXITS
	      packed => NULL;
            END;
          union =>
            BEGIN
            IF tb[node].attr2 THEN cd.remaining _ cd.remaining+1;
            tb[node].son[2] _ TreeOps.UpdateList[tb[node].son[2], CountDups];
            GO TO normalRet
            END;
          cast, pad =>
            BEGIN
            tb[node].son[1] _ TreeOps.UpdateList[tb[node].son[1], CountDups];
            GO TO normalRet
            END;
	  safen => 
	    BEGIN
	    IF cd.ignoreSafen THEN
              BEGIN
              v _ TreeOps.UpdateList[tb[node].son[1], CountDups];
              tb[node].son[1] _ Tree.Null;
              TreeOps.FreeNode[node];
              RETURN --[v]
              END
            ELSE
              BEGIN
	      r: VarIndex = P5L.VarForLex[P5.Exp[tb[node].son[1]]];
	      sei: ISEIndex = P5L.CopyToTemp[r].sei;
	      seb[sei].idType _ tb[node].info;
	      TreeOps.FreeNode[node];
              cd.remaining _ cd.remaining+1;
	      RETURN [[symbol[sei]]];
              END;
	    END;
          ENDCASE;
        END;
      ENDCASE;
    cd.remaining _ cd.remaining+1;
    GO TO normalRet;
    EXITS
      normalRet => RETURN[t];
    END;

  ConstructCountDown: PROCEDURE =
    BEGIN
    IF LOOPHOLE[(cd.remaining _ cd.remaining-1),INTEGER] < 0 THEN
      SIGNAL ConstructionError;
    RETURN
    END;

  --
  RowCons: PUBLIC PROCEDURE [t: Tree.Link, node: Tree.Index] =
    BEGIN -- array initialization
    r: VarIndex;
    asei: CSEIndex = LOOPHOLE[tb[node].info];
    saveCd: ConsDestination = cd; -- necessary in an inline
    offset: frame VarComponent;

    cd _ [ignoreSafen: t.tag = symbol]; -- + many defaults
    IF tb[node].attr1 THEN cd.remaining _ 1
    ELSE tb[node].son[2] _ TreeOps.UpdateList[tb[node].son[2], CountDups];
    r _ P5L.VarForLex[P5.Exp[t]];
    [] _ SetConsDest[r, FALSE];
    offset _ [wSize: cd.wSize, bSize: cd.bSize, space: frame[]];
    Row[node, asei, @offset];
    IF cd.remaining # 0 THEN SIGNAL ConstructionError;
    cd _ saveCd;
    RETURN
    END;

  RowConsExp: PUBLIC PROCEDURE [t: Tree.Link, node: Tree.Index] 
      RETURNS [Lexeme] =
    BEGIN -- array (expression)initialization
    r, rr: VarIndex;
    asei: CSEIndex _ tb[node].info;
    awords: CARDINAL = WordsForType[asei];
    saveCd: ConsDestination = cd;
    offset: frame VarComponent;

    cd _ [ignoreSafen: t = Tree.Null OR t.tag = symbol]; -- + many defaults
    tb[node].son[2] _ TreeOps.UpdateList[tb[node].son[2], CountDups];
    r _ P5L.VarForLex[IF t = Tree.Null THEN P5.GenTempLex[awords]
	ELSE P5.Exp[t]];
    rr _ SetConsDest[r, TRUE];
    offset _ [wSize: cd.wSize, bSize: cd.bSize, space: frame[]];
    Row[node, asei, @offset];
    IF cd.remaining # 0 THEN SIGNAL ConstructionError;
    cd _ saveCd;
    RETURN[[bdo[rr]]]
    END;


  Row: PROCEDURE [node: Tree.Index, asei: CSEIndex, atO: POINTER TO READONLY frame VarComponent] =
    BEGIN
    -- handles ARRAY initialization
    n: CARDINAL;
    csei: CSEIndex;
    c: CARDINAL;
    filled: BOOLEAN _ FALSE;
    localstrconst, globalstrconst: BOOLEAN;
    tOffset: frame VarComponent = atO^;
    offset: frame VarComponent _ atO^;
    constrow: PROCEDURE [t: Tree.Link] =
      BEGIN -- outputs a row of constants
      scr: PROCEDURE [t: Tree.Link] =
        BEGIN
        msti: Literals.MSTIndex;
        WITH e:t SELECT FROM
          literal =>
            WITH e.info SELECT FROM
              string =>
                BEGIN
                msti _ LiteralOps.MasterString[index];
                IF stb[msti].local THEN localstrconst _ TRUE
                ELSE globalstrconst _ TRUE;
                P5.WriteCodeWord[stb[msti].info];
                END;
              ENDCASE => P5.P5Error[577];
          ENDCASE => P5.P5Error[578];
        n _ n+1;
        RETURN
        END;

      n _ 0;
      TreeOps.ScanList[t, scr];
      RETURN
      END; -- of constrow

    scrow: PROCEDURE [t: Tree.Link] =
      BEGIN
      node: Tree.Index;

      offset.wSize _ eWSize; offset.bSize _ eBSize;
      IF t # Tree.Null THEN
        BEGIN
        DO -- until we get to something interesting
          WITH t SELECT FROM
            subtree =>
              SELECT tb[index].name FROM
                pad =>
                 BEGIN
                 eWords: CARDINAL;
                 t _ tb[index].son[1]; -- note the variant may change here
                 eWords _ P5U.WordsForOperand[t];
                 offset.wSize _ eWords; offset.bSize _ 0;
                 END;
                cast => t _ tb[index].son[1];
                ENDCASE => EXIT;
            ENDCASE => EXIT;
          ENDLOOP;
        WITH t SELECT FROM
          subtree =>
            BEGIN
            node _ index;
            SELECT tb[node].name FROM
              rowcons =>
                BEGIN
                Row[node, csei, @offset];
                P5L.ModComponent[var: @offset, wd: eWSize, bd: eBSize];
                RETURN
                END;
              construct =>
                BEGIN
                MainConstruct[
                  tb[node].son[2], P5U.OperandType[t], P5U.FieldAddress,
                  @offset];
                P5L.ModComponent[var: @offset, wd: eWSize, bd: eBSize];
                RETURN
                END;
              all =>
                BEGIN -- convert this later
                AllConstruct[node, @offset];
                P5L.ModComponent[var: @offset, wd: eWSize, bd: eBSize];
                RETURN
                END;
              ENDCASE;
            END;
          ENDCASE;
        ConstructCountDown[];
        ConsAssign[@offset, t];
        END; -- of t # Tree.Null
      P5L.ModComponent[var: @offset, wd: eWSize, bd: eBSize];
      RETURN
      END; -- of scrow

    totalBits: CARDINAL = tOffset.wSize * wordlength + tOffset.bSize;
    -- totalBits could overflow, but that would be a very large constructor
    fillBits: CARDINAL _ 0;
    eWSize: CARDINAL;
    eBSize: [0..wordlength);
    packed: BOOLEAN _ FALSE;

    IF tb[node].attr1 THEN
      BEGIN
      c _ P5.MoveToCodeWord[];
      localstrconst _ globalstrconst _ FALSE;
      constrow[tb[node].son[2]];
      ConstructCountDown[];
      Stack.Dump[]; Stack.Mark[];
      P5U.PushLitVal[c];
      P5U.PushLitVal[n];
      IF localstrconst AND globalstrconst THEN SIGNAL CPtr.CodeNotImplemented;
      P5U.Out1[IF localstrconst THEN FOpCodes.qLADRB ELSE FOpCodes.qGADRB,0];
      [] _ LoadPointer[0];
      IF cd.pLength # 1 THEN -- does a long pointer to array of short strings
        SIGNAL CPtr.CodeNotImplemented; -- make any sense?
      P5.SysCall[SDDefs.sStringInit];
      RETURN
      END;
    WITH a: seb[asei] SELECT FROM
      array =>
        BEGIN
	grain: [0..16);
        csei _ UnderType[a.componentType];
        IF a.oldPacked THEN
	  BEGIN
          SELECT SymbolOps.BitsForType[a.componentType] FROM
	    1 => grain _ 1;
	    2 => grain _ 2;
	    3,4 => grain _ 4;
	    5,6,7,8 => grain _ 8;
	    ENDCASE => GO TO not;
	  grain _ 8; -- *************** until after 6.0c bootstrap
	  packed _ TRUE;
	  -- change test when partial word packed arrays happen
	  fillBits _ totalBits - Cardinality[UnderType[a.indexType]]*grain;
          IF fillBits # 0 THEN cd.remaining _ cd.remaining+1;
	  eWSize _ 0; eBSize _ grain;
	  EXITS
	    not => packed _ FALSE;
	  END
	ELSE packed _ FALSE;
	IF ~packed THEN
	  BEGIN
	  eBSize _ 0; eWSize _ SymbolOps.WordsForType[a.componentType];
	  END;
        END;
      ENDCASE => P5.P5Error[580];
    TreeOps.ScanList[tb[node].son[2], scrow];
    IF fillBits # 0 THEN
      BEGIN
      IF fillBits >= wordlength THEN SIGNAL ConstructionError;
      offset.wSize _ 0;
      offset.bSize _ fillBits;
      ConstructCountDown[];
      ConsAssign[@offset, MPtr.tC0];
      END;
    RETURN
    END;



  MainConstruct: PROCEDURE [
	maint: Tree.Link,
	rsei: CSEIndex,
        fa: PROCEDURE[ISEIndex] RETURNS [BitAddress, CARDINAL],
	atO: POINTER TO READONLY frame VarComponent,
        fieldsei: ISEIndex _ ISENull] =
    BEGIN -- workhorse subroutine for construction in memory
    tOffset: frame VarComponent = atO^;
    totalBits: CARDINAL = tOffset.wSize * wordlength + tOffset.bSize;
    more: BOOLEAN _ TRUE;
    rcsei: RecordSEIndex;
    ssmc: PROCEDURE [root: Tree.Link] =
      BEGIN
      offset: frame VarComponent;
      rep: BitAddress;
      res: CARDINAL;
      node: Tree.Index;
      iscontrolled: BOOLEAN _ FALSE;

      BEGIN -- to set up label "done"
      IF root # Tree.Null THEN
        BEGIN
        [rep, res] _ fa[fieldsei];
        offset _ tOffset;
        P5L.FieldOfComponent[var: @offset, wd: rep.wd, bd: rep.bd,
          wSize: res / wordlength, bSize: res MOD wordlength];
        IF fa # FnField AND totalBits <= wordlength THEN
          P5L.AdjustComponent[
            var: @offset, rSei: rcsei, fSei: fieldsei, tBits: totalBits];
        DO -- until we get to something interesting
          WITH root SELECT FROM
            subtree =>
              SELECT tb[index].name FROM
                pad =>
                 BEGIN
                 eWords: CARDINAL;
                 root _ tb[index].son[1]; -- note the variant may change here
                 eWords _ P5U.WordsForOperand[root];
                 offset.wSize _ eWords; offset.bSize _ 0;
                 END;
                cast => root _ tb[index].son[1];
                ENDCASE => EXIT;
            ENDCASE => EXIT;
          ENDLOOP;
        WITH root SELECT FROM
          subtree =>
            BEGIN
            node _ index;
            SELECT tb[node].name FROM
	      construct =>
                BEGIN
                MainConstruct[tb[node].son[2], P5U.OperandType[root],
		  P5U.FieldAddress, @offset];
                GOTO done
                END;
              union =>
                BEGIN
		UnionConstruct[node, rcsei, atO];
	        GO TO done
		END;
              rowcons  =>
                BEGIN
                Row[node, UnderType[seb[fieldsei].idType], @offset];
                GO TO done
                END;
	      all =>
		BEGIN
                AllConstruct[node, @offset];
		GO TO done;
		END;
              ENDCASE;
            END;
          ENDCASE;
        ConstructCountDown[];
        ConsAssign[@offset, root];
	END; -- IF root # Tree.Null
      EXITS
        done => NULL;
      END;
      fieldsei _ P5U.NextVar[NextSe[fieldsei]];
      RETURN
      END; -- of ssmc

    IF fieldsei = ISENull THEN
      WITH seb[rsei] SELECT FROM
        record =>
          BEGIN
          rcsei _ RecordRoot[LOOPHOLE[rsei]];
          fieldsei _ P5U.NextVar[ctxb[seb[rcsei].fieldCtx].seList];
          END;
        ENDCASE => P5.P5Error[589]
    ELSE rcsei _ LOOPHOLE[rsei];
    TreeOps.ScanList[maint, ssmc];
    RETURN
    END; -- of MainConstruct

  UnionConstruct: PROCEDURE [
	node: Tree.Index,
        rootSei: RecordSEIndex,
	atO: POINTER TO READONLY frame VarComponent] =
    BEGIN -- construct a union part, atO^ is offset of beginning of record
    tOffset: frame VarComponent = atO^;
    offset: frame VarComponent _ tOffset;
    fieldsei: ISEIndex;
    constctx: CTXIndex;
    usei: CSEIndex = tb[node].info;
    rcsei: RecordSEIndex;
    tsei: ISEIndex;
    iscontrolled: BOOLEAN;
    tagvalue: CARDINAL;
    tBits: CARDINAL = tOffset.wSize * wordlength + tOffset.bSize;

    WITH seb[usei] SELECT FROM
      union =>
	BEGIN
	iscontrolled _ controlled;
	IF iscontrolled THEN
          BEGIN
	  tagAddr: BitAddress _ seb[tagSei].idValue;
	  tagSize: [0..wordlength] _ seb[tagSei].idInfo;

	  P5L.FieldOfComponent[
	    var: @offset, wd: tagAddr.wd, bd: tagAddr.bd,
	    wSize: tagSize / wordlength, 
	    bSize: tagSize MOD wordlength];
          IF tBits <= wordlength THEN
            P5L.AdjustComponent[
              var: @offset, rSei: rootSei, fSei: tagSei,
	      tBits: tBits];
	  END;
	END;
      ENDCASE => ERROR;
    WITH tb[node].son[1] SELECT FROM
      symbol => tsei _ index;
      ENDCASE => P5.P5Error[583];
    tagvalue _ seb[tsei].idValue;
    rcsei _ LOOPHOLE[UnderType[tsei], RecordSEIndex];
    constctx _ seb[rcsei].fieldCtx;
    fieldsei _ P5U.NextVar[ctxb[constctx].seList];
    IF iscontrolled THEN
      BEGIN
      IF fieldsei # ISENull AND seb[fieldsei].idCtx # constctx THEN
        BEGIN -- a dummy fill field
        fillSize: [0..wordlength) _ seb[fieldsei].idInfo;
	b: CARDINAL _ offset.bSize+fillSize;
        tagvalue _ InlineDefs.BITSHIFT[tagvalue, fillSize];
        offset.bSize _ b MOD wordlength;
	offset.wSize _ b / wordlength;
        fieldsei _ P5U.NextVar[NextSe[fieldsei]];
        END;
      ConstructCountDown[];
      ConsAssign[@offset, P5U.MakeTreeLiteral[tagvalue]];
      END
    ELSE IF fieldsei # ISENull AND seb[fieldsei].idCtx # constctx THEN
      BEGIN -- no tag, but a fill field anyway
      fillSize: [0..wordlength) _ seb[fieldsei].idInfo;
      fillAddr: BitAddress _ seb[fieldsei].idValue; -- can't be full word
      P5L.FieldOfComponent[
	var: @offset, wd: fillAddr.wd,
	bd: fillAddr.bd, bSize: fillSize];
	IF tBits <= wordlength THEN
          P5L.AdjustComponent[
            var: @offset, rSei: rootSei, fSei: fieldsei,
            tBits: tBits];
      ConsAssign[@offset, MPtr.tC0];
      fieldsei _ P5U.NextVar[NextSe[fieldsei]];
      END;
    IF fieldsei # ISENull THEN
      MainConstruct[
	tb[node].son[2], rootSei, P5U.FieldAddress, atO, fieldsei];
    RETURN
    END;

  AllConstruct: PROCEDURE [
	node: Tree.Index,
	atO: POINTER TO READONLY frame VarComponent] =
    BEGIN
    asei: CSEIndex = tb[node].info;
    csei: CSEIndex; -- element type
    t1: Tree.Link _ tb[node].son[1];
    tOffset: frame VarComponent = atO^;
    offset: frame VarComponent _ tOffset;
    totalBits: CARDINAL = tOffset.wSize * wordlength + tOffset.bSize;
    -- totalBits could overflow, should probably use LONG CARD
    fillBits: CARDINAL _ 0;
    eCount, owd: CARDINAL;
    eWSize: CARDINAL;
    eBSize: [0..wordlength);
    packed: BOOLEAN _ FALSE;
    grain: [0..16);
    bWords, e2Offset: CARDINAL;
    
    WITH a: seb[asei] SELECT FROM
      array =>
        BEGIN
        csei _ UnderType[a.componentType];
        IF a.oldPacked THEN
	  BEGIN
          SELECT SymbolOps.BitsForType[a.componentType] FROM
	    1 => grain _ 1;
	    2 => grain _ 2;
	    3,4 => grain _ 4;
	    5,6,7,8 => grain _ 8;
	    ENDCASE => GO TO not;
	  packed _ TRUE;
	  grain _ 8; -- *************** until after 6.0c bootstrap
	  -- rethink fillBits when partial word packed arrays happen
	  eCount _ Cardinality[UnderType[a.indexType]];
	  fillBits _ totalBits - eCount*grain;
          IF fillBits # 0 THEN cd.remaining _ cd.remaining+1;
	  eWSize _ 0; eBSize _ grain;
	  EXITS
	    not => packed _ FALSE;
	  END
	ELSE packed _ FALSE;
	IF ~packed THEN
	  BEGIN
	  eBSize _ 0; eWSize _ SymbolOps.WordsForType[a.componentType];
	  END;
        END;
      ENDCASE => ERROR;

      P5L.FieldOfComponent[var: @offset, wSize: eWSize, bSize: eBSize];
      DO -- until we get to something interesting
        WITH t1 SELECT FROM
          subtree =>
	    BEGIN
	    node1: Tree.Index = index;
            SELECT tb[node1].name FROM
              pad =>
               BEGIN
               eWords: CARDINAL;
               t1 _ tb[node1].son[1]; -- note the variant may change here
               eWords _ P5U.WordsForOperand[t1];
               offset.wSize _ eWords; offset.bSize _ 0;
               END;
              cast => t1 _ tb[node1].son[1];
              ENDCASE => EXIT;
	    END;
          ENDCASE => EXIT;
        ENDLOOP;

    IF ~packed THEN
      BEGIN
      IF tOffset.wSize > eWSize THEN
	cd.remaining _ cd.remaining + 1; -- so only pointer isn't lost
      BEGIN -- to set up label "done"
      WITH t1 SELECT FROM
        subtree =>
	  BEGIN
	  node1: Tree.Index = index;
	  SELECT tb[node1].name FROM
            construct =>
              BEGIN
              MainConstruct[tb[node1].son[2], P5U.OperandType[t1],
                P5U.FieldAddress, @offset];
              GO TO done
              END;
            rowcons  =>
              BEGIN
              Row[node, csei, @offset];
              GO TO done
              END;
	    all => 
              BEGIN
              AllConstruct[node, @offset];
              GO TO done
              END;
            ENDCASE;
	  END;
	ENDCASE;
      ConstructCountDown[];
      ConsAssign[@offset, tb[node].son[1]]; -- set first element
      EXITS
	done => NULL;
      END;
      e2Offset _ eWSize;
      END
    ELSE -- packed case
      BEGIN
      -- for bootstraping purposes, deal only with word aligned
      ePerWord: CARDINAL = wordlength/grain;
      val: VarComponent _ P5L.ComponentForLex[P5.Exp[t1]];
      val _ P5L.EasilyLoadable[val, load]; -- could only clober with self
      THROUGH [0..MIN[ePerWord, eCount]) DO
	ConsAssign[@offset, Tree.Null, [bdo[P5L.OVarItem[val]]]];
	P5L.ModComponent[var: @offset, bd: eBSize];
	ENDLOOP;
      e2Offset _ 1;
      END;

    bWords _ tOffset.wSize - e2Offset; -- assumes tOffset.wSize >= 1
    IF bWords = 0 THEN RETURN;
    owd _ LoadPointer[tOffset.wd]; -- load address of first element
    IF ~(cd.inFrame OR cd.pLink OR cd.pLevel # lZ) THEN
      BEGIN -- we need to load at least twice, save in temp
      tvar: VarComponent _ Stack.TempStore[cd.pLength];
      P5L.LoadComponent[tvar]; -- load it back
      WITH vv: tvar SELECT FROM
        frame => BEGIN cd.pLevel _ vv.level; cd.pOffset _ vv.wd; END;
        ENDCASE => ERROR;
      END;
    cd.pLoaded _ FALSE; -- cd.pSti was maybe invalid anyway
    IF owd # 0 THEN P5L.GenAdd[owd, cd.pLength # 1];
    ConstructCountDown[];
    IF cd.pLength = 1 THEN -- otherwise stack gets too full
      P5U.Out1[FOpCodes.qLI, bWords];
    owd _ LoadPointer[tOffset.wd + e2Offset]; -- load address of second
    IF (cd.remaining # 0 AND
         ~(cd.inFrame OR cd.pLink OR cd.pLevel # lZ)) THEN
      BEGIN -- still needed, save in temp
      tvar: VarComponent _ Stack.TempStore[cd.pLength];
      P5L.LoadComponent[tvar]; -- load it back
      WITH vv: tvar SELECT FROM
        frame => BEGIN cd.pLevel _ vv.level; cd.pOffset _ vv.wd; END;
        ENDCASE => ERROR;
      END;
    cd.pLoaded _ FALSE; -- cd.pSti was maybe invalid anyway
    IF owd # 0 THEN P5L.GenAdd[owd, cd.pLength # 1];
    IF cd.pLength # 1 THEN
      BEGIN -- we almost certainly had to add something
      -- so this is not as awful as it seems
      tvar: VarComponent _ Stack.TempStore[2];
      P5U.Out1[FOpCodes.qLI, bWords];
      P5L.LoadComponent[tvar];
      END;
    BEGIN -- to define BltOp
    BltOp: ARRAY [1..2] OF BYTE = [FOpCodes.qBLT, FOpCodes.qBLTL];
    P5U.Out0[BltOp[cd.pLength]];
    END;
    IF fillBits # 0 THEN
      BEGIN
      usedBits: CARDINAL = eCount * grain;
      offset _ tOffset;
      P5L.FieldOfComponent[var: @offset, wd: usedBits / wordlength,
	bd: usedBits MOD wordlength, bSize: fillBits];
      ConstructCountDown[];
      ConsAssign[@offset, MPtr.tC0];
      END;
    END;

  ConstructExp: PUBLIC PROCEDURE [t: Tree.Link, node: Tree.Index]
      RETURNS [Lexeme] =
    BEGIN
    -- generate code for constructor expression
    r, rr: VarIndex;
    tsei: RecordSEIndex;
    wa: BOOLEAN _ FALSE;
    fa: PROCEDURE [ISEIndex] RETURNS [BitAddress, CARDINAL];
    saveCd: ConsDestination = cd;
    offset: frame VarComponent;
    nwords: CARDINAL;
    packedDest: VarIndex _ VarNull;

    tsei _ LOOPHOLE[tb[node].info, RecordSEIndex];
    nwords _ WordsForType[tsei];
    wa _ P5U.WordAligned[tsei];
    IF t = Tree.Null AND wa AND nwords <= MaxParmsInStack THEN
      BEGIN -- can build in stack
      P5.ConstructOnStack[tb[node].son[2], tsei];
      RETURN[P5L.TOSLex[nwords]];
      END;
    cd _ [ignoreSafen: t = Tree.Null OR t.tag = symbol]; -- + many defaults
    tb[node].son[2] _ TreeOps.UpdateList[tb[node].son[2], CountDups];
    r _ P5L.VarForLex[IF t = Tree.Null THEN P5.GenTempLex[nwords]
	ELSE P5.Exp[t]];
    WITH cc: cb[r] SELECT FROM
      ind => WITH cc SELECT FROM
	packed =>
	  BEGIN
	  var: VarComponent;
	  packedDest _ r;
	  var _ P5L.ComponentForLex[P5.GenTempLex[1]];
	  r _ P5L.OVarItem[var];
	  END;
	ENDCASE;
      ENDCASE;
    rr _ SetConsDest[r, TRUE];
    offset _ [wSize: cd.wSize, bSize: cd.bSize, space: frame[]];
    fa _ IF seb[tsei].argument THEN SymbolOps.FnField ELSE P5U.FieldAddress;
    MainConstruct[tb[node].son[2], tsei, fa, @offset];
    IF cd.remaining # 0 THEN SIGNAL ConstructionError;
    IF packedDest # VarNull THEN
      [] _ P5L.VarVarAssign[packedDest, P5L.CopyVarItem[rr], FALSE];
    cd _ saveCd;
    RETURN [[bdo[rr]]];
    END;


  TransferConstruct: PUBLIC PROCEDURE [lex: Lexeme, t: Tree.Link, tsei: CSEIndex] =
    BEGIN -- generate code for construct statement
    -- lex is TOSAddrLex for allocated large parameter record
    saveCd: ConsDestination = cd;
    offset: frame VarComponent;

    cd _ [ignoreSafen: t.tag = symbol]; -- + many defaults
    t _ TreeOps.UpdateList[t, CountDups];
    IF cd.remaining = 0 THEN RETURN;
    [] _ SetConsDest[P5L.VarForLex[lex], FALSE];
    cd.remaining _ cd.remaining + 1;
    offset _ [wSize: cd.wSize, bSize: cd.bSize, space: frame[]];
    MainConstruct[t, tsei, SymbolOps.FnField, @offset];
    [] _ LoadPointer[0];
    cd _ saveCd;
    RETURN
    END;

  Construct: PUBLIC PROCEDURE [t: Tree.Link, node: Tree.Index] =
    BEGIN -- generate code for construct statement
    tsei: RecordSEIndex;
    r, rr: VarIndex;
    saveCd: ConsDestination = cd;
    offset: frame VarComponent;
    fa: PROCEDURE [ISEIndex] RETURNS [BitAddress, CARDINAL];
    packedDest: VarIndex _ VarNull;

    cd _ [ignoreSafen: t.tag = symbol]; -- + many defaults
    tb[node].son[2] _ TreeOps.UpdateList[tb[node].son[2], CountDups];
    IF cd.remaining = 0 THEN RETURN;
    tsei _ LOOPHOLE[tb[node].info];
    fa _ IF seb[tsei].argument THEN SymbolOps.FnField ELSE P5U.FieldAddress;
    r _ P5L.VarForLex[P5.Exp[t]];
    WITH cc: cb[r] SELECT FROM
      ind => WITH cc SELECT FROM
	packed =>
	  BEGIN
	  var: VarComponent;
	  packedDest _ r;
	  var _ P5L.ComponentForLex[P5.GenTempLex[1]];
	  r _ P5L.OVarItem[var];
	  END;
	ENDCASE;
      ENDCASE;
    rr _ SetConsDest[r, packedDest # VarNull];
    offset _ [wSize: cd.wSize, bSize: cd.bSize, space: frame[]];
    MainConstruct[tb[node].son[2], tsei, fa, @offset];
    IF cd.remaining # 0 THEN SIGNAL ConstructionError;
    IF packedDest # VarNull THEN
      [] _ P5L.VarVarAssign[packedDest, rr, FALSE];
    cd _ saveCd;
    RETURN
    END;

  VariantConstruct: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN -- generate code for construct statement
    r: VarIndex;
    saveCd: ConsDestination = cd;
    offset: frame VarComponent;
    t1: Tree.Link _ tb[node].son[1];
    rootSei: RecordSEIndex;

    WITH t1 SELECT FROM
      subtree => t1 _ tb[index].son[1]; -- always a dollar node
      ENDCASE => P5.P5Error[592];
    cd _ [ignoreSafen: t1.tag = symbol]; -- + many defaults
    tb[node].son[2] _ TreeOps.UpdateList[tb[node].son[2], CountDups];
    IF cd.remaining = 0 THEN RETURN;
    rootSei _ SymbolOps.RecordRoot[LOOPHOLE[P5U.OperandType[t1]]];
    r _ P5L.VarForLex[P5.Exp[t1]];
    WITH cc: cb[r] SELECT FROM
      ind => WITH cc SELECT FROM
	packed => SIGNAL CPtr.CodeNotImplemented;
	ENDCASE;
      ENDCASE;
    [] _ SetConsDest[r, FALSE];
    offset _ [wSize: cd.wSize, bSize: cd.bSize, space: frame[]];
    WITH tb[node].son[2] SELECT FROM
      subtree => UnionConstruct[index, rootSei, @offset];
      ENDCASE;
    IF cd.remaining # 0 THEN SIGNAL ConstructionError;
    cd _ saveCd;
    RETURN
    END;

  All: PUBLIC PROCEDURE [t: Tree.Link, node: Tree.Index] =
    BEGIN -- array initialization
    r: VarIndex;
    saveCd: ConsDestination = cd; -- necessary in an inline
    offset: frame VarComponent;
    asei: Symbols.ArraySEIndex = tb[node].info;

    cd _ [ignoreSafen: t.tag = symbol]; -- + many defaults
    IF seb[asei].oldPacked AND
        SymbolOps.BitsForType[seb[asei].componentType] <= 8 THEN
      cd.remaining _ 1
    ELSE tb[node].son[1] _ TreeOps.UpdateList[tb[node].son[1], CountDups];
    r _ P5L.VarForLex[P5.Exp[t]];
    [] _ SetConsDest[r, FALSE];
    offset _ [wSize: cd.wSize, bSize: cd.bSize, space: frame[]];
    AllConstruct[node, @offset];
    IF cd.remaining # 0 THEN SIGNAL ConstructionError;
    cd _ saveCd;
    RETURN
    END;

  AllExp: PUBLIC PROCEDURE [t: Tree.Link, node: Tree.Index] 
      RETURNS [Lexeme] =
    BEGIN -- array (expression)initialization
    r, rr: VarIndex;
    saveCd: ConsDestination = cd;
    offset: frame VarComponent;
    awords: CARDINAL = WordsForType[tb[node].info];
    asei: Symbols.ArraySEIndex = tb[node].info;

    cd _ [ignoreSafen: t = Tree.Null OR t.tag = symbol]; -- + many defaults
    IF seb[asei].oldPacked AND
        SymbolOps.BitsForType[seb[asei].componentType] <= 8 THEN
      cd.remaining _ 1
    ELSE tb[node].son[1] _ TreeOps.UpdateList[tb[node].son[1], CountDups];
    r _ P5L.VarForLex[IF t = Tree.Null THEN P5.GenTempLex[awords]
	ELSE P5.Exp[t]];
    rr _ SetConsDest[r, TRUE];
    offset _ [wSize: cd.wSize, bSize: cd.bSize, space: frame[]];
    AllConstruct[node, @offset];
    IF cd.remaining # 0 THEN SIGNAL ConstructionError;
    cd _ saveCd;
    RETURN[[bdo[rr]]]
    END;


  END.