-- file CountingImpl.Mesa
-- last edited by Satterthwaite, May 11, 1983 9:31 am
-- last change by Russ Atkinson, October 11, 1980  2:12 PM

DIRECTORY
  Alloc: TYPE USING [Notifier],
  CodeDefs: TYPE USING [
    Base, BoVarIndex, BYTE, codeType, JumpType, LabelCCIndex, Lexeme, NullLex,
    StoreOptions, VarComponent, VarIndex, VarNull],
  ComData: TYPE USING [switches, typeRefANY],
  Counting: TYPE USING [],
  FOpCodes: TYPE USING [
    qBLZL, qDUP, qKFCB, qLP, qNILCKL, qRL, qRD, qREC, qSFC, qSUB,
    qWCDL, qWCIDL],
  P5: TYPE USING [CallCatch, Exp, GenTempLex, PushLex, PushRhs, SAssign, SysCall],
  P5L: TYPE USING [
    AllLoaded, CopyToTemp, CopyVarItem, EasilyLoadable, InCode, GenAdd, LoadAddress,
    LoadComponent, LoadVar, MakeBo, OVarItem, ReleaseVarItem, ReusableCopies,
    StoreVar, TOSAddrLex, VarAlignment, VarVarAssign, VarForLex, Words],
  P5U: TYPE USING [
    InsertLabel, LabelAlloc, Out0, Out1, OutJump, PushLitVal, TreeLiteral, WordsForSei],
  RTSD: TYPE USING [sAssignComposite, sAssignCompositeNew, SD, sSystemZone],
  Stack: TYPE USING [Decr, DeleteToMark, Dump, Incr, Load, Mark, TempStore, Top],
  SymbolOps: TYPE USING [
    FirstCtxSe, NextSe, RCType, TypeRoot, UnderType, WordsForType],
  Symbols: TYPE USING [
    Base, CSEIndex, ISEIndex, lZ, RecordSEIndex, RefClass, SEIndex, seType],
  SymLiteralOps: TYPE USING [TypeRef],
  Tree: TYPE USING [Link, Null],
  TreeOps: TYPE USING [FreeTree, ScanList];

