{
LispRplCons.mc
Created: 26-Nov-84 16:03:47 by don
Last edit: 4-Dec-84 11:08:53 by don
}
SetTask[0];
#LispRplCons:
{
- - - - - - - - - - - - - - - - - - - - - - - - - -
# 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;
{
rplTypC3:
rhTT ← TT ← MD, c3;{tos-1 hi = Hi 8 bits of old cell VA}
MAR ← [rhS, S + 0], c1;
, c2;
Rx ← MD, c3;{tos-1 lo = Lo 16 bits of old cell VA}
Q ← Rx, c1;{Lo 16 bits of old cell VA}
, c2;
, c3;
MAR ← Rx ← [Rx, TT + 0], c1;{byte merge}
Rx ← Rx LRot8, c2;
Rx ← Rx RShift1, getTypemsBit, c3;
MAR ← [rhRx, Rx + 0], L1 ← L1.NoFixes, c1;{type table fetch}
Rx ← ListType, c2;
Rx ← MD xor Rx, L0 ← L0.RedoRplX, c3;
rplxmap:
Map ← TT ← [rhTT, Q], c1;{map the old cell}
Ybus ← Rx - 1, PgCarryBr, c2;{check if type = list}
rhRx ← Rx ← MD, XwdDisp, BRANCH[$, rplUfn], c3;
uTOSm1 ← TT, DISP2[rplxremap], c1, at[L0.RedoRplX, 10, WxMapFixCaller];{uTOSm1 ← Lo 16 bits of old cell VA}
Q ← rhTT, c2, at[1, 4, rplxremap];
uTOSHm1 ← Q, c3;{uTOSHm1 ← Hi 8 bits of cell VA}
MAR ← Rx ← [rhRx, TT + 0], c1;
uSavAddr ← Rx, L3Disp, c2;{uSavAddr ← lo 16 bits old cell RA}
rhTT ← TT ← MD, DISP4[rpls], c3;{high data of old cell}
}
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 ← 1, XDisp, CALL[ConsMakeCellnoMap], c3;
{
ConsMakeCellnoMap:
{ get first word from cons page
this is: [count,,next]}
MAR ← [rhRx, 0 + 0], DISP2[ConsMap2], c1,at[L0.RedoCons2,10,WMapFixCaller];
Rx ← Rx and ~0FF, c2, at[1, 4, ConsMap2];{Rx ← mid 8 bits of cell RA}
TT ← MD, c3;{cell page cnt,,next}
{ MakeConsCell}
Q{next} ← TT and 0FF, c1;{lo 8 bits of new cell addr}
Rx ← Rx or Q, c2;{Rx ← lo 16 bits of new cell RA}
TT ← TT LRot8, c3;
TT{cnt} ← TT and 0FF, c1;{TT now has cnt}
Q ← Q or uAddrNewCellLo, c2;{Q ← lo 16 bits of new cell VA}
TT{cnt-1} ← TT - 1, NegBr, c3;{test if no more space, and gen cnt-1}
TT ← TT LRot8, BRANCH[$, ConsNoRoom1], c1;{hi 8 bits = cnt-1}
uNewCount ← TT, c2;{uNewCount ← hi 8 bits = cnt-1}
uGcLov ← 0, c3;{prepare for GcRef}
{ get hi word of new cell}
MAR ← [rhRx, Rx + 0], c1;
uAddrNewCellLo ← Q, c2;{uAddrNewCellLo ← lo 16 bits of new cell VA}
Q ← MD, c3;{Q ← hi 16 bits of data from new cell}
TT{newnext} ← Q and ~0FF, c1;{ptr to next free cell from new cell}
TT ← TT LRot8, c2;
Q ← uNewCount, c3;
{ rewrite first word of cons page with new [count,,nextcell]}
MAR ← [rhRx, 0 + 0], c1;
MDR ← TT{Lo: newnext} or Q{Hi: cnt-1}, L3Disp, c2;
Q ← rhTT, DISP4[CMCEarly], c3;{saves rh of Vaddr of cons cell}
}
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;
{
{ increment LISTDTD:COUNTER and return }
Q ← ConsCnt, c2,at[L2.ConsDel,10,GcLookRet];
CALL[ConsMapDTD], c3;
ConsMapDTD:
rhTT ← DTDspace, c1;
TT ← DTDbasePage, c2;
TT ← TT LRot8, c3;
Map ← [rhTT,TT], L0 ← L0.RedoCons1, c1;
L1 ← L1.NoFixes, c2;
Rx ← rhRx ← MD, XwdDisp, c3;
{ fetch ListpDTD:NextPage/Counter}
MAR ← [rhRx, Q + 0], DISP2[ConsMap1], c1,at[L0.RedoCons1, 10, WMapFixCaller];
L2Disp, c2, at[1, 4, ConsMap1];
TT{NextPage/Counter} ← MD, RET[ConsMapDTDRet], c3;
{ increment ListpDTD:COUNTER}
MAR ← [rhRx, Q + 0], c1,at[L2.ConsDel, 10, ConsMapDTDRet];
MDR ← TT + 1, c2;
S ← S - 2, c3;
TT ← TT and ~u0FFF, ZeroBr, c1;
Rx ← uGcLov{set by GcLookup}, BRANCH[ConsCntBig, ReclX1], c2;
}
rplcNot200ufn:
GOTO[ufnX1], c3;
{ E N D }