-- file Store.mesa
-- last modified by Sweet, 14-Dec-81 10:38:19
-- last modified by Satterthwaite, December 16, 1982 11:12 am

DIRECTORY
  Alloc: TYPE USING [Notifier],
  Code: TYPE USING [fileindex, tailJumpOK, xtracting, xtractlex, xtractsei],
  CodeDefs: TYPE USING [
    Base, BoVarIndex, codeType, Lexeme, NullLex, StoreOptions,
    VarComponent, VarIndex, VarNull, wordlength],
  Counting: TYPE USING [VarVarAssignCounted],
  FOpCodes: TYPE USING [qBLZL, qDB, qFF, qLP, qSL],
  P5: TYPE USING [
    All, Construct, Exp, GenTempLex, LogHeapFree, MultiZero, PushLProcDesc,
    RowCons, VariantConstruct],
  P5L: TYPE USING [
    AdjustComponent, ComponentForSE, CopyToTemp, EasilyLoadable, EasyToLoad, 
    FieldOfComponent, FieldOfVar, GenVarItem, LoadAddress, LoadComponent,
    LoadVar, MakeBo, ModComponent, OVarItem, ReleaseVarItem, ReusableCopies, 
    StoreComponent, TOSAddrLex, TOSComponent, TOSLex, VarForLex, VarVarAssign,
    Words],
  P5S: TYPE USING [],
  P5U: TYPE USING [
    BitsForOperand, LongTreeAddress, NextVar, OperandType, Out0, Out1,
    PrevVar, PushLitVal, WordAligned],
  Stack: TYPE USING [Clear, Dup, Pop],
  SymbolOps: TYPE USING [FirstCtxSe, FnField, NextSe, RecField],
  Symbols: TYPE USING [
    Base, BitAddress, bodyType, CBTIndex, ContextLevel, ISEIndex, ISENull, lG,
    RecordSEIndex, seType],
  Tree: TYPE USING [Base, Index, Link, Null, treeType],
  TreeOps: TYPE USING [GetNode, OpName, NthSon, ReverseUpdateList, ScanList];

