trivia-1976-1977/trivia/9006234/ar1.tv/datdel.3

	<DEFINE OFFSET (VAR) <- <* <VALUE .VAR> 2> 1>>


<TITLE DATREMOVE>
	<DECLARE ("VALUE" <OR FIX FALSE> ASYLUM FIX)>
	<PUSH	TP* (AB)>
	<AOBJN	AB* HERE -1>
	<PUSHJ	P* DATA1>
	<JRST	FINIS>

<INTERNAL-ENTRY DATA1 2>
	<SUBM	M* (P)>
	<MOVE	A* -2(TP)>	; "THE ASYLUM"
	<MOVE	B* <OFFSET MFDPAGE> (A)>
	<LSH	B* 10>	; "ADDRESS OF MFD PAGE"
	<PUSH	P* B>
	<ADDI	B* ALLOCLOCK>
	<PUSH	TP* <TYPE-WORD WORD>>
	<PUSH	TP* B>
	<MCALL	1 DHLOCK>	; "HARD LOCK THE ALLOCATOR"
	<GETYP	B* A>
	<CAIN	B* <TYPE-CODE FALSE>>
	<JRST	ALLOSE>		; "SORRY. ALREADY LOCKED"
	<MOVE	A* -2(TP)>
	<MOVE	B* <OFFSET ALLOCPAGE> (A)>
	<LSH	B* 10>	; "ADDRESS OF ALLOCATION PAGE"
	<MOVE	C* (B)>		; "AOBJN TO TABLE"
	<TRZ	C* *776000*>	; "FLUSH HIGH BITS"
	<ADD	C* B>
	<SKIPL	C>
	<ERRUUO* <MQUOTE ALLOCATOR-MUNGED>>
	<PUSH	P* C>		; " ** SAVED TOP OF ALLOCATION TABLE **"
	<SETZ>			; "USE 0 FOR BEST FIT"
	<MOVE	D* (TP)>	; "ENTRY TO FLUSH BEGINS HERE"
ALLOOP	<CAMN	D* 1(C)>	; "RIGHT ENTRY?"
	<JRST	TBLWN1>
ALFROB	<ADD	C* [<2 (2)>]>	; "TRY NEXT ENTRY"
	<JUMPL	C* ALLOOP>

TBLOSE	<SUB	P* [<2 (2)>]>
	<MOVE	A* <MQUOTE '("NOT FOUND")>>
	<JRST	ALLOS2>


; "COME HERE IF THERE IS A WINNING ENTRY CLOSE ENOUGH TO THE CORRECT SIZE
   TO MAKE IT A WINNER.  IT IS ALREADY LOCKED."

TBLWN1	<MOVE	O* 1(C)>	; "O HAS WINNING BLOCK POINTER"
	<MOVEI	A* 1(C)>
	<POP	P* D>		; " ** RESTORED TOP OF ALLOC TABLE **"
	<PUSHJ	P* BBLT>	; "REMOVE THIS TABLE ENTRY"
	<MOVE	A* -2(TP)>
	<MOVE	A* <OFFSET ALLOCPAGE> (A)>
	<LSH	A* 10>
	<MOVEM	D* (A)>
	<JRST	ALWIN>		; "AND WIN"

BBLT	<SUBM	M* (P)>
	<MOVEI	B* 2(D)>
	<SUBI	A* -1(B)>	; "BLT TABLE UP TWO LOCATIONS"
	<MOVE	E* A>
	<HRLZS	A>
	<HRR	A* D>
	<ADDI	A* -1(E)>
	<MOVEI	C* (B)>
	<SUBI	C* (A)>
	<ADDI	C* -1(E)>
	<HRLI	C* A>
	<POP	A* @ C>
	<TLNE	A* *777777*>
	<JRST	HERE -2>
	<ADD	D* [<2 (2)>]>	; "REST THE TABLE 2"
	<JRST	MPOPJ>

ALWIN	<POP	P* B>		; " ** RESTORED ADDRESS OF MFD **"
	<ADDI	B* ALLOCLOCK>	
	<PUSH	TP* <TYPE-WORD WORD>>
	<PUSH	TP* B>
	<PUSH	P* O>		; "ADDRESS FOR WRITE"
	<MCALL	1 DUNLOCK>	; "UNLOCK THE ALLOCATION TABLE"
ALWIN1	<MOVE	D* -2(TP)>
	<MOVE	B* <OFFSET ALLOCPAGE> (D)>
	<MOVE	A* <TYPE-WORD FIX>>
	<POP	P* B>		; "RESTORE WINNING ADDRESS"
	<SUB	TP* [<4 (4)>]>	; "TASTE AND WINNAGE"
	<JRST	MPOPJ>

; "VARIOUS LOSSAGES"

ALLOSE	<SUB	P* [<1 (1)>]>	
	<MOVE	B* <MQUOTE (6)>>
	<JRST	ALLOS2>

ALLOS2	<MOVE	A* <TYPE-WORD FALSE>>
	<SUB	TP* [<4 (4)>]>
	<JRST	MPOPJ>