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>