CountingImpl: PROGRAM
    IMPORTS MPtr: ComData, P5, P5L, P5U, Stack, SymbolOps, SymLiteralOps, TreeOps
    EXPORTS Counting, CodeDefs = {
  OPEN CodeDefs, Counting, Symbols;


  seb: Symbols.Base;		-- se base (local copy)
  cb: CodeDefs.Base;		-- code base (local copy)

  CountingNotify: PUBLIC Alloc.Notifier = {
    -- called by allocator whenever table area is repacked
    seb ← base[seType]; cb ← base[codeType]};


  CheckArgRefs: PUBLIC PROC [t: Tree.Link, rsei: RecordSEIndex] RETURNS [safe: BOOL←TRUE] =
    BEGIN
    IF seb[rsei].hints.refField THEN
      BEGIN
      sei: ISEIndex ← SymbolOps.FirstCtxSe[seb[rsei].fieldCtx];
      
      TestField: PROC [t: Tree.Link] =
        BEGIN
        IF SymbolOps.RCType[SymbolOps.UnderType[seb[sei].idType]] # none
         AND ~P5U.TreeLiteral[t] THEN
          safe ← FALSE;
        sei ← SymbolOps.NextSe[sei];
        END;
        
      TreeOps.ScanList[t, TestField];
      END;
    RETURN
    END;
    
 
  Allocate: PUBLIC PROC [
      zone: Tree.Link, type: SEIndex, catch: Tree.Link, pushSize: PROC] = {

    -- Allocate generates code for space allocation from counted zones

    -- first, generate code to perform the allocation
    nwords: CARDINAL = SymbolOps.WordsForType[type];
    sizeVar: VarIndex ← VarNull;
    zoneVar, copyVar: VarIndex;
    topVar:  VarIndex ← VarNull;
    initRC: RefClass = SymbolOps.RCType[SymbolOps.UnderType[type]];
    typeTree: Tree.Link ← SymLiteralOps.TypeRef[SymbolOps.TypeRoot[type], FALSE];
    Stack.Dump[];  Stack.Mark[];
    IF zone = Tree.Null THEN LoadSystemZone[]
    ELSE {
      zoneVar ← P5L.VarForLex[P5.Exp[zone]];
      [first: zoneVar, next: copyVar] ← P5L.ReusableCopies[zoneVar, load, FALSE];
      P5L.LoadVar[zoneVar]};
    IF pushSize # NIL THEN {
      pushSize[];                            -- (must save it for later) 
      P5U.Out0[FOpCodes.qDUP];  sizeVar ← StackTemp[1]}
    ELSE P5U.PushLitVal[nwords];
    P5.PushRhs[typeTree]; typeTree ← TreeOps.FreeTree[typeTree];
    IF zone = Tree.Null THEN LoadSystemZone[]
    ELSE {
      P5L.LoadVar[copyVar];
      IF ~MPtr.switches['a] THEN P5U.Out0[FOpCodes.qNILCKL]};
    P5U.Out1[FOpCodes.qRL, 0];
    Stack.DeleteToMark[];  Stack.Incr[1];  P5U.Out0[FOpCodes.qSFC];
    P5.CallCatch[catch];
    Stack.Incr[2];

    -- if size is in a variable and we are RC, then clear the world to NIL
    IF initRC # none AND pushSize # NIL THEN {
      IF nwords = 0 OR sizeVar = VarNull THEN ERROR;
      CopyLoad[sizeVar]; P5U.Out0[FOpCodes.qBLZL]}};


  Free: PUBLIC PROC [var: VarIndex, counted: BOOL, zone, catch: Tree.Link] = {
    -- emit code for zone.FREE[@ var ! catch]
    c0: VarIndex ← P5L.OVarItem[[wSize: 2, space: const[d1:0, d2:0]]];
    bor: BoVarIndex ← P5L.MakeBo[var];
    rr, zoneVar, copyVar: VarIndex;
    cb[bor].base ← P5L.EasilyLoadable[cb[bor].base, load];
    rr ← P5L.CopyVarItem[bor];
    Stack.Dump[];  Stack.Mark[];
    IF zone = Tree.Null THEN LoadSystemZone[]
    ELSE {
      zoneVar ← P5L.VarForLex[P5.Exp[zone]];
      [first: zoneVar, next: copyVar] ← P5L.ReusableCopies[zoneVar, load, FALSE];
      P5L.LoadVar[zoneVar]};
    P5L.LoadVar[bor];
    IF counted THEN [] ← VarVarAssignCounted[rr, c0, [counted: TRUE], MPtr.typeRefANY]
    ELSE [] ← P5L.VarVarAssign[rr, c0, FALSE];
    IF zone = Tree.Null THEN LoadSystemZone[]
    ELSE {
      P5L.LoadVar[copyVar];
      IF ~MPtr.switches['a] THEN P5U.Out0[FOpCodes.qNILCKL]};
    P5U.Out1[FOpCodes.qRL, 1];
    Stack.DeleteToMark[];  Stack.Incr[1];  P5U.Out0[FOpCodes.qSFC];
    P5.CallCatch[catch]};


  VarVarAssignCounted: PUBLIC PROC [
	to, from: VarIndex, options: StoreOptions, type: SEIndex]
      RETURNS [l: Lexeme ← NullLex] = {
    nWords: CARDINAL = P5U.WordsForSei[type];
    IF options.composite THEN {
      typeTree: Tree.Link ← SymLiteralOps.TypeRef[SymbolOps.UnderType[type]];
      tempVar: VarIndex;
      LoadLongVarAddress[from];
      IF options.expr THEN CopyLoad[tempVar ← StackTemp[2]];
      LoadLongAddress[to];
      P5.PushRhs[typeTree];  typeTree ← TreeOps.FreeTree[typeTree];
      P5U.PushLitVal[nWords];
      Stack.Load[Stack.Top[6], 6];  Stack.Decr[6];  -- Stack.LoadToDepth[6];
      P5U.Out1[FOpCodes.qKFCB, IF options.init THEN RTSD.sAssignCompositeNew ELSE RTSD.sAssignComposite];
      IF options.expr THEN l ← AddrVarToLex[tempVar, nWords]}
    ELSE {
      IF nWords # 2 THEN ERROR; -- somebody goofed!
      IF options.expr THEN {
        v: VarIndex;
        P5L.LoadVar[from];
        v ← StackTemp[2]; CopyLoad[v];
        l ← [bdo[v]]}
      ELSE {
        IF ~StackVar[from, nWords]
         OR ~P5L.AllLoaded[from] THEN P5L.LoadVar[from]};  -- anything above it is part of "to"
      StoreVarCounted[to, options]};
    RETURN};


  StoreVarCounted: PROC [r: VarIndex, options: StoreOptions] = {
    WCDOp: ARRAY BOOL OF CodeDefs.BYTE = [
      FALSE: FOpCodes.qWCDL, TRUE: FOpCodes.qWCIDL];
    alpha: CARDINAL ← 0;
    WITH cc: cb[r] SELECT FROM
      bo => {
	offset: VarComponent = cc.offset;
	WITH oo: offset SELECT FROM
	  frame =>
	    IF oo.level = Symbols.lZ AND oo.wSize = 2 AND oo.bSize = 0 AND oo.bd = 0 THEN {
	      P5L.LoadComponent[cc.base];
	      SELECT P5L.Words[cc.base.wSize, cc.base.bSize] FROM
		1 => P5U.Out0[FOpCodes.qLP];
		2 => NULL;
		ENDCASE => ERROR;
	      alpha ← oo.wd;
	      P5L.ReleaseVarItem[r]}
	    ELSE LoadLongAddress[r];
	  ENDCASE => LoadLongAddress[r]};
      ENDCASE => LoadLongAddress[r];
    Stack.Load[Stack.Top[4], 4];  -- REF + nWords
    P5U.Out1[WCDOp[options.init], alpha]};
    
  FillCounted: PUBLIC PROC [
      space, source: VarIndex, options: StoreOptions, type: Symbols.SEIndex] = {
    subType: CSEIndex = SymbolOps.UnderType[type];
    wordsPerItem: CARDINAL = SymbolOps.WordsForType[subType];
    nItems: CARDINAL = P5L.VarAlignment[space, load].wSize/wordsPerItem;
    countLex: Lexeme.se = P5.GenTempLex[1];
    ptrTemp: VarIndex;
    loopLabel: CodeDefs.LabelCCIndex = P5U.LabelAlloc[];
    testLabel: LabelCCIndex = P5U.LabelAlloc[];
    LoadLongAddress[space];  ptrTemp ← StackTemp[2];
    Stack.Dump[];
    P5U.PushLitVal[nItems];  Stack.Decr[1];
    P5U.OutJump[Jump, testLabel];
    P5U.InsertLabel[loopLabel];              -- top of the assignment loop
    IF SymbolOps.RCType[subType] = composite THEN {
      typeTree: Tree.Link ← SymLiteralOps.TypeRef[subType];
      Stack.Mark[];
      LoadLongVarAddress[source];
      CopyLoad[ptrTemp];
      P5.PushRhs[typeTree];  typeTree ← TreeOps.FreeTree[typeTree];
      P5U.PushLitVal[wordsPerItem];
      P5.SysCall[IF options.init THEN RTSD.sAssignCompositeNew ELSE RTSD.sAssignComposite]}
    ELSE {
      WCDOp: ARRAY BOOL OF CodeDefs.BYTE = [
        FALSE: FOpCodes.qWCDL, TRUE: FOpCodes.qWCIDL];
      P5L.LoadVar[source];
      CopyLoad[ptrTemp];
      P5U.Out1[WCDOp[options.init], 0]};
    DoubleIncr[ptrTemp, wordsPerItem];	-- update pointer
    P5L.StoreVar[ptrTemp];
    P5.PushLex[countLex];
    P5U.PushLitVal[1];
    P5U.Out0[FOpCodes.qSUB];
    P5U.InsertLabel[testLabel];
    P5.SAssign[countLex.lexsei];
    P5U.Out0[FOpCodes.qREC];
    P5U.PushLitVal[0];
    P5U.OutJump[JumpG, loopLabel]};



  LoadLongAddress: PUBLIC PROC [v: VarIndex] = {
    -- Push a LONG address for the variable
    -- NOTE: clobbers the VarItem
    IF ~P5L.LoadAddress[v] THEN P5U.Out0[FOpCodes.qLP]};

  LoadLongVarAddress: PROC [var: VarIndex] = INLINE {
    -- Push a LONG address for the var
    IF P5L.InCode[var] THEN var ← P5L.OVarItem[P5L.CopyToTemp[var].var];
    LoadLongAddress[var]};

  LoadSystemZone: PROC = {
    P5U.PushLitVal[LOOPHOLE[RTSD.SD, CARDINAL] + RTSD.sSystemZone];
    P5U.Out1[FOpCodes.qRD, 0]};

  AddrVarToLex: PROC [var: VarIndex, nwords: CARDINAL, pushOK: BOOL←TRUE]
      RETURNS [Lexeme] = {
    CopyLoad[var];
    RETURN [P5L.TOSAddrLex[nwords, TRUE]]};

  DoubleIncr: PROC [var: VarIndex, n: CARDINAL] = {
    -- load the LONG variable and increment it by n
    -- NOTE: does not clobber the var
    P5L.LoadVar[P5L.CopyVarItem[var]];
    P5L.GenAdd[n, TRUE]};

  CopyLoad: PROC [var: VarIndex] = {
    -- load the variable
    -- NOTE: does not clobber the var
    P5L.LoadVar[P5L.CopyVarItem[var]]};

  StackTemp: PROC [nwords: CARDINAL] RETURNS [VarIndex] = {
    -- make a new temporary from the top nwords of the stack
    RETURN [P5L.OVarItem[Stack.TempStore[nwords]]]};

  StackVar: PROC [var: VarIndex, nWords: CARDINAL] RETURNS [BOOL] = {
    RETURN [WITH cc: cb[var] SELECT FROM
      o =>
	WITH vv: cc.var SELECT FROM
	  stack => (vv.wd = 0 AND vv.wSize = nWords),
	  ENDCASE => FALSE,
      ENDCASE => FALSE]};

  }.