-- file Store.mesa
-- last modified by Sweet, February 25, 1981  1:49 PM
-- last modified by Satterthwaite, November 23, 1982 5:17 pm

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],
  ComData: TYPE USING [switches],
  Counting: TYPE USING [VarVarAssignCounted],
  Environment: TYPE USING [bitsPerWord],
  FOpCodes: TYPE USING [qBLZL, qDESCB, qFREE, 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, PushLitVal,
    PrevVar, 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, ListLength, NthSon, ReverseUpdateList, ScanList];

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

  -- imported definitions

  wordlength: CARDINAL = Environment.bitsPerWord;

  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 ((	-- some heuristics
	   ~longAddressLhs OR nbits > 20*wordlength OR 
	   TreeOps.ListLength[TreeOps.NthSon[t2, 2]] <= 4) AND ~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 (~longAddressLhs AND ~ManySafens[t2, nbits]) THEN
	  BEGIN
	  l ← P5.RowCons[t1, TreeOps.GetNode[t2], options];
	  RETURN
	  END
	ELSE IF nbits > 2*wordlength THEN
	  BEGIN
	  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 MPtr.switches['m]
         AND 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.expr ← options.counted ← 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 => BEGIN noAll ← FALSE; CountSafens[TreeOps.NthSon[t, 1]] END;
        cast, pad => CountSafens[TreeOps.NthSon[t, 1]];
        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.qFREE];
      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.qDESCB, body.entryIndex];
	P5U.Out1[FOpCodes.qSL, body.frameOffset];
	END;
      ENDCASE;
    END;


  END.