*-----------------------------------------------------------
Title[DMesaAlloc.mc...March 11, 1983  1:33 PM...WSH];
*-----------------------------------------------------------
** version for PILOT only
*-----------------------------------------------------------
** allocating Quantized Node
     rme[mAsz, rcv];
     rme[hcode, residue];
     rme[SzSize, entry];
     rme[szfl, oiPrev0];

** freeing Quantized Node
     rme[zoneIndex, entry];
     rme[szflLo, onStack];
     rme[szflHi, oiPrev1];

** allocating Prefixed Node
     rme[pLengthLo, rcv];
     rme[pLengthHi, residue];
     rme[pSize, entry];
     rme[pfnFirstLo, onStack];
     rme[pfnFirstHi, oiPrev1];
     rme[znpfn, oiPrev0];

** freeing Prefixed Node
     rme[pfnPrevLo, rcv];
     rme[pfnPrevHi, residue];
     rme[pfnLo, entry];
     rme[pfnHi, oiPrev0];
     rme[pfnNextLo, onStack];
     rme[pfnNextHi, oiPrev1];

   top level;
*-----------------------------------------------------------
*
* GetReferentType[ref: REF ANY] RETURNS[Type]
*-----------------------------------------------------------
GetRefType: MiscTable[71];
   Stack&-2, call[getRef];   * T has Stack-1
   Stack-1_ T, IFUNext0;

