:TITLE[Htfind.0mc, October 19, 1983  3:50 PM, van Melle];

* RV[Probe, IP[lspNargs]];
RV[Case, IP[lspDefx0]];
RV[Entry, IP[lspDefx1]];

@GcRef:	* TOS -> TOS if cnt went to zero, NIL otherwise

	Case _ 100000c, opcode[025];	* = explicit punt if collision
	T _ NextData[IBuf];
	Case _ (Case) + T;

	T _ Stack&-1;			* L0,1 _ TOS
	lspL1 _ T;
	T _ Stack&+1, loadpage[pgHtFind];
	lspL0 _ T, call[GcLookup];
	lu _ (Entry) and (htStkCnt), goto[TOSGetsNILifNeq];
			* Smash TOS with NIL unless Stackbit = refcnt = 0

onpage[pgHtFind];
* GcLookup subroutine L0,1 = Pointer, Case = operation; returns Entry, which
* is guaranteed to be valid in collision bit and count field if no collision
* Smashes lspLN, lspNargs, lspL5, AC2/Hi, and Case & Entry (lspDefx0,1).

GcLookup:
	UseCTask;
GcLookupWithCTask:
	T _ APC&APCTask, task;
	lspL5 _ T;			* Save return address
	T _ lspL0 _ rhmask[lspL0];	* mask out any garbage in hi 8 bits
	T _ lsh[lspL0, 7];
*	T _ lsh[lspL0, 7], skip[NoH2Bit8];
*	  goto[htAtom];		* This catches invalid addrs in the 200b range
				* Too bad I can't get the 100b ones so cheaply
	T _ (rsh[lspL1, 11]) or T;
	PFetch1[MDSTypeBaseBr, lspLN];	* get Type table entry
	AC2Hi _ (htMainSpace);		* Set up base register while waiting
	AC2 _ (htMainBase), task;
	T _ rsh[lspL1, 1];		* Location to make probe in hash table
	lu _ (lspLN) and (40000c), goto[htAtom, R<0];	* sign bit = no gcref
