*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;
(635)\b118B1b89B40b312B23b162B223b48B89b60B195b85B1131b88B795b81B566b101B91b54B364b81B149b103B1b50B120b148B454b83B2457b334B4869b147B194b130B352b86B1814b21B16b216B2609b94B934b43B