-- Constructor.mesa
-- last modified by Sweet, January 21, 1981  10:49 PM
-- last modified by Satterthwaite, June 15, 1982 8:45 am

DIRECTORY
  Alloc: TYPE USING [Notifier],
  Code: TYPE USING [CodeNotImplemented, curctxlvl],
  CodeDefs: TYPE USING [
    Base, BoVarIndex, Byte, codeType, ConsDestination, Lexeme, LabelCCIndex,
    MaxParmsInStack, NullLex, StoreOptions, VarComponent, VarIndex, VarNull],
  ComData: TYPE USING [switches, tC0],
  Counting: TYPE USING [Allocate, FillCounted, VarVarAssignCounted],
  Environment: TYPE USING [bitsPerCharacter, bitsPerWord],
  FOpCodes: TYPE USING [
    qADD, qALLOC, qBLT, qBLTL, qBLZL, qDSUB, qDUP, qGADRB, qLADRB, qLCO,
    qLI, qLP, qMUL, qOR, qPUSH, qSUB, qSHIFT, qWS, qWSD, qWSF],
  Inline: TYPE USING [BITOR, BITSHIFT],
  LiteralOps: TYPE USING [MasterString],
  Literals: TYPE USING [Base, MSTIndex, stType],
  P5: TYPE USING [
    ConstructOnStack, Exp, GenTempLex, MoveToCodeWord, MultiZero,
    P5Error, PushRhs, StoreMod, SysCall, WriteCodeWord, ZoneOp],
  P5L: TYPE USING [
    AdjustComponent, ComponentForLex, ComponentForSE, CopyToTemp,
    CopyVarItem, EasilyLoadable, FieldOfComponent, GenAdd, GenVarItem, 
    LoadAddress, LoadComponent, LoadVar, MakeBo, ModComponent, OVarItem,
    ReleaseVarItem, ReusableCopies, TOSAddrLex, TOSLex, VarForLex,
    VarVarAssign, Words],
  P5U: TYPE USING [
    ComputeFrameSize, FieldAddress, InsertLabel, MakeTreeLiteral, NextVar,
    LabelAlloc, OperandType, Out0, Out1, Out2, OutJump, PushLitVal, RecordConstant,
    TreeLiteral, TreeLiteralValue, TypeForTree, WordAligned, WordsForOperand],
  PrincOps: TYPE USING [AllocationVectorSize, FieldDescriptor],
  SDDefs: TYPE USING [sStringInit],
  Stack: TYPE USING [
    Also, Decr, Dump, Forget, Incr, Mark, Pop, TempStore, Top],
  Symbols: TYPE USING [
    Base, ArraySEIndex, BitAddress, ContextLevel, CSEIndex, CTXIndex,
    ISEIndex, ISENull, lG, lZ, RecordSEIndex, SEIndex, seType, typeANY],
  SymbolOps: TYPE USING [
    BitsPerElement, Cardinality, FirstCtxSe, FnField, NextSe, RCType, RecordRoot,
    UnderType, VariantField, WordsForType],
  Tree: TYPE USING [Base, Index, Link, Map, NodeName, Null, Scan, treeType],
  TreeOps: TYPE USING [
    FreeNode, GetNode, GetSe, NthSon, OpName, ScanList, UpdateList];

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

  -- imported definitions

  wordlength: CARDINAL = Environment.bitsPerWord;
  charlength: CARDINAL = Environment.bitsPerCharacter;

  ArraySEIndex: TYPE = Symbols.ArraySEIndex;
  BitAddress: TYPE = Symbols.BitAddress;
  ContextLevel: TYPE = Symbols.ContextLevel;
  CSEIndex: TYPE = Symbols.CSEIndex;
  CTXIndex: TYPE = Symbols.CTXIndex;
  ISEIndex: TYPE = Symbols.ISEIndex;
  ISENull: ISEIndex = Symbols.ISENull;
  lZ: ContextLevel = Symbols.lZ;
  lG: ContextLevel = Symbols.lG;
  RecordSEIndex: TYPE = Symbols.RecordSEIndex;
  SEIndex: TYPE = Symbols.SEIndex;
  typeANY: CSEIndex = Symbols.typeANY;	-- don't-care type for ConsAssign


  tb: Tree.Base;                -- tree base (local copy)
  seb: Symbols.Base;            -- semantic entry base (local copy)
  cb: CodeDefs.Base;            -- code base (local copy)
  stb: Literals.Base;           -- string base (local copy)

  ConstructorNotify: PUBLIC Alloc.Notifier =
    BEGIN  -- called by allocator whenever table area is repacked
    seb _ base[Symbols.seType];
    stb _ base[Literals.stType];
    tb _ base[Tree.treeType];
    cb _ base[codeType];
    END;

  -- state data and common code for construction

  OffsetRef: TYPE = POINTER TO READONLY frame VarComponent;
  ConstructionError: SIGNAL = CODE;

  cd: PUBLIC ConsDestination;

  SetConsDest: PROC [r: VarIndex, exp: BOOLEAN _ FALSE]
      RETURNS [rVal: VarIndex _ VarNull] =
    BEGIN
    bor: BoVarIndex;
    base: VarComponent;
    WITH cb[r] SELECT FROM
      o => WITH vv: var SELECT FROM
	frame =>
	  IF vv.level = lG OR vv.level = CPtr.curctxlvl THEN
	    BEGIN
	    cd.bd _ vv.bd;  cd.fOffset _ vv.wd;  cd.fLevel _ vv.level;
	    cd.inFrame _ TRUE;   cd.pLength _ 1;	-- in case loaded
	    cd.wSize _ vv.wSize;  cd.bSize _ vv.bSize;
	    IF exp THEN rVal _ r ELSE P5L.ReleaseVarItem[r];
	    RETURN
	    END;
	frameup, 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;
      [first: r1, next: rVal] _ P5L.ReusableCopies[bor, store, FALSE];
      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;
    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 => {cd.pLink _ TRUE; cd.pOffset _ vv.wd};
      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;

  CountedAssign: PROC [type: CSEIndex, const: BOOLEAN] RETURNS [BOOLEAN] = INLINE
    BEGIN
    RETURN [cd.options.counted AND RCType[type]#none AND ~(const AND cd.options.init)]
    END;
    
 
  GetPointer: PROC [owd: CARDINAL]
       RETURNS [aVar: VarComponent, newOwd: CARDINAL] =
    BEGIN -- exit invariant: cd.pLoaded => newOwd + cd.pDelta = owd
    SELECT TRUE FROM
      cd.pLoaded => 
	IF cd.inFrame AND INTEGER[owd] < cd.pDelta AND (cd.fOffset+owd) IN Byte THEN
	  BEGIN
	  PopPointer[];
	  cd.pLink _ FALSE; cd.pLevel _ lZ;
	  cd.pDelta _ owd; newOwd _ 0;
	  aVar _ [wSize: 1, space: faddr[wd: cd.fOffset+owd, level: cd.fLevel]];
	  END
	ELSE 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;  cd.pDelta _ owd; -- to be right if loaded
	newOwd _ 0;
	cd.pLevel _ lZ; --forget copy of old pointer in frame (can do better some day)
	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] IN [cd.pDelta .. cd.pDelta + LAST[Byte]] THEN
      newOwd _ CARDINAL[INTEGER[owd] - cd.pDelta]
    ELSE
      BEGIN
      P5L.LoadComponent[aVar];
      IF INTEGER[owd] > cd.pDelta THEN
	P5L.GenAdd[INTEGER[owd] - cd.pDelta, cd.pLength # 1]
      ELSE
	BEGIN
	P5U.Out1[FOpCodes.qLI, CARDINAL[cd.pDelta] - owd];
	IF cd.pLength # 1 THEN
	  {P5U.Out1[FOpCodes.qLI, 0]; P5U.Out0[FOpCodes.qDSUB]}
	ELSE P5U.Out0[FOpCodes.qSUB];
	END;
      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: PROC [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;
  
  DumpPointer: PROC =
    BEGIN
    IF cd.pLoaded THEN
      BEGIN
      IF cd.pLink OR cd.pLevel # lZ THEN PopPointer[]
      ELSE
	BEGIN
	aVar: VarComponent = Stack.TempStore[cd.pLength];
	WITH aVar SELECT FROM
	  frame => {cd.pLevel _ level; cd.pOffset _ wd};
	  link => {cd.pLink _ TRUE; cd.pOffset _ wd};
	  ENDCASE => ERROR;
	END;
      cd.pLoaded _ FALSE;
      END;
    END;

  PopPointer: PROC =
    BEGIN
    IF cd.pLoaded THEN Stack.Pop[cd.pLength];
    cd.pLoaded _ FALSE;
    END;
    
    
  ConsAssign: PROC [type: CSEIndex, atO: OffsetRef, t: Tree.Link, l: Lexeme _ NullLex] =
    BEGIN
    dest: VarIndex;
    source: VarIndex;
    offset: frame VarComponent _ atO^;
    counted: BOOLEAN = CountedAssign[type, P5U.TreeLiteral[t]];
    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 ~counted AND
      (offset.wSize = 0 OR (offset.bSize = 0 AND offset.wSize IN [1..2]));
    offset.bd _ offset.bd + cd.bd;
    IF cd.pLoaded THEN
      SELECT TRUE FROM
	useFrame => PopPointer[];
	~useSwapped => DumpPointer[];
	ENDCASE;
    IF useSwapped THEN offset.wd _ LoadPointer[offset.wd];
    source _ P5L.VarForLex[IF l # NullLex
      THEN l
      ELSE P5.Exp[IF offset.wSize = 0 AND TreeOps.OpName[t] = mod
 	THEN P5.StoreMod[t, offset.bSize] ELSE t]];
    IF useSwapped THEN
      BEGIN
      base: VarComponent;
      P5L.LoadVar[source];
      WITH cb[cd.pSti] SELECT FROM
	onStack =>
	  BEGIN
	  WSOp: ARRAY [1..2] OF Byte = [FOpCodes.qWS, FOpCodes.qWSD];
	  IF offset.bSize = 0 THEN P5U.Out1[WSOp[offset.wSize], offset.wd]
	  ELSE P5U.Out2[FOpCodes.qWSF, offset.wd,
	    LOOPHOLE[PrincOps.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;
      source _ P5L.VarForLex[P5L.TOSLex[P5L.Words[offset.wSize, offset.bSize]]];
      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 => {cd.pLevel _ level; cd.pOffset _ wd};
            link => {cd.pLink _ TRUE; cd.pOffset _ wd};
            ENDCASE => ERROR;
          cd.pLoaded _ FALSE;
          END;
        ENDCASE;
      dest _ P5L.GenVarItem[bo];
      cb[dest] _ [body: bo[base: base, offset: offset]];
      END;
    IF counted THEN
      BEGIN
      subOptions: StoreOptions _ cd.options;
      subOptions.composite _ (RCType[type] = composite);
      [] _ Counting.VarVarAssignCounted[
	to: dest, from: source, options: subOptions, type: type];
      END
    ELSE [] _ P5L.VarVarAssign[to: dest, from: source, isexp: FALSE];
    cd.pLoaded _ FALSE;
    END;


  VanillaCons: PROC [t: Tree.Link] RETURNS [vanilla: BOOLEAN _ TRUE] =
    BEGIN

    CheckItem: Tree.Scan =
      BEGIN
      SELECT TreeOps.OpName[t] FROM
	rowcons, construct, all, union => vanilla _ FALSE;
	cast, pad => CheckItem[TreeOps.NthSon[t, 1]];
	ENDCASE => NULL;
      END;

    TreeOps.ScanList[t, CheckItem];  RETURN
    END;

  CountDups: Tree.Map =
    BEGIN
    v _ t;	-- normal case (see safen)
    IF t # Tree.Null THEN WITH t SELECT FROM
      subtree =>
        BEGIN
        node: Tree.Index = index;
        SELECT tb[node].name FROM
          rowcons, construct =>
	    IF tb[node].name = rowcons AND tb[node].attr1 THEN
	      cd.remaining _ cd.remaining+1
	    ELSE tb[node].son[2] _ TreeOps.UpdateList[tb[node].son[2], CountDups];
	  all =>
            BEGIN
	    aSei: Symbols.ArraySEIndex = tb[node].info;
	    IF BitsPerElement[seb[aSei].componentType, seb[aSei].packed] < wordlength
	     AND tb[node].son[1] # Tree.Null THEN
	      cd.remaining _ cd.remaining+1
            ELSE tb[node].son[1] _ CountDups[tb[node].son[1]];
            END;
          union =>
            BEGIN
            IF tb[node].attr2 THEN cd.remaining _ cd.remaining+1;
            tb[node].son[2] _ TreeOps.UpdateList[tb[node].son[2], CountDups];
            END;
          cast, pad =>
            tb[node].son[1] _ CountDups[tb[node].son[1]];
	  safen => 
	    IF cd.ignoreSafen THEN
              BEGIN
              v _ CountDups[tb[node].son[1]];
              tb[node].son[1] _ Tree.Null;  TreeOps.FreeNode[node];
              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;
	      v _ [symbol[sei]];
	      cd.remaining _ cd.remaining+1;
	      TreeOps.FreeNode[node];
              END;
          ENDCASE => cd.remaining _ cd.remaining+1;
        END;
      ENDCASE => cd.remaining _ cd.remaining+1;
    RETURN
    END;

  ConstructCountDown: PROC =
    BEGIN
    IF cd.remaining = 0 THEN SIGNAL ConstructionError;
    cd.remaining _ cd.remaining - 1;
    END;

 
  ConstantFill: PROC [type: CSEIndex, atO: OffsetRef, t: Tree.Link] =
    BEGIN
    ConstructCountDown[];
    SELECT TRUE FROM
      MPtr.switches['m] AND
       P5.MultiZero[t] AND cd.pLength = 2 AND ~CountedAssign[type, TRUE] =>
	FillZeros[atO, P5L.Words[atO.wSize, atO.bSize]];
      -- test for other special cases here
      ENDCASE => ConsAssign[type, atO, t];
    END;
    
  FillZeros: PROC [atO: OffsetRef, nwords: CARDINAL] =
    BEGIN
    base: VarComponent;
    offset: frame VarComponent _ atO^;
    dest: VarIndex;
    IF cd.remaining # 0 AND ~(cd.pLength = 2 AND offset.wd = 0) THEN
      DumpPointer[];
    [base, offset.wd] _ GetPointer[offset.wd];
    dest _ P5L.GenVarItem[bo];
    cb[dest] _ [body: bo[base: base, offset: offset]];
    IF ~P5L.LoadAddress[dest] THEN P5U.Out0[FOpCodes.qLP];
    P5U.PushLitVal[nwords];
    P5U.Out0[FOpCodes.qBLZL];
    IF cd.remaining # 0 AND (cd.pLength = 2 AND offset.wd = 0) THEN
      cd.pLoaded _ TRUE
    ELSE {Stack.Pop[2]; cd.pLoaded _ FALSE};
    END;
    
    
 -- main drivers

  MainConstruct: PROC [
	maint: Tree.Link,
	rSei: CSEIndex,
        fa: PROC [ISEIndex] RETURNS [BitAddress, CARDINAL],
	atO: OffsetRef,
        fieldSei: ISEIndex _ ISENull] =
    BEGIN -- workhorse subroutine for construction in memory
    tOffset: frame VarComponent = atO^;
    totalBits: CARDINAL = tOffset.wSize*wordlength + tOffset.bSize;
    rcSei: RecordSEIndex;

    AssignField: PROC [root: Tree.Link] =
      BEGIN
      offset: frame VarComponent;
      rep: BitAddress;
      res: CARDINAL;
      fieldType: CSEIndex = UnderType[seb[fieldSei].idType];
      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
          SELECT TreeOps.OpName[root] FROM
	    pad =>
	      BEGIN
	      root _ TreeOps.NthSon[root, 1];
	      offset.wSize _ P5U.WordsForOperand[root]; offset.bSize _ 0;
	      END;
	    cast => root _ TreeOps.NthSon[root, 1];
	    ENDCASE => EXIT;
          ENDLOOP;
        SELECT TreeOps.OpName[root] FROM
          construct =>
	    MainConstruct[
	      TreeOps.NthSon[root, 2], P5U.OperandType[root], P5U.FieldAddress, @offset];
          union => UnionConstruct[TreeOps.GetNode[root], rcSei, atO];
          rowcons => Row[TreeOps.GetNode[root], @offset];
          all => [] _ AllConstruct[TreeOps.GetNode[root], @offset];
          mwconst => ConstantFill[fieldType, @offset, root];
          ENDCASE => {ConstructCountDown[]; ConsAssign[fieldType, @offset, root]};
	END; -- IF root # Tree.Null
      fieldSei _ P5U.NextVar[NextSe[fieldSei]];
      END; -- of AssignField

    IF fieldSei = ISENull THEN
      WITH seb[rSei] SELECT FROM
        record =>
          BEGIN
          rcSei _ RecordRoot[LOOPHOLE[rSei]];
          fieldSei _ P5U.NextVar[FirstCtxSe[seb[rcSei].fieldCtx]];
          END;
        ENDCASE => P5.P5Error[589]
    ELSE rcSei _ LOOPHOLE[rSei];
    TreeOps.ScanList[maint, AssignField];
    END; -- of MainConstruct


  Row: PROC [node: Tree.Index, atO: OffsetRef] =
    BEGIN  -- handles ARRAY construction
    aSei: ArraySEIndex = tb[node].info;
    IF seb[aSei].typeTag # array THEN P5.P5Error[580];
    IF tb[node].attr1 THEN
      BEGIN	-- row of string literals
      c: CARDINAL = P5.MoveToCodeWord[];
      n: CARDINAL _ 0;
      localText, globalText: BOOLEAN _ FALSE;

      TextItem: PROC [t: Tree.Link] =
        BEGIN
        WITH e:t SELECT FROM
          literal =>
            WITH e.info SELECT FROM
              string =>
                BEGIN
                msti: Literals.MSTIndex = LiteralOps.MasterString[index];
                IF stb[msti].local THEN localText _ TRUE ELSE globalText _ TRUE;
                P5.WriteCodeWord[stb[msti].info];
                END;
              ENDCASE => P5.P5Error[577];
          ENDCASE => P5.P5Error[578];
        n _ n+1;
        END;

      TreeOps.ScanList[tb[node].son[2], TextItem];
      ConstructCountDown[];
      Stack.Dump[]; Stack.Mark[];
      P5U.Out1[FOpCodes.qLCO, c];  P5U.PushLitVal[n];  P5U.RecordConstant[c, n];
      IF localText AND globalText OR cd.remaining # 0 AND ~cd.inFrame THEN
	SIGNAL CPtr.CodeNotImplemented;
      P5U.Out1[IF localText THEN FOpCodes.qLADRB ELSE FOpCodes.qGADRB, 0];
      [] _ LoadPointer[atO.wd];
      IF cd.pLength # 1 THEN -- does a long pointer to array of short strings
        SIGNAL CPtr.CodeNotImplemented; -- make any sense?
      P5.SysCall[SDDefs.sStringInit];
      cd.pLoaded _ FALSE;
      END
    ELSE
      BEGIN  -- not all string literals
      offset: frame VarComponent _ atO^;
      eWSize: CARDINAL;
      eBSize: [0..wordlength);
      cSei: CSEIndex = UnderType[seb[aSei].componentType];

      AssignElement: PROC [t: Tree.Link] =
	BEGIN
	DO -- until we get to something interesting
	  SELECT TreeOps.OpName[t] FROM
	    pad =>
	      BEGIN
	      t _ TreeOps.NthSon[t, 1];
	      offset.wSize _ P5U.WordsForOperand[t]; offset.bSize _ 0;
	      END;
	    cast => t _ TreeOps.NthSon[t, 1];
	    ENDCASE => EXIT;
          ENDLOOP;
	SELECT TreeOps.OpName[t] FROM
          rowcons => Row[TreeOps.GetNode[t], @offset];
          construct =>
	    MainConstruct[
	      TreeOps.NthSon[t, 2], P5U.OperandType[t], P5U.FieldAddress, @offset];
          all => -- convert this later
	    [] _ AllConstruct[TreeOps.GetNode[t], @offset];
          mwconst => ConstantFill[cSei, @offset, t];
          ENDCASE =>
	    IF t # Tree.Null THEN {ConstructCountDown[]; ConsAssign[cSei, @offset, t]};
	P5L.ModComponent[var: @offset, wd: eWSize, bd: offset.bSize];
	offset.wSize _ eWSize;  offset.bSize _ eBSize;
	END; -- of AssignElement

      totalBits: CARDINAL = atO.wSize*wordlength + atO.bSize;
        -- totalBits could overflow, but that would be a very large constructor
      grain: CARDINAL = BitsPerElement[seb[aSei].componentType, seb[aSei].packed];
      packed: BOOLEAN;
      fillBits: CARDINAL;
      IF grain >= wordlength THEN
	BEGIN
	packed _ FALSE;  fillBits _ 0;
	eBSize _ 0; eWSize _ WordsForType[seb[aSei].componentType];
	END
      ELSE
	BEGIN
	packed _ TRUE;
	fillBits _ totalBits - Cardinality[UnderType[seb[aSei].indexType]]*grain;
	IF fillBits # 0 AND totalBits > wordlength THEN 
	  cd.remaining _ cd.remaining+1;
	eWSize _ 0; eBSize _ grain;
	END;
      IF fillBits # 0 AND totalBits <= wordlength THEN 
	BEGIN
	bs: CARDINAL = eBSize + fillBits;
	offset.wSize _ bs / wordlength;
	offset.bSize _ bs MOD wordlength;
	fillBits _ 0;
	END
      ELSE {offset.wSize _ eWSize; offset.bSize _ eBSize};
      TreeOps.ScanList[tb[node].son[2], AssignElement];
      IF fillBits # 0 THEN
	BEGIN
	offset.wSize _ 0;  offset.bSize _ fillBits;
	ConstructCountDown[];  ConsAssign[typeANY, @offset, MPtr.tC0];
	END;
      END;
    END;


  UnionConstruct: PROC [node: Tree.Index, rootSei: RecordSEIndex, atO: OffsetRef] =
    BEGIN -- construct a union part, atO^ is offset of beginning of record
    tOffset: frame VarComponent = atO^;
    offset: frame VarComponent _ atO^;
    fieldSei: ISEIndex;
    vCtx: CTXIndex;
    uSei: CSEIndex = tb[node].info;
    rcSei: RecordSEIndex;
    tSei: ISEIndex;
    tagged: BOOLEAN;
    tagValue: CARDINAL;
    tBits: CARDINAL = tOffset.wSize*wordlength + tOffset.bSize;
    WITH u: seb[uSei] SELECT FROM
      union =>
	BEGIN
	tagged _ u.controlled;
	IF tagged THEN
          BEGIN
	  tagAddr: BitAddress = seb[u.tagSei].idValue;
	  tagSize: [0..wordlength] = seb[u.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: u.tagSei, tBits: tBits];
	  END;
	END;
      ENDCASE => ERROR;
    tSei _ TreeOps.GetSe[tb[node].son[1]];
    tagValue _ seb[tSei].idValue;
    rcSei _ LOOPHOLE[UnderType[tSei], RecordSEIndex];
    vCtx _ seb[rcSei].fieldCtx;
    fieldSei _ P5U.NextVar[FirstCtxSe[vCtx]];
    IF tagged THEN
      BEGIN
      IF fieldSei # ISENull AND seb[fieldSei].idCtx # vCtx THEN
        BEGIN -- a dummy fill field
        fillSize: [0..wordlength) = seb[fieldSei].idInfo;
	b: CARDINAL = offset.bSize + fillSize;
        tagValue _ Inline.BITSHIFT[tagValue, fillSize];
        offset.bSize _ b MOD wordlength;  offset.wSize _ b/wordlength;
        fieldSei _ P5U.NextVar[NextSe[fieldSei]];
        END;
      ConstructCountDown[];
      ConsAssign[typeANY, @offset, P5U.MakeTreeLiteral[tagValue]];
      END
    ELSE IF fieldSei # ISENull AND seb[fieldSei].idCtx # vCtx 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[typeANY, @offset, MPtr.tC0];
      fieldSei _ P5U.NextVar[NextSe[fieldSei]];
      END;
    IF fieldSei # ISENull THEN
      MainConstruct[tb[node].son[2], rootSei, P5U.FieldAddress, atO, fieldSei];
    END;


  AllConstruct: PROC [node: Tree.Index, atO: OffsetRef, replCount: CARDINAL _ 1] 
      RETURNS [wordsFilled: CARDINAL] =
    BEGIN	-- reexamine when packed arrays of packed arrays
    aSei: ArraySEIndex = tb[node].info;
    tOffset: frame VarComponent = atO^;
    offset: frame VarComponent _ atO^;
    csei: CSEIndex = UnderType[seb[aSei].componentType];
    eWSize: CARDINAL;
    eBSize: [0..wordlength);
    t1: Tree.Link _ tb[node].son[1];
    totalBits: CARDINAL = tOffset.wSize*wordlength + tOffset.bSize;
      -- totalBits could overflow, should probably use LONG CARD
    grain: CARDINAL = BitsPerElement[seb[aSei].componentType, seb[aSei].packed];
    packed: BOOLEAN;
    fillBits, eCount: CARDINAL;
    e2Offset: CARDINAL;
    wordsFilled _ P5L.Words[tOffset.wSize, tOffset.bSize];
    IF grain >= wordlength THEN
      BEGIN
      packed _ FALSE;  fillBits _ 0;
      eBSize _ 0; eWSize _ WordsForType[seb[aSei].componentType];
      END
    ELSE
      BEGIN
      packed _ TRUE;
      eCount _ Cardinality[UnderType[seb[aSei].indexType]];
      fillBits _ totalBits - eCount*grain;
      eWSize _ 0; eBSize _ grain;
      END;
    P5L.FieldOfComponent[var: @offset, wSize: eWSize, bSize: eBSize];
    IF fillBits # 0 AND totalBits <= wordlength THEN 
      BEGIN
      bs: CARDINAL = eBSize + fillBits;
      offset.wSize _ bs / wordlength;
      offset.bSize _ bs MOD wordlength;
      fillBits _ 0;
      END;
    IF fillBits = 0 THEN wordsFilled _ wordsFilled * replCount;
    IF t1 = Tree.Null THEN RETURN;
    DO -- until we get to something interesting
      SELECT TreeOps.OpName[t1] FROM
	pad =>
	  BEGIN
	  t1 _ TreeOps.NthSon[t1, 1];
	  offset.wSize _ P5U.WordsForOperand[t1]; offset.bSize _ 0;
	  END;
	cast => t1 _ TreeOps.NthSon[t1, 1];
	ENDCASE => EXIT;
      ENDLOOP;
    IF MPtr.switches['m] AND (P5.MultiZero[t1, 1] AND wordsFilled > 1)
     AND ~CountedAssign[csei, TRUE] THEN
      BEGIN
      ConstructCountDown[];
      FillZeros[atO, wordsFilled];
      e2Offset _ wordsFilled;  fillBits _ 0;
      END
    ELSE IF packed THEN
      BEGIN
      ePerWord: CARDINAL = wordlength/grain;
      fold: BOOLEAN = P5U.TreeLiteral[t1];
      v: WORD;
      IF fillBits # 0 THEN cd.remaining _ cd.remaining+1;
      IF cd.pLoaded THEN
        SELECT TRUE FROM
	  (cd.pLength > 1) => DumpPointer[];
	  cd.inFrame => PopPointer[];
	  ENDCASE;
      SELECT TRUE FROM
	fold => v _ P5U.TreeLiteralValue[t1];
	(grain = 1) => {v _ 1; P5.PushRhs[t1]};
	ENDCASE => P5.PushRhs[t1];
      THROUGH (0..MIN[ePerWord, eCount]) DO
        IF fold OR grain = 1 THEN v _ Inline.BITOR[Inline.BITSHIFT[v, grain], v]
        ELSE
	  BEGIN
	  P5U.Out0[FOpCodes.qDUP];
	  P5U.PushLitVal[grain];  P5U.Out0[FOpCodes.qSHIFT];
	  P5U.Out0[FOpCodes.qOR];
	  END;
     	ENDLOOP;
      SELECT TRUE FROM
	fold => P5U.PushLitVal[v];
	(grain = 1) =>
	  BEGIN
	  tlabel: LabelCCIndex = P5U.LabelAlloc[];
	  elabel: LabelCCIndex = P5U.LabelAlloc[];
	  P5U.PushLitVal[0];  P5U.OutJump[JumpE, tlabel];
	  P5U.PushLitVal[v];  P5U.OutJump[Jump, elabel];
	  P5U.InsertLabel[tlabel];
	  Stack.Decr[1];  P5U.Out0[FOpCodes.qPUSH];
	  P5U.InsertLabel[elabel];
	  END;
	ENDCASE => NULL;
      IF totalBits < wordlength THEN P5L.FieldOfComponent[var: @offset, bSize: totalBits]
      ELSE P5L.FieldOfComponent[var: @offset, wSize: 1];
      ConsAssign[typeANY, @offset, Tree.Null, P5L.TOSLex[1]];
      P5L.ModComponent[var: @offset,
	bd: IF eCount > ePerWord THEN wordlength ELSE offset.bSize];
      IF wordsFilled <= 1 THEN -- all in one word case
	BEGIN
	ConstructCountDown[];
	IF cd.remaining = 0 AND cd.pLoaded THEN PopPointer[];
	END;
      e2Offset _ 1;
      END
    ELSE IF TreeOps.OpName[t1] = all THEN
      BEGIN  -- ~packed, set all elements in recursive call
      eCount _ Cardinality[UnderType[seb[aSei].indexType]];
      e2Offset _ AllConstruct[TreeOps.GetNode[t1], @offset, replCount*eCount];
      -- wordsFilled > e2Offset => cd.remaining has been incremented
      END
    ELSE
      BEGIN -- ~packed
      IF wordsFilled > eWSize THEN
	cd.remaining _ cd.remaining + 1; -- so only pointer isn't lost
      SELECT TreeOps.OpName[t1] FROM -- set first element
	construct =>
	  MainConstruct[TreeOps.NthSon[t1, 2], P5U.OperandType[t1],
	    P5U.FieldAddress, @offset];
	rowcons => Row[TreeOps.GetNode[t1], @offset];
	ENDCASE => {ConstructCountDown[]; ConsAssign[csei, @offset, t1]};
      e2Offset _ eWSize;
      END;
    IF wordsFilled > e2Offset THEN
      BEGIN
      bWords: CARDINAL = wordsFilled - e2Offset;
      IF ~CountedAssign[csei, P5U.TreeLiteral[t1]] THEN
	BEGIN
	BltOp: ARRAY [1..2] OF Byte = [FOpCodes.qBLT, FOpCodes.qBLTL];
	owd: CARDINAL _ 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 => {cd.pLevel _ vv.level; cd.pOffset _ vv.wd};
	    ENDCASE => ERROR;
	  END;
	cd.pLoaded _ FALSE; -- cd.pSti was maybe invalid anyway
	IF owd # 0 THEN P5L.GenAdd[owd, cd.pLength # 1];
	ConstructCountDown[];
	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 => {cd.pLevel _ vv.level; cd.pOffset _ vv.wd};
	    ENDCASE => ERROR;
	  END;
	cd.pLoaded _ FALSE; -- cd.pSti was maybe invalid anyway
	IF owd # 0 THEN P5L.GenAdd[owd, cd.pLength # 1];
	P5U.Out0[BltOp[cd.pLength]];
	END
      ELSE
	BEGIN
	aVar: VarComponent;
	r: VarIndex = P5L.GenVarItem[bo];
	rr: VarIndex = P5L.GenVarItem[bo];
	offset _ tOffset;  offset.wSize _ e2Offset;  offset.bSize _ 0;
	[aVar, offset.wd] _ GetPointer[offset.wd];
	IF cd.pLoaded THEN
	  BEGIN
	  aVar _ Stack.TempStore[cd.pLength];
	  IF cd.remaining # 0 AND ~cd.inFrame THEN
	    WITH aVar SELECT FROM
	      frame => {cd.pLevel _ level; cd.pOffset _ wd};
	      link => {cd.pLink _ TRUE; cd.pOffset _ wd};
	      ENDCASE => ERROR;
	  cd.pLoaded _ FALSE;
	  END;
	ConstructCountDown[];
	cb[r] _ [body: bo[base: aVar, offset: offset]];
	P5L.ModComponent[@offset, e2Offset];  offset.wSize _ bWords;
	cb[rr] _ [body: bo[base: aVar, offset: offset]];
	Counting.FillCounted[source: r, space: rr, type: csei, options: cd.options];
	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];
	IF replCount > 1 THEN cd.remaining _ cd.remaining + 1;  -- caller replicates
	ConstructCountDown[];  ConsAssign[typeANY, @offset, MPtr.tC0];
	END;
      END;
    RETURN
    END;


 -- public entries

  All: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions] =
    BEGIN
    r: VarIndex;
    saveCd: ConsDestination = cd; -- necessary in an inline
    offset: frame VarComponent;
    aSei: Symbols.ArraySEIndex = tb[node].info;
    cd _ [options: options, ignoreSafen: t.tag = symbol]; -- + many defaults
    IF BitsPerElement[seb[aSei].componentType, seb[aSei].packed] < wordlength THEN
      cd.remaining _ 1
    ELSE tb[node].son[1] _ CountDups[tb[node].son[1]];
    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;
    END;

  AllExp: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions]
      RETURNS [Lexeme] =
    BEGIN
    r, rr: VarIndex;
    saveCd: ConsDestination = cd;
    offset: frame VarComponent;
    aSei: Symbols.ArraySEIndex = tb[node].info;
    aWords: CARDINAL = WordsForType[aSei];
    cd _ [options: options, ignoreSafen: t = Tree.Null OR t.tag = symbol]; -- + defaults
    IF BitsPerElement[seb[aSei].componentType, seb[aSei].packed] < wordlength THEN
      cd.remaining _ 1
    ELSE tb[node].son[1] _ CountDups[tb[node].son[1]];
    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;


  Construct: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions] =
    BEGIN
    tsei: RecordSEIndex = tb[node].info;
    r, rr: VarIndex;
    saveCd: ConsDestination = cd;
    offset: frame VarComponent;
    fa: PROC [ISEIndex] RETURNS [BitAddress, CARDINAL] =
      IF seb[tsei].argument THEN FnField ELSE P5U.FieldAddress;
    packedDest: VarIndex _ VarNull;
    cd _ [options: options, ignoreSafen: t.tag = symbol]; -- + many defaults
    tb[node].son[2] _ TreeOps.UpdateList[tb[node].son[2], CountDups];
    IF cd.remaining # 0 THEN
      BEGIN
      r _ P5L.VarForLex[P5.Exp[t]];
      WITH cc: cb[r] SELECT FROM
	ind => WITH cc SELECT FROM
	  packed =>
	    BEGIN
	    var: VarComponent = P5L.ComponentForLex[P5.GenTempLex[1]];
	    packedDest _ r;  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];
      END;
    IF cd.remaining # 0 THEN SIGNAL ConstructionError;
    IF packedDest # VarNull THEN	-- not RC
      [] _ P5L.VarVarAssign[packedDest, rr, FALSE];
    cd _ saveCd;
    END;

  ConstructExp: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions]
      RETURNS [Lexeme] =
    BEGIN  -- generate code for constructor expression
    r, rr: VarIndex;
    tsei: RecordSEIndex = tb[node].info;
    nwords: CARDINAL = WordsForType[tsei];
    wa: BOOLEAN = P5U.WordAligned[tsei];
    fa: PROC [ISEIndex] RETURNS [BitAddress, CARDINAL] =
      IF seb[tsei].argument THEN FnField ELSE P5U.FieldAddress;
    saveCd: ConsDestination = cd;
    offset: frame VarComponent;
    packedDest: VarIndex _ VarNull;
    IF t = Tree.Null AND wa AND nwords <= MaxParmsInStack AND
	VanillaCons[tb[node].son[2]] THEN
      BEGIN -- can build in stack
      P5.ConstructOnStack[tb[node].son[2], tsei];
      RETURN [P5L.TOSLex[nwords]]
      END;
    cd _ [options: options, ignoreSafen: t = Tree.Null OR t.tag = symbol]; -- + 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 = P5L.ComponentForLex[P5.GenTempLex[1]];
	  packedDest _ r;  r _ P5L.OVarItem[var];
	  END;
	ENDCASE;
      ENDCASE;
    rr _ SetConsDest[r, TRUE];
    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	-- not RC
      [] _ P5L.VarVarAssign[packedDest, P5L.CopyVarItem[rr], FALSE];
    cd _ saveCd;
    RETURN [[bdo[rr]]]
    END;


  RowCons: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions] =
    BEGIN -- array initialization
    aSei: ArraySEIndex = tb[node].info;
    saveCd: ConsDestination = cd; -- necessary in an inline
    offset: frame VarComponent;
    cd _ [options: options, 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];
    [] _ SetConsDest[P5L.VarForLex[P5.Exp[t]], FALSE];
    offset _ [wSize: cd.wSize, bSize: cd.bSize, space: frame[]];
    Row[node, @offset];
    IF cd.remaining # 0 THEN SIGNAL ConstructionError;
    cd _ saveCd;
    END;

  RowConsExp: PUBLIC PROC [t: Tree.Link, node: Tree.Index, options: StoreOptions]
      RETURNS [Lexeme] =
    BEGIN -- array (expression) construction
    r, rr: VarIndex;
    aSei: ArraySEIndex = 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, @offset];
    IF cd.remaining # 0 THEN SIGNAL ConstructionError;
    cd _ saveCd;
    RETURN [[bdo[rr]]]
    END;


  TransferConstruct: PUBLIC PROC [
      nparms: CARDINAL, resident: BOOLEAN, t: Tree.Link, tsei: CSEIndex] =
    BEGIN -- generate code for construct statement
    lex: Lexeme;
    saveCd: ConsDestination = cd;
    offset: frame VarComponent;
    fs: CARDINAL _ P5U.ComputeFrameSize[nparms];
    cd _ [ignoreSafen: FALSE]; -- + many defaults
    IF TreeOps.OpName[t] = safen THEN
      BEGIN  -- CountDups would free t
      node: Tree.Index = TreeOps.GetNode[t];
      r: VarIndex = P5L.VarForLex[P5.Exp[tb[node].son[1]]];
      sei: ISEIndex = P5L.CopyToTemp[r].sei;
      seb[sei].idType _ tb[node].info;
      t _ [symbol[sei]];
      END;
    t _ TreeOps.UpdateList[t, CountDups];
    IF resident THEN fs _ fs + PrincOps.AllocationVectorSize;
    P5U.PushLitVal[fs];  P5U.Out0[FOpCodes.qALLOC];
    cd.remaining _ cd.remaining + 1;
    IF cd.remaining # 1 THEN
      BEGIN
      lex _ P5L.TOSAddrLex[nparms];
      [] _ SetConsDest[P5L.VarForLex[lex], FALSE];
      offset _ [wSize: cd.wSize, bSize: cd.bSize, space: frame[]];
      MainConstruct[t, tsei, FnField, @offset];
      [] _ LoadPointer[0];
      END;
    IF cd.remaining # 1 THEN SIGNAL ConstructionError;
    cd _ saveCd;
    END;


  VariantConstruct: PUBLIC PROC [t1, t2: Tree.Link, options: StoreOptions] =
    BEGIN
    r: VarIndex;
    saveCd: ConsDestination = cd;
    offset: frame VarComponent;
    rootSei: RecordSEIndex;
    t1 _ TreeOps.NthSon[t1, 1];
    cd _ [options: options, ignoreSafen: t1.tag = symbol]; -- + many defaults
    t2 _ TreeOps.UpdateList[t2, CountDups];
    IF cd.remaining # 0 THEN
      BEGIN
      rootSei _ 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[]];
      UnionConstruct[TreeOps.GetNode[t2], rootSei, @offset];
      END;
    IF cd.remaining # 0 THEN SIGNAL ConstructionError;
    cd _ saveCd;
    END;


  New: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN
    long: BOOLEAN = tb[node].attr2;
    counted: BOOLEAN = tb[node].attr3;
    pLength: CARDINAL = WordsForType[tb[node].info];
    typeTree: Tree.Link = tb[node].son[2];
    overType: SEIndex = P5U.TypeForTree[typeTree];
    type: CSEIndex = UnderType[overType];
    catchTree: Tree.Link = IF tb[node].nSons = 4 THEN tb[node].son[4] ELSE Tree.Null;
    tag: ISEIndex _ ISENull;
    seqLength: VarComponent;
    computedType: BOOLEAN = (TreeOps.OpName[typeTree] = apply);
    sizePusher: PROC = IF computedType THEN PushNewSize ELSE NIL;

    PushNewSize: PROC =
      BEGIN
      nw: CARDINAL = WordsForType[type];
      IF computedType THEN
	BEGIN
	subNode: Tree.Index = TreeOps.GetNode[typeTree];
	vSei: ISEIndex = VariantField[type];
	bitsPerItem, n: CARDINAL;
	IF vSei # ISENull THEN
	  BEGIN
	  vType: CSEIndex = UnderType[seb[vSei].idType];
	  WITH v: seb[vType] SELECT FROM
	    sequence =>
	      BEGIN
	      tag _ IF v.controlled THEN v.tagSei ELSE ISENull;
	      bitsPerItem _ BitsPerElement[v.componentType, v.packed];
	      END;
	    ENDCASE => ERROR;
	  END
	ELSE
	  BEGIN  -- must be StringBody, fudge it
	  tag _ NextSe[FirstCtxSe[seb[LOOPHOLE[type, RecordSEIndex]].fieldCtx]];
	  bitsPerItem _ charlength;
	  END;
	seqLength _ P5L.ComponentForLex[P5.Exp[tb[subNode].son[2]]];
	IF tag # ISENull THEN seqLength _ P5L.EasilyLoadable[seqLength, load];
	IF bitsPerItem >= wordlength THEN
	  BEGIN
	  n _ bitsPerItem/wordlength;
	  WITH s: seqLength SELECT FROM
	    const => P5U.PushLitVal[nw + n*s.d1];
	    ENDCASE =>
	      BEGIN
	      P5L.LoadComponent[seqLength];
	      IF n # 1 THEN {P5U.PushLitVal[n];  P5U.Out0[FOpCodes.qMUL]};
	      P5U.PushLitVal[nw];  P5U.Out0[FOpCodes.qADD];
	      END;
	  END
	ELSE
	  BEGIN
	  n _ wordlength/bitsPerItem;
	  WITH s: seqLength SELECT FROM
	    const => P5U.PushLitVal[nw + ((s.d1+(n-1))/n)];
	    ENDCASE =>
	      BEGIN
	      P5L.LoadComponent[seqLength];
	      P5U.PushLitVal[n-1];  P5U.Out0[FOpCodes.qADD];
	      P5U.PushLitVal[SELECT n FROM 2 => -1, 4 => -2, 8 => -3, ENDCASE => -4];
	      P5U.Out0[FOpCodes.qSHIFT];
	      P5U.PushLitVal[nw];  P5U.Out0[FOpCodes.qADD];
	      END;
	  END;
	END
      ELSE P5U.PushLitVal[nw];
      END;

    zoneTree: Tree.Link = tb[node].son[1];
    initTree: Tree.Link;

    saveCd: ConsDestination = cd;
    cd _ [options: [init: TRUE, counted: counted], ignoreSafen: FALSE];  -- + defaults
    cd.remaining _ 1;
    tb[node].son[3] _ CountDups[tb[node].son[3]];
    
    IF counted THEN
      Counting.Allocate[zone: zoneTree, type: overType, catch: catchTree, pushSize: sizePusher]
    ELSE
      BEGIN
      P5.ZoneOp[zone: zoneTree, index: 0, pushArg: PushNewSize, catch: catchTree, long: long];
      Stack.Incr[pLength];
      END;
    IF tag # ISENull OR tb[node].son[3] # Tree.Null THEN
      BEGIN
      ptrVar: VarIndex;
      ptrVar _ P5L.TOSAddrLex[size: WordsForType[type], long: long].lexbdoi;
      [] _ SetConsDest[ptrVar];
      IF tag # ISENull THEN
	BEGIN
	offset:  VarComponent _ P5L.ComponentForSE[tag];
	WITH o: offset SELECT FROM
	  frame => ConsAssign[typeANY, @o, Tree.Null, [bdo[P5L.OVarItem[seqLength]]]];
	  ENDCASE => ERROR;
	END;
      IF tb[node].son[3] # Tree.Null THEN
	BEGIN
	offset:  frame VarComponent _ [wSize: cd.wSize, bSize: cd.bSize, space: frame[]];
	initTree _ tb[node].son[3];
	DO
	  SELECT TreeOps.OpName[initTree] FROM
	    pad =>
	      BEGIN
	      initTree _ TreeOps.NthSon[initTree, 1];
	      offset.wSize _ P5U.WordsForOperand[initTree];  offset.bSize _ 0;
	      END;
	    cast => initTree _ TreeOps.NthSon[initTree, 1];
	    ENDCASE => EXIT;
	  ENDLOOP;
	SELECT TreeOps.OpName[initTree] FROM
	  construct =>
	    MainConstruct[TreeOps.NthSon[initTree, 2], P5U.OperandType[initTree],
		P5U.FieldAddress, @offset];
	  rowcons => Row[TreeOps.GetNode[initTree], @offset];
	  all => [] _ AllConstruct[TreeOps.GetNode[initTree], @offset];
	  mwconst => ConstantFill[type, @offset, initTree];
	  ENDCASE => {ConstructCountDown[]; ConsAssign[type, @offset, initTree]};
	END;
      IF cd.remaining # 1 THEN SIGNAL ConstructionError;
      [] _ LoadPointer[0];
      END;
    cd _ saveCd;
    RETURN [P5L.TOSLex[pLength]]
    END;
    
  END.