-- Store.mesa, modified by Sweet, January 9, 1980  9:34 PM

DIRECTORY
  AltoDefs: FROM "altodefs" USING [BYTE, charlength, wordlength],
  Code: FROM "code" USING [fileindex, xtracting, xtractlex, xtractsei],
  CodeDefs: FROM "codedefs" USING [
    BoVarIndex, Lexeme, NullLex, VarComponent, VarIndex, VarNull],
  FOpCodes: FROM "fopcodes" USING [qFREE, qLI, qPSD, qSL],
  Literals: FROM "literals" USING [ltType, MSTIndex, stType],
  P5: FROM "p5" USING [
    All, AllExp, Construct, ConstructExp, Exp, FreeTempSei, GenStringBodyLex,
    LogHeapFree, PushLProcDesc, PushNonnestedProcDesc, RowCons, RowConsExp, 
    VariantConstruct],
  P5L: FROM "p5l" USING [
    AdjustComponent, ComponentForSE, CopyToTemp, EasilyLoadable, EasyToLoad, 
    FieldOfComponent, FieldOfVar, GenVarItem, LoadAddress, LoadComponent, 
    MakeBo, ModComponent, OVarItem, ReleaseVarItem, StoreComponent, 
    TOSComponent, TOSLex, VarForLex, VarVarAssign],
  P5S: FROM "p5s",
  P5U: FROM "p5u" USING [
    BitsForOperand, FieldAddress, LongTreeAddress, NextVar, OperandType, Out0, 
    Out1, PrevVar, PushLitVal, TreeLiteralValue, WordAligned],
  Stack: FROM "stack" USING [Dup, Pop],
  SymbolOps: FROM "symbolops" USING [FnField, NextSe],
  Symbols: FROM "symbols" USING [
    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, Null, treeType],
  TreeOps: FROM "treeops" USING [ReverseUpdateList, ScanList, TestTree];

