*Subroutines for Dorado Smalltalk Microcode -- Model 1, XM version
* last edited July 11, 1979 11:17 PM by Deutsch

* last edited May 1, 1980 2:23 PM by Haugeland
* change to use IFU based Alto Emultor

Title[DsmallSubrs.Mc];

Subroutine;



*Ground rules for all subroutines:
* RBase is assumed to be State on entry and is unaffected or set to State on exit
* MemBase is unknown on entry and smashed on exit
* May smash T and MyTemp
* If can take arg in Arg1 or T, the T entry stores T into Arg1
* No other temporary registers are affected unless noted

KnowRBase[State];



*TestVecStr
* Tests the class number in T and returns with a value in T and Alu
* Value=0 if Vector, 1 if String
* Branches to Apply if none of the above is true

TestVecStr:
MyTemp ← T - (400c);
PD ← (MyTemp) - (StrClsm400.c);
PD ← (MyTemp) - (VecClsm400.c), Branch[.HitStr, Alu=0];

DblBranch[.HitVec, Apply, Alu=0];

.HitVec:
T ← T - T, Return;

.HitStr:
T ← (1c), Return;



*PopTop
* Subroutine to pop top of stack into T

PopTop:
T ← StackP ← (StackP) - 1, MemBase ← TFrameBr;
Fetch ← T;
T ← Md, Return;



*Stash
* Subroutine to stash Pcb and StackP in current arec

Stash:
MemBase ← ArecBr;
RBase ← RBase[IfuState];
T ← (Pcb) + (Oop00.c);
Store ← Pcf.s, DBuf ← T;

RBase ← RBase[State];
T ← (StackP) + (Oop00.c);
Store ← StackPf.s, DBuf ← T, Return;



*Ival:
*Arg1 = T = Oop
*T ← Value of number---preserves Arg1
* Calls GClass and Hash

Ivall:*arg in T
PD ← (T) - (MsInt.c);
PD ← T + 1, Branch[.NonIntL, Carry’];
Arg1 ← T, Q ← Link, DblBranch[.NonInt1, .Ival1, Alu=0];
.NonIntL:
Arg1 ← T, Q ← Link, Branch[.NonInt1];

Ival:*arg in Arg1
PD ← (Arg1) - (MsInt.c);*Less than SmallInt?
.IvalEnt:
PD ← (Arg1) + 1, Branch[.NonInt, Carry’];
Q ← Link, DblBranch[.NonInt1, .Ival1, Alu=0];*branch if nil
.Ival1:
T ← (Arg1) - (Oop00.c), Return;*Actually the number