*	skip[alu=0];			* test "no gcref in microcode" bit
*	  goto[htPunt];			* Entry needs to be set

	PFetch1[AC2, Entry];		* Get Hash table entry
					* Cannot fault because table locked
	lu _ Entry, skip[Reven];	* Pointer to collision entry if odd
	  goto[htPunt];
	T _ lsh[lspL0, 1], goto[htNotEmpty, alu#0];	* Is entry empty?
	Entry _ T;			* Empty means Entry has count of 1
	Entry _ (Entry) or (ht1cnt), goto[htDisp];

htNotEmpty:
	T _ ldf[Entry, 7, 10];		* get hi bits of hash table entry
	lu _ (lspL0) xor T;		* compare with the pointer
	lu _ (Entry) + (ht2Cnt), skip[alu=0];
	  Entry _ 1c, goto[htPunt];	* Not same, is a collision
	goto[htPunt, carry];		* Cnt field is full or about to be, so punt it to Lisp

htDisp:
	dispatch[Case, 16, 2];
	lspLN _ (htStkCnt), disp[htProbe];

htProbe:
	T _ Entry _ (Entry) + (ht1Cnt), goto[htStore], disptable[3];	* [0]: addref
	T _ Entry _ (Entry) - (ht1Cnt), goto[htStore];		* [1]: delref
	T _ Entry _ (Entry) or (htStkBit), goto[htStore];	* [2]: stkref

htStore:				* store modified entry
	lspLN _ (lspLN) and T;		* Mask out all but Stk & Cnt fields
	lu _ (lspLN) xor (ht1Cnt);
	lspLN _ T, skip[alu#0];
	  lspLN _ 0c;			* Entry with cnt=1, stk=0 not stored
	T _ rsh[lspL1, 1];
	PStore1[AC2, lspLN], goto[htDone];
					* Update entry in hash table
htAtom:
	Entry _ (ht1Cnt), goto[htDone];	* atoms etc never in table
htDone:
	lspL0 _ rhmask[lspL0], call[retLBL];	* Mask out garbage from Punt
					* And task, because next return won't
	APC&APCTask _ lspL5, goto[retLBL];

htPunt:					* add case,,L0,1 to HT overflow table
	T _ lsh[Case, 10], goto[htCallUfn, R<0];
	lspL0 _ (lspL0) + T;		* OR case into hi L0
	T _ 100000c, call[.+1];		* Offset of overflow table
	PFetch1[AC2, lspLN];		* fetch entry
	lu _ lspLN;			* Zeros end the table
	skip[alu=0], Case _ (Case) or (GcOverflowPunt);	* signal punt for end of op
	  T _ (Form2[AllOnes]) + T, return;	* T _ T+2, return to PFetch1
	PStore2[AC2, lspL0], goto[htDone];	* Store entry

htCallUfn:				* Can't defer this punt
	lspUFN _ 025c, goto[ufnLBL];

* RplPtr.n(base, ptr): store TOS at n off TOS-1, preserving the hi byte at TOS-1

@RplPtr:
	loadpage[pgHStack], call[CheckElt2P4], opcode[24];

:IF[0];		*** old code
	loadpage[pgRplPtr];
	nop;
onpage[pgRplPtr];
	Stack&-2, call[PopL2];		* Set L3,2 to ptr
	T _ NextData[IBuf];		* get offset
	lspL2 _ (lspL2) + T;
	goto[RplPtrA1, no carry];
	  lspL3 _ (lspL3) + (400c);	* crossed segment
	goto[RplPtrA1];		* because just wrote hi base for next PFetch

PopL2:				* put TOS in L3,2 for addressing
				* leaves stack level alone
	T _ Stack&-1;
	lspL2 _ T;
	T _ rhmask[Stack&+1];
	lspL3 _ T;
	lspL3 _ (lsh[lspL3, 10]) + T + 1, return;

:ELSE;		**** new code
	Stack&-2;			* Point at base
	T _ NextData[IBuf];		* word offset
	T _ (Stack&-1) + T, loadpage[pgRplPtr];	* form low base
	lspL2 _ T, FreezeResult;
onpage[pgRplPtr];
	T _ lsh[Stack&+1, 10], skip[Carry'];	* form hi base
	  T _ (R400) + T;		* Segment cross
	lspL3 _ T;
	nop;				* wait for hi base to write
:ENDIF;

RplPtrA1:		* from Rplaca, Rplacd.
			* Stack points at PTR, new item is above that
			* L3,2 points at cell to replace in
	PFetch2[lspL2, lspL0, 0];	* get old contents.  CAN FAULT
	T _ lhmask[lspL0];
RplPtrA2:				* from Rplaca
	XBuf _ T, loadpage[pgHTFind];
	Case _ 1c, callp[GcLookup];	* Deleteref old value

	StkState _ rsh[StkState, 1];
	Stack&+2;			* point at new item
	T _ Stack&-1;
	lspL1 _ T;
	T _ XBuf;			* old hi byte,,0
	T _ (rhmask[Stack&-1]) or T;
	lspL0 _ T;			* L0,1 _ old hi byte,,new item
 
RplPtr1:			* From GVAR_.  L0,1 = words to store at L3,2
	PStore2[lspL2, lspL0, 0];	* Store new value, no fault

	loadpage[pgHTFind];		* Case _ 0 in rh, punt flag remains
	Case _ lhmask[Case], callp[GcLookup];	* Addref new value
	
GcExit:			* Come here at end of gcreffing instructions
			* normal finish, unless htpunt was called for
	lu _ (Case) and (GcPunts);
	lu _ (Case) and (CreateCellPunt), skip[alu#0];
	  NextOpCode;
	lspDefx1 _ (atomGCOVERFLOW), skip[alu=0];
	  lspDefx1 _ (atomGCGENPUNT);	* more general punt needed
	loadpage[pgFrame];
	lspNargs _ 1c, gotop[lspCallFn0];



* Gvar_, op 27: Set top value of atom alpha,beta to TOS

@SetGvar:
	loadpage[pgRplPtr], opcode[27];
	lspL3 _ (VALspace);
onpage[pgRplPtr];
	T _ NextData[IBuf];
	lspL2 _ T;
	T _ NextData[IBuf];
	lspL2 _ (lsh[lspL2, 10]) or T, task;	* L2 _ atom number to set
	lspL2 _ lsh[lspL2, 1];		* Point at value cell
SetGvar1:				* Here from SETF
	PFetch2[lspL2, lspL0, 0];	* fetch old top value; CAN FAULT

	loadpage[pgHTFind];
	Case _ 1c, callp[GcLookup];	* Deleteref old value
	
	T _ Stack&-1;
	lspL1 _ T;			* L0,1 _ TOS
	T _ Stack&+1;
	lspL0 _ T, goto[RplPtr1];

* Rplaca (LST ITEM)

@Rplaca:
	loadpage[pgHStack], call[CheckElt2P4], opcode[030];
	Stack&-2, call[lspTyp];		* check type of LST (below ITEM)
	loadpage[pgRplPtr];
	lu _ (lspType) - (listType);
onpage[pgRplPtr];
	skip[alu=0];			* ok if listp
	  lspUFN_ 30c, goto[ufnLBL];
					* LST is now in L3,2 from lspTyp
	PFetch2[lspL2, lspL0, 0];	* look at old cdrcode,,car
	T _ lhmask[lspL0];		* cdrcode
	goto[RplPtrA2, alu#0];		* cdrcode#0 is normal, do Rplptr
	T _ lsh[lspL0, 10];		* indirect: this is hiloc shifted
	lspL3 _ T;
	T _ lspL1;			* loloc indirect
	lspl2 _ T, goto[RplPtrA1];	* go do RPLPTR with fetch


@Rplacd:
	lspUFN_ (031c), goto[lspUfnxP4], opcode[031];	* Rplacd
%
@Rplacd:		* (RPLACD LST NEWCDR) => LST

	loadpage[pgHStack], call[CheckElt2P4], opcode[031];
	Stack&-2, call[lspTyp];		* get LST in L3,2, type in lspType
	loadpage[pgRplacd];
	lu _ (lspType) - (listtype);
onpage[pgRplacd];
	lspUFN _ 31c, skip[alu=0];
	  goto[ufnLBL];
RplacdFetch:
	Pfetch2[lspL2, lspL0, 0];	* fetch contents of cell
	T _ lhmask[lspL0];		* get cdrcode
	XBuf1 _ T, goto[Rplacd1, alu#0];
	T _ lspL0;
	lspL3 _ T;			* follow indirect...
	T _ lspL1;
	lspL2 _ T, goto RplacdFetch;

Rplacd1:				* contents of cell in 0,1
	goto[RplacdIndirect, alu>=0];	* indirect on page
	Stack&+2;			* Point Stack back at NEWCDR
	T _ Stack&-1;
	lspL1 _ T;
	T _ Stack&-1;			* Stack points at LST now
	lspL4 _ T, goto[RplacdNIL, alu=0];	* NEWCDR in 4,1
	lu _ (lspL3) xor T;		* compare hi words of LST, NEWCDR
	skip[alu=0];
	  goto[ufnLBL];			* NEWCDR not on LST's page
	T _ lhmask[lspL1];
	T _ (lhmask[lspL2]) xor T;	* compare lo parts of page numbers
	skip[alu=0];
	  goto[ufnLBL];			* NEWCDR not on LST's page
	T _ lsh[lspL1, 7];		* cell # of NEWCDR in left half
	T _ (rhmask[lspL0]) or T;	* new contents of LST, minus 200 bit
	XBuf2_ T;			* save it
	T _ lspL4;
	lspL0 _ T, loadpage[pgHtFind];	* NEWCDR now in 0,1
	Case_ 0c, callp[GcLookup];	* Addref NEWCDR

RplacdSmash:				* Old cdrcode in lh of XBuf1
					* almost new cdr code word in XBuf2
					* LST in L3,2
	T _ XBuf1 _ ldf[XBuf1, 1, 10];	* 2 * old cdrcode
	T _ (lhmask[lspL2]) + 2;	* point at old cdr
	lspL1 _ T;
	T _ lspL3;
	lspL0 _ T, loadpage[pgHtFind];	* old cdr now in 0,1
	Case _ (lhmask[Case]) + 1, callp[GcLookup]; 	* deleteref old cdr
	XBuf2 _ (XBuf2) or (100000c);	* set cdr on page bit
	PStore1[lspL2, XBuf2, 0];	* update LST's cdr code
	loadpage[pgRplPtr];
	StkState_rsh[StkState,1], gotop[GcExit];
				* done, having popped once, check for punt

RplacdNIL:				* Hiloc(NEWCDR) = 0
	lu _ lspL1;			* Loloc(NEWCDR)
	XBuf2 _ 0c, goto[RplacdSmash, alu=0];
	  goto[ufnLBL];			* NEWCDR not NIL, so punt
	
RplacdIndirect:				* indirect on page, cdrcode in XBuf1
	T _ ldf[XBuf1, 1, 10], loadpage[pgRplptr];	* 2 * old cdrcode
	lspL2 _(lhmask[lspL2]) + T, gotop[RplptrA1];
				* point 3,2 at loc of cdr, go do RplPtr on it
	
%	



* GcScan1, op 173
@GcScan1:
	T _ 0c, goto[GcScanx], opcode[173];

* GcScan2, op 174
@GcScan2:
	T _ 100c, opcode[174];
	lspL0 _ (htStkBit);		* Pattern = Collision bit or Stack bit
 	lspL0 _ (lspL0) + 1, goto[GcScanx];

GcScanx:
	Saluf _ T, T _ Stack&-1;	* MB _ 0 for GcScan1, 1 for GcScan2
	lspGenBrHi _ (htMainSpace);
	lspGenBr _ (htMainBase);
	lspLN _ T, loadpage[pgGcScan];
	PFetch4[lspGenBr, XBuf];
onpage[pgGcScan];
GcScanRestart:
	Dispatch[lspLN, 16, 2];
	T _ lspLN _ (lspLN) and not (3c), disp[.+1];
	lu _ 0c, goto[GcSa0], disptable[4];	* == instr at GcSa0+1
	lu _ 0c, goto[GcSa1];			* == T _ XBuf, goto[GcSa0];
	lu _ 0c, goto[GcSa2];			* == T _ XBuf1, goto[GcSa1];
	lu _ 0c, goto[GcSa3];			* == T _ XBuf2, goto[GcSa2];

GcScanLoop:
	PFetch4[lspGenBr, XBuf], call[retLBL];	* get 4 words, task
	T _ XBuf3;
GcSa3:	T _ XBuf2, goto[GcSc3, alu#0];
GcSa2:	T _ XBuf1, goto[GcSc2, alu#0];
GcSa1:	T _ XBuf, goto[GcSc1, alu#0];
GcSa0:	lu _ lspLN, goto[GcSc0, alu#0];
	T _ lspLN _ (lspLN) - (4c), dblgoto[GcScanLoop, GcScanDone, alu#0];

GcSc3:	lspLN _ (lspLN) + (3c);
	T _ XBuf3, dblgoto[GcCheck2, GcCheck1, MB];
	
GcSc2:	lspLN _ (lspLN) + (2c);
	T _ XBuf2, dblgoto[GcCheck2, GcCheck1, MB];
	
GcSc1:	lspLN _ (lspLN) + (1c);
	T _ XBuf1, dblgoto[GcCheck2, GcCheck1, MB];
	
GcSc0:	T _ XBuf, dblgoto[GcCheck2, GcCheck1, MB];

GcCheck1:			* In GcScan1: Check for collision or stk=cnt=0
	lspL1 _ T;
	lu _ (lspL1) and (htStkCnt), skip[Reven];
	  T _ lspLN, goto[GcScanFound];		* Collision bit on
	skip[alu#0];
	  T _ lspLN, goto[GcScanFound];		* Stk=cnt=0
	goto[GcScanRestart];		* combine with GcCheck2+1? (senses are reversed)

GcCheck2:			* In GcScan2: Check for collision or stk
	lu _ (lspL0) and T;	* L0 set up the desired pattern at init
	T _ lspLN, dblgoto[GcScanFound, GcScanRestart, alu#0];

GcScanDone:
	T _ Stack _ 0c;		* TOS _ NIL when done
GcScanFound:
	Stack&+1 _ T, goto[nxiLBL];	* TOS _ offset of find


@ReclaimCell:	* (PTR) => newptr or NIL
*	lspUFN _ (172c), goto[lspUfnxP5], opcode[172];	* ReclaimCell

	loadpage[pgReclaim], opcode[172];
	nop;
onpage[pgReclaim];
	loadpage[pgTyp];
	callp[lspTyp];
	lu _ (lspType) - (listtype);
	lspUFN _ 172c, skip[alu=0];
	  goto[ufnLBL];			* punt if nlistp
	PFetch2[lspL2, lspL0, 0];	* contents of cell -> L0,1
	T _ lhmask[lspL0];		* get cdrcode
	skip[alu#0];
	  goto[ufnLBL];			* punt on full indirect (cdrcode=0)
%---------
	T _ lhmask[lspL0], skip[R<0];	* get cdrcode, skip if 200 bit on
	  goto[ufnLBL];			* punt on indirect cases
---------%

	XBuf _ T, call[FreeListCell];	* save cdr code, free cell L2,3
	loadpage[pgHtFind];
	Case _ 1c, call[GcLookup];	* deleteref car

	Stack&-1 _ 0c;			* TOS _ NIL
	Stack&+1 _ 0c, call[ReclaimCheck];  * Put car on stack if cnt is zero

	T _ ldf[XBuf, 1, 10];		* cdrcode lsh 1
	goto[ReclaimDone, alu=0], T _ lspL2_ (lhmask[lspL2]) + T;
				* point at cdr cell, or finished if cdr nil
	lu _ XBuf, goto[ReclaimCdr1, R<0];	* Case 1 is cdr on page, easy
	PFetch2[lspL2, lspL0, 0];		* Get contents of cdr's cell
	call[FreeListCell];			* Free the cell itself
	T _ rhmask[lspL0], goto[ReclaimCdr2];	* cdr = contents of cell

ReclaimCdr1:
	lspL1 _ T;			* lo half of cdr
	T _ rsh[lspL3, 10];
ReclaimCdr2:
	lspL0 _ T, loadpage[pgHtFind];	* hi half
	call[GcLookup];			* deleteref cdr
	call[ReclaimCheck];		* put cdr on stack if cnt is zero
ReclaimDone:
	loadpage[pgRplPtr];
	gotop[GcExit];			* check for htpunt


ReclaimCheck:
	* Replace TOS with L0,1 if Entry is a zero-count ht entry

	lu _ (Entry) and (htstkcnt), skip [REven];
	  return;			* Collision entry, so unknown
	T _ lspL0, skip[alu=0];
	  return;			* Stkbit,,cnt nonzero
	Stack&-1 _ T;
	T _ lspL1;
	Stack&+1 _ T, return;


FreeListCell:
	* L3,2 points at cell to free.  L0 is contents of its first word.
	* Smashes L3,2 to point at pagebase.  Smashes L4, lh[L0], XBuf2,3

	T _ rhmask[lspL2];		* offset in page
	lspL2 _ lhmask[lspL2];		* point to page base
	Pfetch2[lspL2, XBuf2, 0];	* get count,,nextcell, nextpage
	lspL4 _ T;			* save offset
	lu _ XBuf3, skip[R>=0];		* nextpage = -1 is punt case.
		* NOTE: Assumes < 24-bit addrs, or no lists on negative pages
	  goto[ufnLBL];			* punt if this page not in free chain
	T _ lsh[XBuf2, 10];		* next cell, shifted to high byte
	lspL0 _ (rhmask[lspL0]) or T;	* make it cdr code at cell
	T _ lspL4;
	Pstore1[lspL2, lspL0];		* store it back in cell
	XBuf2 _ (XBuf2) + (400c);	* increment count
	XBuf2 _ (lhmask[XBuf2]) or T;	* make it count,,celloffset

:IF[BreakPoints];
	lu _ XBuf2, skip[REven];
	  breakpoint;
:ENDIF;
	Pstore1[lspL2, XBuf2, 0];	* store it back on page
	return;				* allow XBuf2 write


	:END[Htfind];