*-----------------------------------------------------------
*
* GetCanonicalReferentType[ref: REF ANY] RETURNS[Type]
*-----------------------------------------------------------
* GetCRefType: MiscTable[72],
*    Stack&-2;
*    call[getRef];   * T has Stack-1
** returns from call with pd_ T test
*    branch[.+2, alu#0], membase_ gcStateBR;
*    IFUNext0, Stack-1_ T;     * nullType
*       knowrbase[gcTemp];
*   gcTemp_ T + T + 1;
*   T_ (fetch_ MapTiTdOffset) + 1, call[loadLPtr];
*    fetch_ 0s, T_ Stack, call[checkSize];
**  MapTiTd is a SEQUENCE of LONG POINTERs
*   T_ (fetch_ gcTemp) + 1, call[loadLPtr];
*   fetch_ eqvTypeSc;
*   pd_ Md;
*    branch[.+2, alu#0];
*    branch[agcTrap], T_ 1C;     * not canonicalized yet
*   Stack-1_ Md, IFUNext0;

*-----------------------------------------------------------
*
* GetCanonicalReferentType[ref: REF ANY] RETURNS[Type]
*  canonical referenttype is now kept in (ref-1)^
*-----------------------------------------------------------
   KnowRBase[rTemp0];
GetCRefType: MiscTable[72],
   Stack&-2;
   membase_ LPtr, pd_ (Stack) OR T;
     branch[.+2, alu#0], pd_ Stack;	* Stack is refLo
   		Stack_ T, IFUNext0;		* ref was NIL => type 0
   rTemp0_ (Stack) - 1, branch[.+2, alu#0];
    T_ T - 1;		* T is refHi
   BrLo_ rTemp0;
   BrHi_ T;
   fetch_ 0s;
   rTemp0_ Md;
    branch[.+2, R<0], T_ (rTemp0) AND (37777C);	* mask for type field
   Stack_ T, IFUNext0;
   branch[cats], T_ 10C;		* referent on free list
*-----------------------------------------------------------
     subroutine;
getRef:
   rbase_ rbase[rcv];   * T has Stack-1
   pd_ (Stack) OR (Q_ T);    * Q has hi part of Pointer
    branch[.+2, alu#0], membase_ GCStateBR, T_ Stack&+1;
    T_ T - T, return;    * Pointer was NIL => type=nullType=0
   glink_ Link;
      top level;

   gcTemp2_ T;     * save ptrLo
   T_ (fetch_ MapPtrMzOffset) + 1, call[loadLPtr];

   T_ Q;
   T_ RCY[T, gctemp2, qiShift];   * quantumIndex
   gctemp_ T, fetch_ 0s, call[checkSize];
** size was OK
**  MapPtrMz is a SEQUENCE of one-word items
   T_ (gcTemp) + 1;
   fetch_ T, T_ Q;
   probe_ pd_ Md;
    branch[subzone, alu<0], pd_ gcTemp2;

*-----------------------------------------------------------
* RealZone => RETURN[(ptr-SIZE[Type])^] where SIZE[Type]=1
* ptr is in T,,gcTemp2
*-----------------------------------------------------------
   gcTemp2_ (gcTemp2) - 1, branch[.+2, alu#0];   * pd_ gcTemp2
    T_ T - 1;    * decrement hi part of ptr if low part = 0
   BrLo_ gcTemp2;
   BrHi_ T, branch[endGRT];

*-----------------------------------------------------------
* SubZone => RETURN[GetSzType[mz.szi]]
*  which is MapSziSz[SzSize lshift 1 + 1]^
*-----------------------------------------------------------
subzone:
   membase_ gcStateBR, SzSize_ Md;
   SzSize_ (SzSize) and (77777C);   * mask off hi bit so size check will work
   T_ (fetch_ MapSziSzOffset) + 1, call[loadLPtr];
    fetch_ 0s, T_ SzSize, call[checkSize];
**  MapSziSz is a SEQUENCE of LONG POINTERs
   T_ (SzSize) + (SzSize) + 1;
   T_ (fetch_ T) + 1, call[loadLPtr];
endGRT: fetch_ 0s;
   link_ gLink;
     subroutine;
   gcTemp_ Md;
    branch[.+2, R<0], T_ (gcTemp) AND (37777C);	* mask for type field
   pd_ T, return;
   branch[cats], T_ 10C;		* referent on free list

   top level;
*-----------------------------------------------------------
*
* AllocateQuantizedNode[zn:PRealZone, size: CARDINAL, t: Type]
*     RETURNS[ptr: Pointer]
*-----------------------------------------------------------
AllocQNode: MiscTable[73], Stack&-3;
  membase_ ScratchBR;
  T_ zn.LOCK, call[checkMLock];
**----------- returns with gcTemp holding the Monitor lock
 knowrbase[gcTemp];
   branch[.+2, R even], gcTemp, T_ zn.mAsz;
   branch[agcTrap], T_ 2C;    * lock was set
** we have the zone
  fetch_ T, Stack&+2;
  mAsz_ (Md) + (Md);
  mAsz_ ((mAsz) + Md) lsh 1;   * hi end of SubZoneArray
  T_ (Stack) AND Md;    * forming hash code
  hcode_ T + T;   * 2*T
  hcode_ ((hcode) + T) lsh 1;     * 6*T  --SubZoneRec is 6 words long
  T_ zn.pAsz;
  T_ (fetch_ T) + 1, call[loadBaseReg];   * overwrite current BR
**  arrive here with StkP pointing to size parameter
 aqLoop:
  T_ (sz.vacant) + (hcode);
* ScratchBR has pointer to SubZoneArray
  fetch_ T, Stack&+1;
  pd_ Md;
   branch[.+2, alu#0], T_ (fetch_ hcode) + 1;  * fetch_ ((sz.type)+(hcode))
   T_ 3C, Stack&+1, branch[agcTrap];    * vacant
  pd_ (Stack&-1) XOR Md;
   branch[.+2, alu=0], szfl_ (fetch_ T) + 1;   * fetch_ ((sz.size)+(hcode))
    pd_ hcode, branch[aqNext];    * types didn't match
  pd_ (Stack) XOR Md;
   branch[aqNext, alu#0], pd_ hcode;
**------- we have a ptr to allocate, maybe
  T_ (fetch_ szfl) + 1;   * fetch_ ((sz.fl)+(hcode))
  Fetch_ T, T_ Q_ Md;
   pd_ T OR (Md), membase_ LPtr;
    branch[.+2, alu#0], BrLo_ T, gcTemp2_ Md;   * branch if FreeList#NIL
    T_ 3C, branch[agcTrap];    * vacant
  BrHi_ gcTemp2;
** LPtr (gcTemp2,,Q) contains the Pointer to allocate
  T_ (fetch_ obj.FreeList1) - 1;
  fetch_ T, gcTemp_ Md;
**  store 0's on top of the old free list
  T_ (store_ T) + 1, dbuf_ 0C;
  T_ (store_ T) - 1, dbuf_ 0C;
** update sz.fl    ** gcTemp(Hi),,Md(Lo) is new FreeList
  membase_ ScratchBR, Stack&-1;
  T_ (store_ szfl) + 1, dbuf_ Md;
  store_ T, dbuf_ gcTemp;
  T_ gcTemp2;
  Stack&-1_ T;
  Stack&+1_ Q, IFUNext0;

 aqNext: T_ (Hcode) - (6C), branch[.+2, alu#0];
   T_ mAsz;
   hcode_ T, b_ Md, branch[aqLoop];

*-----------------------------------------------------------
*
* AllocatePrefixedNode[zn:PRealZone, size: CARDINAL, t: Type]
*     RETURNS[ptr: Pointer]
*-----------------------------------------------------------
AllocPNode: MiscTable[74], Stack&-3;
  membase_ ScratchBR;
  T_ zn.LOCK, call[checkMLock];
**----------- returns with gcTemp holding the Monitor lock
   branch[.+2, R even], gcTemp, T_ MinBlockSize;
    branch[agcTrap], T_ 2C;    * lock was set
   Stack&+2;
   branch[apn0, R EVEN], pd_ (Stack) - T;
   Stack_ (Stack) + 1;
    branch[.+3, alu#0];
	  Stack_ (Stack) - 1;
     branch[agcTrap], T_ 5C;   * size too big
   pd_ (Stack) - T;
apn0: branch[.+2, carry], T_ (Stack&+1) + (pNodeOverhead);
     pSize_ FreeNodeSize, branch[doneSize];
    branch[.+2, carry'], pSize_ T;
     branch[agcTrap], T_ 5C;   * size too big

doneSize:    * pSize has node size, ScratchBR has zn
   T_ znpfn_ zn.pfn;
   T_ (fetch_ T) + 1;
   gcTemp_ 100C;
   Cnt_ gcTemp;
   fetch_ T, pfnFirstLo_ Md;
   membase_ LPtr, T_ Md;
   BrLo_ pfnFirstLo;
   pfnFirstHi_ BrHi_ T;
* LPtr has PFreeNode
 apLoop:
   T_ (fetch_ pnode.sizeHi) - 1;
   pLengthHi_ Md, fetch_ T;
  apL2: pLengthHi_ (pLengthHi) AND (377C), branch[.+2, R <0];
    branch[cats], T_ 5C;     * node on free list is not free
    pd_ pLengthHi, T_ Md;
   branch[sizeOK, alu#0], T_ T - (pSize);  * branch if pLengthHi # 0
    branch[.+2, carry'];   * skip if pSize > pLengthLo
    pLengthLo_ T, branch[szOK1];

** this node is too small, check interrupts, count and then try another
**  undate rover pointer in zone
   T_ (fetch_ pnode.pfnNextHi) - 1;
   pLengthHi_ Md, fetch_ T;
   membase_ ScratchBR, T_ (znpfn) + 1;
   T_ (store_ T) - 1, dbuf_ pLengthHi;
   store_ T, dbuf_ Md, T_ Md, branch[.+2, Cnt#0&-1];
    branch[agcTrap], T_ 4C;    * looked at 20B nodes
**  check if have gone all the way around a short list
   branch[.+2, ReSchedule'], membase_ LPtr;
    branch[MesaReschedTrap];   * priority interrupt
   pd_ (BrLo_ T) XOR (pfnFirstLo);
    branch[apLoop, alu#0], T_ BrHi_ pLengthHi;
   pd_ T xor (pfnFirstHi);
    branch[.+2, alu=0], T_ (fetch_ pnode.sizeHi) - 1;
    branch[apL2], pLengthHi_ Md, fetch_ T;
     branch[agcTrap], T_ 3C;    * all the way around
*-----------------------------------------------------------
 sizeOK:
   pLengthLo_ T, branch[.+2, carry'];
    branch[splitBlock];    * know plengthHi > 0 => split
   pLengthHi_ (pLengthHi) - 1;    * borrow
     branch[splitblock, alu>0];
** pLengthHi,,pLengthLo has length of leftover node
 szOK1:
   pd_ (pLengthLo) - (4MinBlockSize);
   branch[.+2, carry'];
    branch[splitBlock];    * need to split the block
* take the whole block off the free list - don't need to change the size
** need to access both next and previous block in linked list before
** taking this node off the chain (page faults)
   T_ (fetch_ pnode.pfnNext) + 1;
   T_ Md, fetch_ T;
   membase_ BBSrcBR;    * use BitBlt's 2 base registers
   pfnFirstLo_ BrLo_ T, T_ Md;
   pfnFirstHi_ BrHi_ T;
   T_ (fetch_ pnode.pfnPrev) + 1;
   T_ Md, fetch_ T;
   membase_ LPtr, b_ Md;
   T_ (fetch_ pnode.pfnPrev) + 1;
   T_ Md, fetch_ T;
   membase_ BBDstBR;
   gcTemp_ BrLo_ T, T_ Md;
   gcTemp2_ BrHi_ T;
   T_ (fetch_ pnode.pfnNext) + 1;
   b_ Md;
   T_ (store_ T) - 1, dbuf_ pfnFirstHi;
   store_ T, dbuf_ pfnFirstLo, flipmembase;
   T_ (store_ pnode.pfnPrev) + 1, dbuf_ gcTemp;
   store_ T, dbuf_ gcTemp2;
*-------- update zn.pfn
   membase_ ScratchBR, T_ pfnFirstLo;
   T_ (store_ znpfn) + 1, dbuf_ T;
   store_ T, dbuf_ pfnFirstHi;
*-------- mark the node as inuse by storing the type into pnode.SizeHi field
   membase_ LPtr;
   store_ pnode.type, dbuf_ Stack&-3;
 endPAlloc:
*-------- clear the freeList pointers (can't cause page fault)
   T_ A0;
   store_ pnode.pfnPrevHi, dbuf_ T;
   store_ pnode.pfnPrev, dbuf_ T;
   store_ pnode.pfnNextHi, dbuf_ T;
   store_ pnode.ref, dbuf_ T;		* same as pnode.pfnNext
   gcTemp_ Md, T_ 377C;	** get memory in good state
   Stack&+1_ VaLo;
   Stack_ T AND (VaHi), IFUNext0;
*--------- split the block - pLengthHi,,pLengthLo has length of leftover node
*  need to access the part of pnode that will be returned as the new node
** this is to take care of page faults
**  LPtr has the node to allocate from, scratchBR is not needed
 splitBlock:
   fetch_ pnode.SizeLo;
   T_ VaLo;
   Q_ T;
   T_ VaHi;
   fetch_ pnode.ref;    * page fault insurance
   gcTemp_ (pLengthLo) + Q;
   T_ T + (pLengthHi), XORSavedCarry;
   pfnFirstHi_ T AND (377C);
   membase_ ScratchBR;
   BrLo_ gcTemp;
   BrHi_ pfnFirstHi;
   T_ (store_ pnode.sizeLo) + 1, dbuf_ pSize;
   store_ T, dbuf_ Stack&-3;   * store type
* must change size of original node
   membase_ LPtr;
   store_ pnode.sizeLo, dbuf_ pLengthLo;
   pLengthHi_ (pLengthHi) OR (100000C);		* mark as free
   store_ pnode.sizeHi, dbuf_ pLengthHi;
   membase_ ScratchBR, branch[endPAlloc];

*-----------------------------------------------------------
*
* DoFreeObject[ptr: Pointer]
*-----------------------------------------------------------
FreeObject:  MiscTable[75], Stack&-2;
  call[getRef];
   knowrbase[gcTemp];   * membase unknown, probe has MapQMz entry
  branch[freePN, R>=0], probe;

** subzone => quantized node to be freed, and membase is LPtr
* LPtr points to the subZone, ptr is in Stack-1,,Stack
** need to get the zone and check the monitor lock (sigh)
freeQN: fetch_ sz.zi;
  zoneIndex_ Md, membase_ gcstateBR;
  T_ (fetch_ MapZiZnOffset) + 1;
  T_ Md, fetch_ T;
  membase_ BBSrcBR, zoneIndex_ (zoneIndex) + (zoneIndex) + 1;
  BrLo_ T, T_ Md;
  BrHi_ T;
  T_ (fetch_ zoneIndex) + 1, call[loadBaseReg];
 freeQN1: fetch_ zn.MLOCK;
  gcTemp_ Md;
   branch[.+2, R even], gcTemp, membase_ LPtr;
    branch[agcTrap], T_ 2C;   * lock was set, so take trap

*  LOOPHOLE[ptr, FreeList]^_ sz.fl;
*  sz.fl_ ptr;

   T_ (fetch_ sz.fl) + 1;
   szflLo_ Md, fetch_ T;
   szflHi_ Md, membase_ ScratchBR;
   BrHi_ Stack&-1;
   BrLo_ Stack;
   T_ (fetch_ obj.FreeList) + 1;
   T_ (store_ T) - 1, dbuf_ szflHi;
   store_ T, dbuf_ szflLo;
   membase_ LPtr;
   T_ (store_ sz.fl) + 1, dbuf_ Stack&+1;
   store_ T, dbuf_ Stack&-2, IFUNext0CF;

* probe has zn.zi
*  pfn, pfnPrev: PFreeNode;
*  pfnNext: PFreeNode_ pfnPrev.pfnNext;
*  pfn.body_ free[pfnPrev: pfnPrev, pfnNext: pfnNext];
*  pfnNext.pfnPrev_ pfn;
*  pfnPrev.pfnNext_ pfn
freePN: membase_ GCstateBR, Stack&-1;
   T_ (fetch_ MapZiZnOffset) + 1, call[loadLPtr];
   fetch_ 0s, T_ probe, call[checkSize];
   T_ (probe) + (probe) + 1;
   T_ (fetch_ T) + 1, call[loadBaseReg];
 * LPtr now holds the zone, StkP points to ptrLo
   T_ pNodeOverhead;    * node+type overhead
freePN1: T_ (Stack&+1) - T;   * need to subtract overhead
   pfnLo_ pd_ T, branch[.+2, carry];
    T_ (Stack) - 1, branch[.+2];
    T_ Stack;
   pfnHi_ T;
 * StkP points to ptrHi, membase is LPtr
   fetch_ zn.MLock, Stack&-2;   * don't need StkP anymore
   gcTemp_ Md;
    branch[.+2, R even], gcTemp, T_ zn.fnd;
     branch[agcTrap], T_ 2C;    * zone is locked

* must reference pfnPrev and pfnNext before any stores
* can do stores into pfn, since its neither free nor used
   DummyRef_ T, b_ Md;
   T_ VaLo;
   BrLo_ T;
   T_ VaHi;
   T_ T AND (377C);
   BrHi_ T;
* LPtr holds pfnPrev
   T_ (fetch_ pnode.pfnNext) + 1;
   pfnNextLo_ Md, fetch_ T;
   pfnNextHi_ Md, membase_ BBDstBR;
   BrLo_ pfnNextLo;
   BrHi_ pfnNextHi;
   T_ (fetch_ pnode.pfnPrev) + 1;
   pfnPrevLo_ Md, fetch_ T;
   pfnPrevHi_ Md, membase_ scratchBR;
**  fix up the new free node to be inserted
   BrHi_ pfnHi;
   BrLo_ pfnLo;
   fetch_ pnode.sizeHi;
   pd_ Md;
    branch[.+2, alu>=0], T_ 6C;
    branch[cats];		* node already on free list
   T_ (store_ pnode.pfnNext) + 1, dbuf_ pfnNextLo;
   store_ T, dbuf_ pfnNextHi;
   T_ (store_ pnode.pfnPrev) + 1, dbuf_ pfnPrevLo;
   store_ T, dbuf_ pfnPrevHi;
   T_ 100000C;     * mark node as free
   store_ pnode.sizeHi, dbuf_ T;
   membase_ BBDstBR;
   T_ (store_ pnode.pfnPrev) + 1, dbuf_ pfnLo;
   store_ T, dbuf_ pfnHi;
   membase_ LPtr;
   T_ (store_ pnode.pfnNext) + 1, dbuf_ pfnLo;
   store_ T, dbuf_ pfnHi, IFUNext0CF;
*** debugging
*   membase_ scratchBR;
*   fetch_ pnode.sizeHi;
*    gcTemp_ Md;
*   branch[.+2, r ODD], gcTemp;   * check if inserted node is marked free
*   branch[cats];
*   IFUNext0;
*** debugging
*-----------------------------------------------------------
*
* FreeQuantizedNode[ptr: Pointer, zn:PRealZone]
*-----------------------------------------------------------
FreeQNode:  MiscTable[76], Stack&-3;
  call[getRef], T_ Stack&-1;
   knowrbase[gcTemp];   * membase unknown
  Stack&+2, membase_ BBSrcBR;
  BrHi_ Stack&-1;
  BrLo_ Stack&-1, branch[freeQN1];

*-----------------------------------------------------------
*
* FreePrefixedNode[ptr: Pointer, zn:PRealZone]
*-----------------------------------------------------------
FreePNode:  MiscTable[77], Stack&-3;
  call[getRef], T_ Stack&-1;
   knowrbase[gcTemp];   * membase unknown
  Stack&+2, membase_ LPtr;
  BrHi_ Stack&-1;
  BrLo_ Stack&-2;  *Lptr holds zone, StkP -> ptrLo
  T_ pNodeOverhead, branch[freePN1];   * node overhead

*-----------------------------------------------------------
     subroutine;
*  T_ (fetch_ xx) + 1, call[loadLPtr]
*-----------------------------------------------------------
loadLPtr:
  T_ Md, fetch_ T;
  membase_ LPtr;
 llpt1: BrLo_ T, T_ Md;
  BrHi_ T, return;

*-----------------------------------------------------------
*  T_ (fetch_ xx) + 1, call[loadBaseReg]
*-----------------------------------------------------------
loadBaseReg:
  T_ Md, fetch_ T, branch[llpt1];

*-----------------------------------------------------------
*
*  fetch_ 0s, T_ xx, call[checkSize]
*-----------------------------------------------------------
checkSize:
  pd_ T - Md;
  branch[.+2, alu<0];
   T_ 7C, branch[cats];    * bounds fault
  return;
*-----------------------------------------------------------
*  T has offset of word in zone/record to fetch
*  ptr (zone/record) is on top of stack
*  sets rbase to Allocator/Collector region
*
*  membase_ xx, T_ yy, call[checkMLock]
*-----------------------------------------------------------
checkMLock:
  BrHi_ Stack&-1;
  BrLo_ Stack;
  fetch_ T;
  rbase_ rbase[rcv];
  gcTemp_ Md, return;
*-----------------------------------------------------------

    top level;

agcTrap: rbase_ rbase[RTemp0], global;
  TrapParam_ T, branch[MiscOpCodeTrap];