.NonInt:
Q ← Link;*Save return address
.NonInt1:
Top Level;
IvalLink ← Q, Call[GClass];
Subroutine;
PD ← T - (NumCls.c);*class = number?
Branch[.NotNmbr, Alu#0];
Top Level;
Call[Hash];
Subroutine;
MemBase ← AemMemBase;
RBase ← RBase[IvalLink];
Link ← IvalLink;*Restore old return
Fetch ← T;
T ← Md, RBase ← RBase[State], Return;

.NotNmbr:
RBase ← RBase[IvalLink];
PD ← (IvalLink) - (NovaIvalRet.c);*Test if call from Nova
RBase ← RBase[State], DblBranch[.ArgFail, .ArgApply, Alu=0];

.ArgFail:*came from Nova
Branch[PrimFail];

.ArgApply:*came from interpreter
Branch[Apply];


*Intn
* Subroutine to intern a number in T
* Returns oop in T
* Uses SavR1
* Calls AInt

Intn:
MyTemp ← T + (Oop00.c) + 1;*MyTemp is oop+1 if small integer
PD ← (MyTemp) - (MsInt.c) - 1, Branch[.Oor1, Alu=0];*Minimum small integer oop; test for nil
Branch[.OutOfRange, Carry’];*<msint?

T ← (MyTemp) - 1, Return;*return oop

.OutOfRange:
SavR1 ← T, Branch[.Oor2];

.Oor1:
SavR1 ← T;
.Oor2:
T ← Link;*Save return address
Top Level;
IntnLink ← T, Call[AInt];*Allocate Integer: Arg1←Oop of new integer, Temp1←core addr
Subroutine;
RBase ← RBase[IntnLink];
Link ← IntnLink;
RBase ← RBase[SavR1];* ready to store value
T ← SavR1, RBase ← RBase[State];*Restore addr.
MemBase ← AemMemBase;*Get core addr of integer,
Store ← Temp1, DBuf ← T;
T ← Arg1, Return;*Return to old link address



*ILONG-
*T = Oop
*T ← Oop’s length
*Loads/Preserves Arg1
* Calls PClassMap, Hash

Ilong:
MyTemp ← Rsh[T, 7];*Open code PClassMap, see below
MyTemp ← (MyTemp) + (MyTemp), MemBase ← PmBaseBr;
Fetch ← MyTemp;
Arg1 ← T, T ← Md;
T ← T and (IscMsk.c);
PD ← T - (Octv.c);
Branch[.IsOct, Alu>=0];
Return;*Size is in T still

.IsOct:
T ← Link;
Top Level;
IlongLink ← T, Call[Hash];*Hash gets argument in Arg1
Subroutine;
T ← (T) - 1, MemBase ← AemMemBase;*Hash returns ptr to object in T
Fetch ← T;
RBase ← RBase[ILongLink];
Link ← ILongLink;
T ← Md, RBase ← RBase[State], Return;*Real length in field -1


*GTopCls:
*T ← Top’s class
*Takes SupMod instead if not nil (for Super opcode)
*Stores Top into Arg1

GTopCls:
PD ← (SupMod) + 1;
Arg1 ← Top, Branch[GClass1, Alu=0];
T ← SupMod, Return;



*Gclass:
*Arg1 = Oop
*T ← Oop’s class
*Preserves Arg1

GClassL:*arg in T
Arg1 ← T;
GClass1:
PD ← (Arg1) + 1, Branch[.GCEnt];

GClass:*arg in Arg1
PD ← (Arg1) + 1;
.GCEnt:
T ← Rsh[Arg1, 7], Branch[.GCNil, Alu=0];*Open code PClassMap, see below
T ← T + T, MemBase ← PmBaseBr;
Fetch ← T;
T ← Md;
T ← Rsh[T, 7], Return;*Extract Rci

.GCNil:
T ← ObjCls.c, Return;



*PClassMap-
*T = Oop
*returns after Fetch ← PClassMap entry address (pending Md)

PClassMap:
T ← Rsh[T, 7];
T ← T + T, MemBase ← PmBaseBr;*PClassMap is 2-word entries
Fetch ← T, Return;*Returns pending "←Md"



*Reference counting routines
*Names end in Inc or Dec for +1 or -1 increment
* Uses Temp3
* Calls Hash

*RefLastInc--
*Reference count last object hashed

RefLastInc:
T ← Link;
RefCtLink ← T;*Using same return address, in Link
MemBase ← RotBaseBr, Branch[.LastRefI];

*RefCkInc, RefCkDec (arg in Arg1)--
*RefCkLInc, RefCkLDec (arg in T -> Arg1)--
*Do reference counting, check for atom first
*Arg1=Oop Smashes Arg1

RefCkLInc:*arg in T
PD ← T - (MinAt), Branch[.RefCkIncEnt];

RefCkInc:*arg in Arg1
T ← Arg1;
PD ← T - (MinAt);
.RefCkIncEnt:
Arg1 ← T, Q ← Link, Branch[.RefIX, Carry’];*Atom->no Refct
Return;

RefCkLDec:*arg in T
PD ← T - (MinAt), Branch[.RefCkDecEnt];

RefCkDec:*arg in Arg1
T ← Arg1;
PD ← T - (MinAt);
.RefCkDecEnt:
Arg1 ← T, Q ← Link, Branch[.RefDX, Carry’];*Atom->no Refct
Return;

*RefInc, RefDec--
*Do reference counting, assume non-atom
*Arg1= Oop, Smashes Arg1

RefInc:
Q ← Link;
.RefIX:
Top Level;
RefCtLink ← B ← Q, Call[Hash];
Subroutine;
RBase ← RBase[RefCtLink];
Link ← RefCtLink;
.LastRefI:*Increment ref count
RBase ← RBase[Hash];
T ← (Rot0) and (ClnMsk.c);
PD ← T and (Rct8Bit.c);*check if count is >=8
T ← T + (Rct1Bit.c), Branch[.IckOv, Alu#0];*and store back

Store ← RotA, DBuf ← T;
RBase ← RBase[State], Return;

.IckOv:
KnowRBase[Hash];
Store ← RotA, DBuf ← T;*Test for 14 or 15 after inc
T ← T and (RctMsk.c);
PD ← T - (340c);*PD ← Rct - 14 (340)
PD ← T - (340c), Branch[.IncOv, Alu>=0];
RBase ← RBase[State], Return;

.IncOv:
T ← (2c), Branch[.NewInc, Alu=0];*Ac1=2--needs new entry

T ← (1c), Branch[.OvOldT];*Ac1=1--Inc old ov entry

.NewInc:
Branch[.OvCallT];

KnowRBase[State];

RefDec:
Q ← Link;
.RefDX:
Top Level;
RefCtLink ← B ← Q, Call[Hash];
Subroutine;
RBase ← RBase[Hash];
T ← (Rot0) and (ClnMsk.c);
MyTemp ← T and (RctMsk.c);
PD ← (MyTemp) - (Rct14.c), Branch[DeAloc, Alu=0];*Check if count=0

T ← T - (Rct1Bit.c), Branch[.DecOv, Alu>=0];*Check if count>=14, i.e. was overflow
.RefDExit:
Store ← RotA, DBuf ← T;
RBase ← RBase[RefCtLink];
Link ← RefCtLink;
RBase ← RBase[State], Return;

DeAloc:
KnowRBase[Hash];
T ← T + (Rct1Bit.c);*Bump refct to 1, and then store it and
Store ← RotA, DBuf ← T;
RBase ← RBase[State], Branch[Recuf];*call the recursive freer//No Link!

.DecOv:
T ← T - T, Branch[.OvOldT];*Ac1=0--Dec old ov entry

.OvOldT:
RBase ← RBase[State];
PD ← (Arg1) - (FalseOop.c);
PD ← (Arg1) - (TrueOopm1.c) - 1, Branch[.OvFalse, Alu=0];*don’t bother with false
Branch[.OvTrue, Alu=0];*or true
.OvCallT:*Enter with Nova Ac1 in T
RBase ← RBase[AemRegs];
StkP← spAC1;
Q ← Stack;
Stack ← T, RBase ← RBase[State];
Temp3 ← B ← Q, RBase ← RBase[Hash];*Save Ac1 in Temp3
T ← Rot0;
Store ← RotA, DBuf ← T;*Restore Rot (Br = RotBaseBr)
T ← (36c);
RBase ← RBase[State], Branch[NovaCall];*Then call OvRef (Oop, Code)

OvRet:
RBase ← RBase[RefCtLink];
Link ← RefCtLink;
RBase ← RBase[State];
T ← Temp3;
rbase← rbase[AemRegs];
StkP← spAC1;
Stack ← T, rbase← rbase[State], Return;*and Return

.OvFalse:
RBase ← RBase[Hash], Branch[.NoOv];
.OvTrue:
RBase ← RBase[Hash], Branch[.NoOv];
.NoOv:
T ← Rot0, Branch[.RefDExit];*restore Rot0

KnowRBase[State];


*Hash--
*Arg1 = Ac0 = Oop (Preserves Ac0)
*Rot0 ← Rot entry of oop
*RotA ← RotBase relative address of Rot entry
*T ← Core location of object referred to by oop
*Leaves MemBase = RotBaseBr
*Uses Residue, SavR0
*If HashT call then:
*Ac1 ← Rpc
*Ac2 ← RotA + RotBase
*Ac3 ←
*Success-> Rot0 before (and 4c)
*Failure-> Residue

Hash:*arg in Arg1
Global, Branch[Hash1];
HashL:*arg in T
Global, Arg1 ← T, Branch[Hash1];
HashMd:
Arg1 ← Md, Branch[Hash1];*arg in Md

Hash1:
T ← Lsh[Arg1, 10];
T ← (Arg1) xor T, RBase ← RBase[Hash];*Form root hash = (lo, 0) xor (Hi, lo)
Residue ← T and (HkrMsk.c);
T ← T + T, MemBase ← RotBaseBr;
T ← T or (Q ← RotCMsk);*Rot addressing is relative to end of Rot, so wraparound can be detected by Carry

* Exit conditions for probe sequence:
* T = RotA of found or empty entry, possibly needing RotCMsk merged in
* On success: Rot0 = Rot word 0, Residue has been incremented by RpcBit an extra time
* On failure: Residue has not been incremented an extra time;
* if 8 reprobes, Rpc in Residue is reset to 7 so no overflow into Hkr

* Probe 0
RotA ← T ← (Fetch ← T) + (32c);
PD ← (Rot0Em) - (Md), Branch[.+2, Carry’];*test for wraparound
RotA ← T + (Q), Branch[.-1];
T ← (Residue) xor (Md), Branch[.+2, Alu#0];*test for empty
T ← (RotA) - (32c), Branch[.Emp];*undo increment of RotA
Rot0 ← Md, PD ← T and (ResRpc.c);
Residue ← (Residue) + (RpcBit.c), Branch[.+2, Alu#0];*test for hit
T ← (RotA) - (32c), Branch[.Found];*undo increment of RotA
* Probe 1 -- address starts in RotA
RotA ← T ← (Fetch ← RotA) + (42c);
PD ← (Rot0Em) - (Md), Branch[.+2, Carry’];
RotA ← T + (Q), Branch[.-1];
T ← (Residue) xor (Md), Branch[.+2, Alu#0];
T ← (RotA) - (42c), Branch[.Emp];
Rot0 ← Md, PD ← T and (ResRpc.c);
Residue ← (Residue) + (RpcBit.c), Branch[.+2, Alu#0];
T ← (RotA) - (42c), Branch[.Found];
* Probe 2
RotA ← T ← (Fetch ← RotA) + (46c);
PD ← (Rot0Em) - (Md), Branch[.+2, Carry’];
RotA ← T + (Q), Branch[.-1];
T ← (Residue) xor (Md), Branch[.+2, Alu#0];
T ← (RotA) - (46c), Branch[.Emp];
Rot0 ← Md, PD ← T and (ResRpc.c);
Residue ← (Residue) + (RpcBit.c), Branch[.+2, Alu#0];
T ← (RotA) - (46c), Branch[.Found];
* Probe 3
RotA ← T ← (Fetch ← RotA) + (56c);
PD ← (Rot0Em) - (Md), Branch[.+2, Carry’];
RotA ← T + (Q), Branch[.-1];
T ← (Residue) xor (Md), Branch[.+2, Alu#0];
T ← (RotA) - (56c), Branch[.Emp];
Rot0 ← Md, PD ← T and (ResRpc.c);
Residue ← (Residue) + (RpcBit.c), Branch[.+2, Alu#0];
T ← (RotA) - (56c), Branch[.Found];
* Probe 4
RotA ← T ← (Fetch ← RotA) + (72c);
PD ← (Rot0Em) - (Md), Branch[.+2, Carry’];
RotA ← T + (Q), Branch[.-1];
T ← (Residue) xor (Md), Branch[.+2, Alu#0];
T ← (RotA) - (72c), Branch[.Emp];
Rot0 ← Md, PD ← T and (ResRpc.c);
Residue ← (Residue) + (RpcBit.c), Branch[.+2, Alu#0];
T ← (RotA) - (72c), Branch[.Found];
* placement
Nop;
* Probe 5
RotA ← T ← (Fetch ← RotA) + (76c);
PD ← (Rot0Em) - (Md), Branch[.+2, Carry’];
RotA ← T + (Q), Branch[.-1];
T ← (Residue) xor (Md), Branch[.+2, Alu#0];
T ← (RotA) - (76c), Branch[.EmpX];
Rot0 ← Md, PD ← T and (ResRpc.c);
Residue ← (Residue) + (RpcBit.c), Branch[.+2, Alu#0];
T ← (RotA) - (76c), Branch[.FoundX];
* Probe 6
RotA ← T ← (Fetch ← RotA) + (112c);
PD ← (Rot0Em) - (Md), Branch[.+2, Carry’];
RotA ← T + (Q), Branch[.-1];
T ← (Residue) xor (Md), Branch[.+2, Alu#0];
T ← (RotA) - (112c), Branch[.EmpX];
Rot0 ← Md, PD ← T and (ResRpc.c);
Residue ← (Residue) + (RpcBit.c), Branch[.+2, Alu#0];
T ← (RotA) - (112c), Branch[.FoundX];
* Probe 7 (and last)
Fetch ← RotA;
PD ← (Rot0Em) - (Md);
T ← (Residue) xor (Md), Branch[.+2, Alu#0];
T ← RotA, Branch[.EmpX];
Rot0 ← Md, PD ← T and (ResRpc.c);
Residue ← (Residue) + (RpcBit.c), Branch[.+2, Alu#0];
T ← RotA, Branch[.FoundX];

T ← RotA, Branch[.Emp8];*fail exit due to ov reprobe

.FoundX:*duplicate for placement
RotA ← T ← T or (Q), Branch[.Found0];
.Found:*Have a hit, test Otp
RotA ← T ← T or (Q);
.Found0:
MyTemp ← Rot0, Branch[.HasXX, R Even];*Save old Rot0 for Nova call

Rot0 ← (Rot0) - 1;*If it was set, clear Otp
Store ← T, DBuf ← Rot0;*Doesn’t clobber Md!!

.HasXX:
PD ← (Rot0) and (ImmBit.c);
T ← (RotA) + 1, Branch[.RemDat, Alu=0];*test immediate bit
T ← (RotBase) + T, RBase ← RBase[State], Return;*core addr = word 1 in ROT
.RemDat:
Fetch ← T;*get core addr from word 1 of Rot
T ← Md, RBase ← RBase[State], Return;

KnowRBase[Hash];

.Emp8:
RotA ← T or (Q);
Residue ← (Residue) - (RpcBit.c);*undo overflow of Rpc into Hkr
MyTemp ← (10c), Branch[.EmpN];*save reprobe count for Nova
.EmpX:*duplicate for placement
RotA ← T or (Q), Branch[.Emp0];
.Emp:
RotA ← T or (Q);
.Emp0:
T ← LDF[Residue, 3, 10];
MyTemp ← T;*save reprobe count
.EmpN:
T ← Link;
PD ← (T) - (NovaHashRet.c);*Test if Nova call
RBase ← RBase[State], Branch[HFail0, Alu=0];*Branch to HFail0 if Nova call
SavR0 ← T;
T ← (34c), Branch[NovaCall];

FltRet:
RBase ← RBase[SavR0];
Link ← SavR0;
RBase ← RBase[State], Branch[Hash1];*Resume hashing



*Dirty
* Mark the last thing hashed as dirty
* -- Only legal to call immediately after Hash -- beware!
* Assumes MemBase = RotBaseBr, address in T

Dirty:
Global, RBase ← RBase[Hash];
MyTemp ← T;*Save address in MyTemp[HashRegs]
T ← (Rot0) and (ClnMsk.c);
Store ← RotA, DBuf ← T;
T ← MyTemp, RBase ← RBase[State], Return;



*Allocators for context, integer and vector
*Arg1 ← T ← New Oop
*Temp1 ← Core Address of new oop
* Uses Temp2, Temp3
* Calls Hash

ACtxt:*Allocate context
T ← ClFree.c, Branch[Alloc];

AInt:*Allocate integer
T ← ClFree2.c, Branch[Alloc];

Avec:*Allocate vector
PD ← (T) - (11c);
Branch[.AVecF, Alu>=0];*trap to Nova if size too big

T ← T + (ClFree3.c), Branch[Alloc];

.AVecF:
Q ← Link;
AllocLink ← B ← Q, Branch[.VecF];

*At this point, T contains the offset from the base of core of the
*relevant freelist

Alloc:
MemBase ← CoreBaseBr;
Temp2 ← (Fetch ← T);
Q ← Link;
AllocLink ← B ← Q;
PD ← (Md) + 1;*uses FF
Arg1 ← Md, Branch[.NilFl1, Alu=0];*Trap if free list empty
Nop;*necessary for placement
Top Level;
Call[Hash];*Hash free list head, dirty
Subroutine;
Temp1 ← T, RBase ← RBase[Hash];*Temp1 ← Core loc of new object
T ← (Rot0) and (ResRpcImm.c);*Preserve residue, rpc, imm; reset clean, otp, and refct
Store ← RotA, DBuf ← T;*MemBase = RotBase from Hash
RBase ← RBase[AllocLink];
Link ← AllocLink;
MemBase ← AemMemBase;
RBase ← RBase[State];
Fetch ← Temp1;
PD ← (Md) + 1;
T ← Md, Branch[.NilFl2, Alu=0];*check to see if the object is nil
MemBase ← CoreBaseBr;
Store ← Temp2, DBuf ← T;*update freelist
T ← Arg1, Return;*Returns T=Arg1=New Oop, Temp1=Core addr.


.NilFl1:
PD ← (Temp2) - (ClFree2.c), Branch[.NilCmn];*Null free list, recover class #
.NilFl2:
PD ← (Temp2) - (ClFree2.c), Branch[.NilCmn];
.NilCmn:
PD ← (Temp2) - (ClFree.c), DblBranch[.IntF, .NonIntF, Alu=0];

.IntF:
T ← NumCls.c, Branch[NovaAlloc];

.NonIntF:
T ← 400c, DblBranch[.CtxtF, .VecF1, Alu=0];

.CtxtF:
T ← CntxCls.c, Branch[NovaAlloc];

.VecF:
T ← 400c;
.VecF1:
T ← T + (VecClsm400.c), Branch[NovaAlloc];

NovaAlloc:
Arg1 ← T, RBase ← RBase[spAc1];
StkP← spAC1;
T ← Stack, RBase ← RBase[State];
Temp3 ← T;
T ← Temp4;
Stack ← T;*TSize
T ← (30c), Branch[NovaCall];

AllocRet:
T ← Temp3, RBase ← RBase[spAc1];
StkP← spAC1;
Stack ← T, rbase← rbase[State];
Top Level;
Call[Hash];*Hash new instance, dirty (Ac0=Arg1 preserved)
Call[Dirty];
Subroutine;
RBase ← RBase[AllocLink];
Link ← AllocLink;
RBase ← RBase[State];
Temp1 ← T;
T ← Arg1, Return;*Return with Arg1=T= Oop, Temp1=core addr.


* End of subroutines

Top Level;


*Recursive Freer----Enter with refct=1
*some of the calls may change Link, or the saved return SavR1--
*Be sure to check that it does not smash important returns, and Calls and
*Branches are used in the right places


Recuf:
T ← (Father) + 1, RBase ← RBase[RefCtLink];*Father=-1 Iff top-level entry
T ← RefCtLink, RBase ← RBase[State], Branch[.+2, Alu#0];
SavR1 ← T;*Save Link for top-level entry
Temp3 ← T ← Arg1;
Call[PClassMap];*Smashes Link
T ← Md;
PD ← T and (CptMsk.c);*extract cpt
PD ← T and (IscMsk.c), Branch[QFinst, Alu=0];*extract isc
Branch[QFinst0, Alu=0];*Branch if size zero

Nop;*Placement
Call[Hash];
Temp3 ← T, RBase ← RBase[Hash];*save core address
T ← (Rot0) and (ClnMsk.c);*mark dirty
T ← T + (Rct1Bit.c);*Bump refct to 2, flag first time
Store ← RotA, DBuf ← T;*MemBase = RotBase from Hash
RBase ← RBase[State];
MemBase ← AemMemBase;
T ← Fetch ← Temp3;*Fetch from core address of object ref’d by oop
Store ← T, DBuf ← Father;*Doesn’t clobber Md!!
T ← Arg1, Arg1 ← Md;
Father ← T, Call[RefCkDec];*Decrement refct -- may cause recursion!!

ReRet:
T ← Father;
Arg1 ← T, Call[Hash];*Hash object being freed--dirty
Call[Dirty];
T ← (T) + 1, MemBase ← AemMemBase;*Core address of field 1
Temp3 ← Fetch ← T;
Temp2 ← Md, RBase ← RBase[Hash];
PD ← (Rot0) and (Rct1Bit.c);*Test even rct (means first time)
RBase ← RBase[State], Branch[FTime, Alu=0];*field 1 holds field offset

DoNxt:
T ← Temp2 ← (Temp2) - 1;*Look at the next field
.DoNxt1:
T ← (Temp3) + (T), MemBase ← AemMemBase, Branch[Out, Alu=0];*test if done
Fetch ← T;
T ← Md;
PD ← (T) - (MinAt);*Atom?

Gtf1:
Arg1 ← T, Branch[.Gtf2, Carry’];*Branch if not atom (Uses FF)
T ← Temp2 ← (Temp2) - 1, Branch[.DoNxt1];*Look at the next field

.Gtf2:
MemBase ← AemMemBase, T ← Temp2;
Store ← Temp3, DBuf ← T, Call[RefDec];*Decrement ref count -- may cause recursion!!
Branch[ReRet];

FTime:
RBase ← RBase[Hash];
T ← (Rot0) - (Rct1Bit.c);*Done field zero
MemBase ← RotBaseBr;
Store ← RotA, DBuf ← T;*Unbump refct to 1, not first time
RBase ← RBase[State];
T ← Arg1, Call[Ilong];*obj. length//Arg1←father at ReRet
Q ← Temp2, Temp2 ← T - 1;
T ← Q, Branch[.Out0, Alu=0];*Test if only had 1 field

PD ← (T) - (MinAt), Branch[Gtf1];*Jump into inner loop

Out:
T ← (Temp3) - 1, MemBase ← AemMemBase, Branch[.Out1];
.Out0:
T ← (Temp3) - 1, MemBase ← AemMemBase, Branch[.Out1];
.Out1:
Temp3 ← B ← Father, Fetch ← T;*Load father stashed in field 0
Father ← Md;
T ← Temp3, Call[PClassMap];
Branch[QFinst];*Free the instance

*QFinst:Quick Finst for exact size objects----
* Enter with Md = PClassMap entry for Temp3

QFinst0:*duplicate--placement constraint
Temp2 ← Md, Branch[.QF1];
QFinst:
Temp2 ← Md, Branch[.QF1];
.QF1:
PD ← (Temp2) - (VarRci.c);*Compare to varlen class
T ← (Temp2) and (IscMsk.c), DblBranch[.VarOop, .NotVar, Carry];*Extract inst size

.VarOop:
PD ← T - (11c);
Temp2 ← T + (ClFree.c), T ← Md, DblBranch[OctL, Exact, Alu>=0];

.NotVar:
PD ← T - (Octv.c);
Temp2 ← ClFree.c, T ← Md, DblBranch[OctL, Exact, Alu>=0];

Exact:
Arg1 ← Rsh[T, 7], Call[Hash];*Hash class of object being freed--dirty
Call[Dirty];
MemBase ← AemMemBase, T ← T + (Temp2);*Might cause a purge
Fetch ← T;
Store ← T, Arg1 ← DBuf ← Temp3;*Class[Free] ← RefOop//doesn’t clobber Md!!
Temp2 ← Md, Call[Hash];*Temp2 ← Class[FreeListHead]
Call[Dirty];*//hash object being freed
MemBase ← AemMemBase;
Store ← T, DBuf ← Temp2, Branch[FiRet];*RefOop[0]←TempX1

*Have to call real Finst in Nova otherwise

OctL:
Arg1 ← Temp3;*Call Finst with RefOop in Ac0
T ← (35c), Branch[NovaCall];*35 traps to 76400

FiRet:
PD ← (Father) + 1;*Finst returns here via trap
Branch[ReRet, Alu#0];*Father not nil=>more Recuf

Subroutine;

RBase ← RBase[SavR1];
Link ← SavR1;*Father is nil! Restore Link, and then...
RBase ← RBase[State], Return;*Return to original caller!

Top Level;