Store: PROGRAM
    IMPORTS
      CPtr: Code, Counting, P5U, P5L, P5, Stack, SymbolOps, TreeOps
    EXPORTS CodeDefs, P5, P5S =
  BEGIN
  OPEN CodeDefs, SymbolOps;

  -- imported definitions

  BitAddress: TYPE = Symbols.BitAddress;
  CBTIndex: TYPE = Symbols.CBTIndex;
  ISEIndex: TYPE = Symbols.ISEIndex;
  ISENull: ISEIndex = Symbols.ISENull;
  lG: Symbols.ContextLevel = Symbols.lG;
  RecordSEIndex: TYPE = Symbols.RecordSEIndex;

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

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


  Assign: PUBLIC PROC [node: Tree.Index] =
    BEGIN -- generates code for assignment statement (RRA)
    [] _ ComAssign[
	t1: tb[node].son[1], t2: tb[node].son[2],
	options: [expr: FALSE, init: tb[node].attr1,
		  counted: tb[node].attr2,  composite: tb[node].attr3]];
    END;

  AssignExp: PUBLIC PROC [node: Tree.Index] RETURNS [l: Lexeme] =
    BEGIN -- generates code for assignment expression (RRA)
    l _ ComAssign[
	t1: tb[node].son[1], t2: tb[node].son[2],
	options: [expr: TRUE, init: tb[node].attr1,
		  counted: tb[node].attr2,  composite: tb[node].attr3]];
    RETURN
    END;


  ComAssign: PROC [t1, t2: Tree.Link, options: StoreOptions] RETURNS [l: Lexeme] =
    BEGIN -- can support counted assignments (RRA)
    nbits: CARDINAL;
    longAddressLhs: BOOL _ P5U.LongTreeAddress[t1];
    aligned: BOOL _ FALSE;
    lv, rv: VarIndex;
    l _ NullLex;
    nbits _ P5U.BitsForOperand[t1];
    DO  -- until we get to something interesting
      SELECT TreeOps.OpName[t2] FROM
	pad =>
	  BEGIN
	  t2 _ TreeOps.NthSon[t2, 1];
	  aligned _ TRUE;  nbits _ P5U.BitsForOperand[t2];
	  END;
	cast, safen => t2 _ TreeOps.NthSon[t2, 1];
	ENDCASE => EXIT;
      ENDLOOP;
    SELECT TreeOps.OpName[t2] FROM
      construct =>
	IF options.counted OR ~ManySafens[t2, nbits] THEN
	  BEGIN
	  l _ P5.Construct[t1, TreeOps.GetNode[t2], options];
	  RETURN
	  END
	ELSE IF nbits > 2*wordlength THEN
	  BEGIN --otherwise fall through into building on stack
	  tlex: Lexeme.se = P5.GenTempLex[(nbits+wordlength-1) / wordlength];
	  [] _ P5.Construct[[symbol[tlex.lexsei]], TreeOps.GetNode[t2], TempOptions[options]];
	  t2 _ [symbol[tlex.lexsei]];
	  END;
      union => IF ~options.expr THEN {P5.VariantConstruct[t1, t2, options]; RETURN};
      rowcons =>
	IF options.counted OR ~ManySafens[t2, nbits] THEN
	  BEGIN
	  l _ P5.RowCons[t1, TreeOps.GetNode[t2], options];
	  RETURN
	  END
	ELSE IF nbits > 2*wordlength THEN
	  BEGIN --otherwise fall through into building on stack
	  tlex: Lexeme.se = P5.GenTempLex[(nbits+wordlength-1) / wordlength];
	  [] _ P5.RowCons[[symbol[tlex.lexsei]], TreeOps.GetNode[t2], TempOptions[options]];
	  t2 _ [symbol[tlex.lexsei]];
	  END;
      all =>
	BEGIN
	l _ P5.All[t1, TreeOps.GetNode[t2], options];
	RETURN
	END;
      mwconst =>
        IF P5.MultiZero[t2] AND (options.init OR ~options.counted) THEN
          BEGIN
          nw: CARDINAL = P5L.Words[w: 0, b: nbits];
          lv _ P5L.VarForLex[P5.Exp[t1]];
          IF ~P5L.LoadAddress[lv] THEN P5U.Out0[FOpCodes.qLP];
          P5U.PushLitVal[nw];
          P5U.Out0[FOpCodes.qBLZL];
          IF options.expr THEN l _ P5L.TOSAddrLex[nw, TRUE]
          ELSE Stack.Pop[2];
          RETURN
          END;
      ENDCASE;
    rv _ P5L.VarForLex[P5.Exp[t2]];
    IF nbits <= 2*wordlength AND ~ProbablyDumpStack[t1] THEN {
      P5L.LoadVar[rv];
      rv _ P5L.VarForLex[P5L.TOSLex[(nbits+ wordlength-1)/wordlength]]};
    lv _ P5L.VarForLex[P5.Exp[t1]];
    IF aligned THEN
      P5L.FieldOfVar[r: lv, wSize: nbits/wordlength, bSize: nbits MOD wordlength];
    IF options.counted THEN
      l _ Counting.VarVarAssignCounted[lv, rv, options, P5U.OperandType[t1]]
    ELSE  l _ P5L.VarVarAssign[lv, rv, options.expr];
    RETURN
    END;

  TempOptions: PROC [options: StoreOptions] RETURNS [StoreOptions] = {
    options.init _ TRUE;  options.counted _ options.expr _ FALSE;
    RETURN [options]};

  ManySafens: PROC [t: Tree.Link, nbits: CARDINAL] RETURNS [BOOL] =
    BEGIN
    nFields, nSafens: CARDINAL _ 0;
    noAll: BOOL _ TRUE;
    
    CountSafens: PROC [t: Tree.Link] =
      BEGIN
      SELECT TreeOps.OpName[t] FROM
        rowcons, construct, union => TreeOps.ScanList[TreeOps.NthSon[t, 2], CountSafens];
        all => noAll _ FALSE;
        cast, pad => TreeOps.ScanList[TreeOps.NthSon[t, 1], CountSafens];
        safen => BEGIN nSafens _ nSafens+1; nFields _ nFields+1 END;
        ENDCASE => nFields _ nFields+1;
      END;
      
    CountSafens[t];
    RETURN [IF nbits<16*wordlength
      THEN (nSafens >= 2)
      ELSE (noAll AND 2*nSafens > nFields)]
    END;


  Extract: PUBLIC PROC [node: Tree.Index] =
    BEGIN
    SExtract[node];
    Stack.Clear[];
    END;

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

  ExtractExp: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN
    t1: Tree.Link = tb[node].son[1];
    tsei: RecordSEIndex = LOOPHOLE[P5U.OperandType[t1]];
    r, rret: VarIndex;
    r _ P5L.VarForLex[P5.Exp[tb[node].son[2]
	  ! P5.LogHeapFree => IF calltree = tb[node].son[2] THEN RESUME[FALSE, NullLex]]];
    [first: r, next: rret] _ P5L.ReusableCopies[r, store, FALSE];
    ExtractFrom[t1, tsei, r, FALSE];
    RETURN [[bdo[rret]]]
    END;


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

    XCount: PROC [t: Tree.Link] =
      BEGIN
      IF t # Tree.Null THEN soncount _ soncount+1;
      END;

    ExtractItem: PROC [t: Tree.Link]  RETURNS [v: Tree.Link] =
      BEGIN
      posn: BitAddress;
      size: CARDINAL;
      v _ t;
      [posn, size] _ fa[sei];
      IF t # Tree.Null THEN
	BEGIN
	subNode: Tree.Index = TreeOps.GetNode[t];
	rr: VarIndex;
	offset, base: VarComponent;
	soncount _ soncount-1;
        IF onStack THEN offset _ toffset -- original record on stack
	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;
	SELECT tb[subNode].name FROM
	  assign => Assign[subNode];
	  extract => SExtract[subNode];
	  ENDCASE => ERROR;
	END
      ELSE IF onStack THEN Stack.Pop[size/wordlength];
      sei _ P5U.PrevVar[startsei, sei];
      RETURN
      END; -- of ExtractItem

    xlist: Tree.Link _ tb[node].son[1];
    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, ExtractItem];
      END;
    IF transferrec THEN
      BEGIN
      IF ~useDup THEN P5L.LoadComponent[tbase];
      P5U.Out0[FOpCodes.qFF];
      END;
    THROUGH [0..trashOnStack) DO Stack.Pop[] ENDLOOP;
    [CPtr.xtracting, CPtr.xtractlex, CPtr.xtractsei] _ saveExtractState;
    END;


  ProbablyDumpStack: PUBLIC PROC [t: Tree.Link] RETURNS [BOOL] =
    BEGIN -- only a hint
    node: Tree.Index;
    WITH t SELECT FROM
      subtree => node _ index;
      ENDCASE => RETURN [FALSE];
    RETURN [SELECT tb[node].name FROM
      loophole, pad, chop, uparrow, dot, dollar, not  => 
	ProbablyDumpStack[tb[node].son[1]],
      and, or, plus, minus, times, div, mod,
      index, dindex, seqindex =>
	ProbablyDumpStack[tb[node].son[2]] OR
	  ProbablyDumpStack[tb[node].son[1]],
      ifx =>
	ProbablyDumpStack[tb[node].son[3]] OR
	  ProbablyDumpStack[tb[node].son[2]] OR
	  ProbablyDumpStack[tb[node].son[1]],
      IN [relE..notin] =>
	ProbablyDumpStack[tb[node].son[2]] OR
	  ProbablyDumpStack[tb[node].son[1]],
      IN [callx..joinx] => TRUE,
      ENDCASE => FALSE]
    END;


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


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

  SLAssign: PUBLIC PROC [sei: ISEIndex, l: Lexeme, exp: BOOL, nwords: CARDINAL] =
    BEGIN -- obsolete?
    TLLAssign[Tree.Null, [se[sei]], l, exp, nwords*wordlength];
    END;

  TTAssign: PUBLIC PROC [t1, t2: Tree.Link] =
    BEGIN -- not called for counted assignments (RRA)
    [] _ ComAssign[t1: t1, t2: t2, options: [expr: FALSE]];
    END;

  TLLAssign: PUBLIC PROC [
      leftson: Tree.Link, leftlex, l: Lexeme, exp: BOOL, nbits: CARDINAL] =
    BEGIN -- obsolete?
    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];
    END;


  BodyInit: PUBLIC PROC [node: Tree.Index] RETURNS [Lexeme] =
    BEGIN -- assigns proc. desc for proc. variable
    bti: CBTIndex = tb[node].info;
    CPtr.fileindex _ bb[bti].sourceIndex;
    P5.PushLProcDesc[bti];
    RETURN [P5L.TOSLex[1]]
    END;


  ProcInit: PUBLIC PROC [node: Tree.Index] =
    BEGIN
    bti: CBTIndex = tb[node].info;
    WITH body: bb[bti] SELECT FROM
      Inner =>
	BEGIN
	CPtr.tailJumpOK _ FALSE;	-- conservative
	P5U.Out1[FOpCodes.qDB, body.entryIndex];
	P5U.Out1[FOpCodes.qSL, body.frameOffset];
	END;
      ENDCASE;
    END;

  END.