Store: PROGRAM
    IMPORTS CPtr: Code, P5U, P5L, P5, Stack, SymbolOps, TreeOps
    EXPORTS CodeDefs, P5, P5S
    SHARES Literals =
  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;

  MSTIndex: TYPE = Literals.MSTIndex;

  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)

  StoreNotify: 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;

  Extract: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN
    t1: Tree.Link = tb[node].son[1];
    tsei: RecordSEIndex _ LOOPHOLE[P5U.OperandType[t1]];
    r: VarIndex;
    transferrec: BOOLEAN _ FALSE;
    r _ P5L.VarForLex[P5.Exp[tb[node].son[2]
	!P5.LogHeapFree =>
	  IF calltree = tb[node].son[2] THEN
	    BEGIN transferrec _ TRUE; RESUME[TRUE, NullLex] END]];
    ExtractFrom[t1, tsei, r, transferrec];
    RETURN
    END;


  ExtractFrom: PUBLIC PROCEDURE [
      t1: Tree.Link, tsei: RecordSEIndex, r: VarIndex, transferrec: BOOLEAN] =
    BEGIN
    saveExtractState: RECORD [
      xtracting: BOOLEAN, xtractlex: Lexeme, xtractsei: Symbols.ISEIndex] _
	[CPtr.xtracting, CPtr.xtractlex, CPtr.xtractsei];
    fa: PROCEDURE[ISEIndex] RETURNS [BitAddress, CARDINAL] _ 
	IF seb[tsei].argument THEN FnField ELSE P5U.FieldAddress;
    startsei: ISEIndex _ ctxb[seb[tsei].fieldCtx].seList;
    sei: ISEIndex _ startsei;
    isei: ISEIndex _ startsei;
    soncount: CARDINAL _ 0;
    tbase, toffset: VarComponent;
    onStack, useDup: BOOLEAN _ FALSE;
    xlist: Tree.Link;
    node: Tree.Index;
    totalBits: CARDINAL;
    trashOnStack: CARDINAL _ 0;

    xcount: PROCEDURE [t: Tree.Link] =
      BEGIN
      IF t # Tree.Null THEN
	soncount _ soncount+1;
      RETURN
      END;
    sextract: PROCEDURE [t: Tree.Link]  RETURNS [v: Tree.Link] =
      BEGIN
      posn: BitAddress;
      size: CARDINAL;
      rr: VarIndex;
      offset, base: VarComponent;

      v _ t;
      [posn, size] _ fa[sei];
      IF t # Tree.Null THEN
	BEGIN
	soncount _ soncount-1;
        IF onStack THEN
	  BEGIN
	  offset _ toffset; -- original record on stack
	  END
	ELSE
	  BEGIN
	  IF useDup THEN
	    BEGIN
	    IF (transferrec OR soncount > 0) THEN Stack.Dup[load: FALSE];
	    base _ P5L.TOSComponent[1];
	    END
	  ELSE base _ tbase;
	  offset _ toffset;
	  END;
        P5L.FieldOfComponent[
	  var: @offset, wd: posn.wd, bd: posn.bd,
	  wSize: size/wordlength, bSize: size MOD wordlength];
	IF fa # FnField AND totalBits <= wordlength THEN
	  P5L.AdjustComponent[var: @offset, rSei: tsei, 
	    fSei: sei, tBits: totalBits];
	IF onStack THEN rr _ P5L.OVarItem[offset]
	ELSE
	  BEGIN
	  rr _ P5L.GenVarItem[bo];
	  cb[rr] _ [body: bo[base: base, offset: offset]];
	  END;
	CPtr.xtractlex _ [bdo[rr]];
	CPtr.xtractsei _ sei;
        WITH t SELECT FROM
	  subtree =>
	    BEGIN
	    node: Tree.Index = index;
	    SELECT tb[node].name FROM
	      assign => Assign[node];
	      extract => Extract[node];
	      ENDCASE => ERROR;
	    END;
	  ENDCASE => ERROR;
	END
      ELSE IF onStack THEN Stack.Pop[size/wordlength];
      sei _ P5U.PrevVar[startsei, sei];
      RETURN
      END; -- of sextract

    WITH t1 SELECT FROM
      subtree =>
	BEGIN
	node _ index;
	xlist _ tb[node].son[1];
	END;
      ENDCASE => ERROR;

    UNTIL (isei _ NextSe[sei]) = ISENull DO
      isei _ P5U.NextVar[isei];
      IF isei = ISENull THEN EXIT;
      sei _ isei;
      ENDLOOP;
    WITH cc: cb[r] SELECT FROM
      o => WITH vv: cc.var SELECT FROM
	stack =>
	  IF P5U.WordAligned[tsei] THEN
	    BEGIN
	    trashOnStack _ vv.wd;
	    vv.wd _ 0;
	    toffset _ cc.var; 
	    IF trashOnStack # 0 THEN
	      P5L.ModComponent[var: @toffset, wd: trashOnStack];
            P5L.ReleaseVarItem[r];
	    onStack _ TRUE;
	    END
	  ELSE
	    BEGIN -- copy whole thing to temp
	    var: VarComponent _ P5L.CopyToTemp[r].var;
	    r _ P5L.OVarItem[var];
	    END;
	ENDCASE;
      ENDCASE;
    IF ~onStack THEN
      BEGIN
      bor: BoVarIndex _ P5L.MakeBo[r];
      IF bor = VarNull THEN -- not addressable
	BEGIN -- r was not freed in this case
	var: VarComponent _ P5L.CopyToTemp[r].var;
	r _ P5L.OVarItem[var];
	bor _ P5L.MakeBo[r]; -- it will work this time
        END;
      tbase _ cb[bor].base; toffset _ cb[bor].offset;
      P5L.ReleaseVarItem[bor];
      IF tbase.wSize > 1 THEN tbase _ P5L.EasilyLoadable[tbase, store]
      ELSE IF ~P5L.EasyToLoad[tbase, store] THEN
	BEGIN
	P5L.LoadComponent[tbase];
	useDup _ TRUE;
	END;
      END;
    totalBits _ toffset.wSize * wordlength + toffset.bSize;
    TreeOps.ScanList[xlist, xcount];
    IF soncount = 0 THEN
      BEGIN
      IF onStack THEN
	trashOnStack _ trashOnStack + (totalBits+wordlength-1) / wordlength;
      END
    ELSE
      BEGIN
      CPtr.xtracting _ TRUE;
      tb[node].son[1] _ TreeOps.ReverseUpdateList[xlist, sextract];
      END;
    IF transferrec THEN
      BEGIN
      IF ~useDup THEN P5L.LoadComponent[tbase];
      P5U.Out0[FOpCodes.qFREE];
      END;
    THROUGH [0..trashOnStack) DO Stack.Pop[] ENDLOOP;
    [CPtr.xtracting, CPtr.xtractlex, CPtr.xtractsei] _ saveExtractState;
    RETURN
    END;

  SAssign: PUBLIC PROCEDURE [sei: ISEIndex] =
    BEGIN -- assigns to a simple variable from the stack
    var: VarComponent = P5L.ComponentForSE[sei];
    P5L.StoreComponent[var];
    RETURN
    END;


  Assign: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN -- generates code for assignment statement
    IF tb[node].attr1 AND TreeOps.TestTree[tb[node].son[2], union] THEN
      BEGIN 
      P5.VariantConstruct[node];
      RETURN
      END;
    [] _ ComAssign[tb[node].son[1], tb[node].son[2], FALSE];
    RETURN
    END;


  AssignExp: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [l: Lexeme] =
    BEGIN -- generates code for assignment expression

    l _ ComAssign[tb[node].son[1], tb[node].son[2], TRUE];
    END;

  TTAssign: PUBLIC PROCEDURE [t1, t2: Tree.Link] =
    BEGIN
    [] _ ComAssign[t1, t2, FALSE];
    END;

  ComAssign: PROCEDURE [t1,t2: Tree.Link, isexp: BOOLEAN] RETURNS [l: Lexeme] =
    BEGIN
    nbits: CARDINAL;
    node: Tree.Index;
    longAddressLhs: BOOLEAN _ P5U.LongTreeAddress[t1];
    aligned: BOOLEAN _ FALSE;
    lv, rv: VarIndex;

    l _ NullLex;
    nbits _ P5U.BitsForOperand[t1];
    IF t2 # Tree.Null THEN WITH t2 SELECT FROM
      subtree =>
	BEGIN
	node _ index;
	SELECT tb[node].name FROM
	  pad =>
	    BEGIN
	    t2 _ tb[node].son[1];
	    nbits _ P5U.BitsForOperand[t2];
	    aligned _ TRUE;
	    END;
	  ENDCASE;
	END;
      ENDCASE;
    IF t2 # Tree.Null THEN 
      WITH t2 SELECT FROM
        subtree =>
          BEGIN
          node _ index;
          SELECT tb[node].name FROM
            construct => IF ~longAddressLhs THEN
              BEGIN
              IF isexp THEN l _ P5.ConstructExp[t1, node]
              ELSE P5.Construct[t1, node];
              RETURN
              END;
            rowcons => IF ~longAddressLhs THEN
              BEGIN
              IF isexp THEN l _ P5.RowConsExp[t1, node]
              ELSE P5.RowCons[t1, node];
              RETURN
              END;
            all =>
              BEGIN
              IF isexp THEN l _ P5.AllExp[t1, node]
              ELSE P5.All[t1, node];
              RETURN
              END;
            ENDCASE;
          END;
        ENDCASE;
    rv _ P5L.VarForLex[P5.Exp[t2]];
    lv _ P5L.VarForLex[P5.Exp[t1]];
    IF aligned THEN
      P5L.FieldOfVar[r: lv,
	wSize: nbits/wordlength,
	bSize: nbits MOD wordlength];
    l _ P5L.VarVarAssign[lv, rv, isexp];
    RETURN
    END;

  ReleaseLex: PROCEDURE[l: Lexeme] =
    BEGIN
    WITH l SELECT FROM
      bdo => P5L.ReleaseVarItem[lexbdoi];
      ENDCASE;
    RETURN
    END;

  TLLAssign: PUBLIC PROCEDURE [leftson: Tree.Link, leftlex, l: Lexeme, exp: BOOLEAN, nbits: CARDINAL] =
    BEGIN -- main subroutine for doing assignment statements and expressions
    OPEN FOpCodes;
    rightr, leftr: VarIndex;

    rightr _ P5L.VarForLex[l];
    IF leftson # Tree.Null THEN leftlex _ P5.Exp[leftson];
    leftr _ P5L.VarForLex[leftlex];
    [] _ P5L.VarVarAssign[leftr, rightr, exp];
    RETURN
    END;


  SLAssign: PUBLIC PROCEDURE [sei: ISEIndex, l: Lexeme, exp: BOOLEAN, nwords: CARDINAL] =
    BEGIN -- sei-lexeme interface to tllCassign
    TLLAssign[Tree.Null, [se[sei]], l, exp, nwords*wordlength];
    RETURN
    END;


  PortInit: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN
    P5U.Out1[FOpCodes.qLI, 0];
    P5U.Out1[FOpCodes.qLI, 0];
    RETURN[P5L.TOSLex[2]]
    END;


  BodyInit: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN -- assigns proc. desc for proc. variable
    bti: CBTIndex _ tb[node].info;

    WITH bb[bti].info SELECT FROM
      Internal => CPtr.fileindex _ sourceIndex;
      ENDCASE;
    P5.PushLProcDesc[bti];
    RETURN [P5L.TOSLex[1]]
    END;


  StringInit: PUBLIC PROCEDURE [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN -- inits string storage and pushes pointer on stack
    nchars: CARDINAL;
    l: se Lexeme;

    nchars _ P5U.TreeLiteralValue[tb[node].son[2]];
    l _ P5.GenStringBodyLex[nchars];
    [] _ P5L.LoadAddress[P5L.VarForLex[l]];
    P5.FreeTempSei[l.lexsei];
    P5U.PushLitVal[0];
    P5U.PushLitVal[nchars];
    P5U.Out1[FOpCodes.qPSD, 0];
    RETURN [P5L.TOSLex[1]]
    END;


  ProcInit: PUBLIC PROCEDURE [node: Tree.Index] =
    BEGIN
    bti: CBTIndex _ tb[node].info;

    WITH bb[bti] SELECT FROM
      Inner =>
	BEGIN
	P5.PushNonnestedProcDesc[entryIndex];
	P5U.Out1[FOpCodes.qSL, frameOffset];
	END;
      ENDCASE;
    RETURN
    END;

  END...