{ QLispRplCons.mc
Created: 26-Nov-84 16:03:47 by don
Last edit: 23-Oct-85 10:48:09 by don
}
SetTask[0];
{
- - - - - - - - - - - - - - - - - - - - - - - - - -
# name len-1 stk level effect UFN table entry
46 RPLCONS 0 -1 \RPLCONS
takes two args (LST ITEM):
check (LISTP LST)
LST's pages CNT field # 0 (see CONS below),
LST's cdrcode = 200q.
call UFN if any of these are not true
MAKECONSCELL on LST's page
store ITEM as in cell, with cdr code = 200q (\CDR.NIL)
store as LST's new cdrcode (((LOLOC newcell) and 377) rsh 1) + 200q.
ADDREF item
increment LISTPDTD:COUNTER
return new cell
[not required; in D0, Dorado?]
- - - - - - - - - - - - - - - - - - - - - - - - - -
# name len-1 stk level effect UFN table entry
32 CONS 0 -1 CONS
Cons pages start with two word header:
word 0: [cnt, nxtcell] (two 8-bit fields: count of available cells
on this page, and word# of next free cell
on this page)
word 1: nextpage (page# of next cons page)
DTDs (data type descriptors) have (ucode relevant fields in caps)
word 0: NAME
word 1: SIZE
words 2,3: FREE
words 4,5: descrs
words 6,7: tyspecs
words 10,11: POINTERS
words 12,13: oldcnt
word 14: COUNTER
word 15: NEXTPAGE
\CDR.NIL= 200q
LISTPDTD is the DTD for type LISTP, i.e., at DTDbase + (LLSH 5 4)
Subroutine MAKECONSCELL[page] (given page, return new cell from it):
new cell is at page + page:nxtcell
new CNT is old CNT - 1; punt if CNT was zero
new NXTCELL is new cell's cdr code
Subroutine NEXTCONSPAGE:
if LISTPDTD:NEXTPAGE # 0 then return it, else punt
(lisp code scans for page with cnt>1)
CONS(X Y) // note: this may not be right. Check sources for truth
If Y is NIL:
get NEXTCONSPAGE
MAKECONSCELL on it
store new cell with \CDR.NIL in cdrcode (hi byte)
X in rest of cell
Elseif Y is a listp and the CNT in Y's page > 0, then
MAKECONSCELL[Y's page]
store X as CAR, CDR code = ([(LOLOC Y) and 377q] rsh 1) + 200q
Else:
get NEXTCONSPAGE
MAKECONSCELL on it
store Y in new cell (hi byte 0)
(remember this as Z)
MAKECONSCELL on same page
store X in new cell, with hi byte= [(LOLOC Z) and 377q] rsh 1
ADDREF X
ADDREF Y
increment LISTPDTD:COUNTER
DELREF result
- - - - - - - - - - - - - - - - - - - - - - - - - -
}
{ start by verifying that tos-1 is a LISTP
}
@RPLCONS: opcode[46'b],
MAR ← [rhS, S - 1], L3 ← L3.RPLCONS, c1;
rhRx ← crhTypeTable, CANCELBR[rplTypC3, 2], c2;
uTT ← TT, c1, at[L3.RPLCONS, 10, rpls];{uTT ← high data of old cell}
TT ← TT LRot8, c2;
TT ← TT xor 200'b, c3;
Ybus ← TT - 1, PgCarryBr, L1 ← L1.NoFixes, c1;{test if old cell cdrcode = 200'b}
BRANCH[$, rplcNot200ufn], c2;
TT ← uTOSm1, c3;{Lo 16 bits of old cell VA}
TT ← TT and ~0FF, c1;{mid 8 bits of cell VA}
uAddrNewCellLo ← TT, c2;{uAddrNewCellLo ← mid 8 bits of cell VA}
Xbus ← PgDirty, XDisp, CALL[ConsMakeCellnoMap], c3;
at[L3.RPLCONS, 10, CMCEarly],
{ store new value into new cell }
TT ← LShift1 TOSH and 0FF, c1;
TT ← RShift1 TT, SE ← 1, c2;{tos hi with cdrcode = 200'b}
, c3;
MAR ← [rhRx, Rx + 0], c1;
MDR ← TT, c2;{tos hi with cdrcode = 200'b}
TT ← uTT, c3;{hi data of old cell}
MAR ← [rhRx, Rx + 1], c1;
MDR ← TOS, CANCELBR[$, 2], LOOPHOLE[wok], c2;{tos lo}
{ change cdr code of old cell to RSH1(loloc new cell) + 200'b }
TT ← TT and 0FF, c3;{lo half of hi 16 bits of old cell}
Rx ← RShift1 Rx and 0FF, c1;{lo 8 bits of new cell addr RSH 1}
Rx ← Rx or 080, c2;{add 200'b}
Rx ← Rx LRot8, c3;{move to hi 8 bits}
TT ← TT or Rx, c1;{new hi 16 bits for old cell}
Rx ← uSavAddr, c2;{lo 16 bits old cell RA}
, c3;
MAR ← [rhRx, Rx + 0], c1;
MDR ← TT, c2;{new high contents for old cell}
{ set tos to be new cell }
uTOS ← TOS, c3;{uTOS ← old tos lo}
Q ← TOSH and 0FF, c1;
uTOSH ← Q, c2;{uTOSH ← old tos hi and 0FF}
TOS ← uAddrNewCellLo, c3;{lo 16 bits of new cell VA}
TOSH ← uTOSHm1, c1;{high 8 bits cell VA}
{setup for GcLookup:
Rx ← addrHi & 0FF
TT ← addrLo
uGcLov ← 0 {before first call only}
L2 used for return via GcLookRet {to c2}
Q ← Q.AddRef or Q.DelRef
Trashes rhTT and rhRx
}
{ AddRef to item = tos}
Rx ← uTOSH, L2 ← L2.ConsDel{share exit}, c2;{old tos hi and 0FF}
TT ← uTOS, c3;{old tos lo}
Q ← Q.AddRef, CALL[GcLookup], c1;
rplcNot200ufn:
GOTO[ufnX1], c3;
{ E N D }