{
dbLispCons.mc
Created: 10-Aug-83 20:35:27 by don
Last edit: 2-Feb-84 10:41:10 by don {swapped the punt exits}
Last edit: 1-Feb-84 11:56:16 by don {comments only}
Last edit: 24-Oct-83 15:04:59 by don
Last edit: 29-Jul-85 23:17:27 by lichtenberg -- daybreakified.
}
SetTask[0];
{*******************************************************************
CONS
*******************************************************************
# 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
- - - - - - - - - - - - - - - - - - - - - - - - - -
}
{ CONS ( X , Y ) returns cons with X as car
Y is initially on top of stack
}
@CONS: opcode[32'b],
{ test if Y {top of stack} is NIL}
Ybus ← TOS or TOSH, ZeroBr, L2 ← L2.ConsNil, c1;
Q ← ConsNxtPg, BRANCH[ConsList, ConsNil], c2;
ConsNil:
CALL[ConsMapDTD], L3 ← L3.CONS, c3;
{ SUBROUTINE ConsMapDTD}
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{XDirtyDisp}, c3;
{ fetch ListpDTD:NextPage/Counter}
MAR ← [rhRx, Q + 0], DISP2[ConsMap1], c1,at[L0.RedoCons1,10,WMapFixCaller];
L2Disp, c2, at[PgDirty, 4, ConsMap1];
TT{NextPage/Counter} ← MD, RET[ConsMapDTDRet], c3;
Ybus ← TT{NextPage}, ZeroBr, c1,at[L2.ConsNil,10,ConsMapDTDRet];
rhTT ← TT ← TT LRot8, BRANCH[$, ConsNxtPg0], c2;
TT ← TT and ~0FF, CALL[ConsMakeCell], c3;
ConsMakeCell:
{ map it}
Map ← [rhTT,TT], L0 ← L0.RedoCons2, c1;
uAddrNewCellLo ← TT, L1 ← L1.NoFixes, c2;{u ← lo part of Vaddr of cons cell}
Rx ← rhRx ← MD, XwdDisp{XDirtyDisp}, c3;
{ get first word from cons page
this is: [count,,next]
}
ConsMakeCellnoMap:
MAR ← [rhRx, 0 + 0], DISP2[ConsMap2], c1,at[L0.RedoCons2,10,WMapFixCaller];
Rx ← Rx and ~0FF, c2, at[PgDirty, 4, ConsMap2];
TT{cnt,,next} ← MD, c3;
{ MakeConsCell}
Q{next} ← TT and 0FF, c1;
Rx ← Rx or Q, c2;{Raddr of cons cell}
TT ← TT LRot8, c3;
TT{cnt} ← TT and 0FF, c1;{TT now has cnt}
Q ← Q or uAddrNewCellLo, c2;{merge hi and lo Vaddr of cons cell}
TT{cnt-1} ← TT - 1, NegBr, c3;{test if more space}
TT ← TT LRot8, BRANCH[$, ConsNoRoom1], c1;
uNewCount ← TT, c2;
uGcLov ← 0, c3;
{ get first word of cons cell}
MAR ← [rhRx, Rx + 0], c1;
uAddrNewCellLo ← Q, c2;
Q ← MD, c3;
TT{newnext} ← Q and ~0FF, c1;
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}
{ build new cons}
{ get second word of X, put to TOS and conspage}
MAR ← [rhS, S + 0], c1, at[L3.CONS, 10, CMCEarly];
uConsTemp ← Q, c2;
TOS{X.Lo} ← MD, c3;
MAR ← [rhRx, Rx + 1], c1;
MDR ← TOS, CANCELBR[$, 2], LOOPHOLE[wok], c2;
c3;
{ get first word of X}
MAR ← [rhS, S - 1], c1;
TOSH ← 0FF, CANCELBR[$, 0], L2Disp, c2;
TOSH{X.Hi} ← MD and TOSH, RET[ConsCMCRet], c3;
{ change cdrcode to nil (= 200B), put to TOSH and conspage}
TOSH ← LShift1 TOSH, SE ← 0, c1,at[L2.ConsNil,10,ConsCMCRet];
TOSH ← RShift1 TOSH, SE ← 1, c2;
Q ← Q.AddRef, c3;
MAR ← [rhRx, Rx + 0], c1;
MDR ← TOSH, c2;
{goto AddRef X, DelRef newconscell,increment ListpDTD:counter, fix stack and exit}
{ there is one abnormal exit from this section
if entries are added to the overflow table
}
{setup for GcLookup:
Rx ← addrHi & 0FF
TT ← addrLo
uGcLov ← 0 {before first call only}
L2 ← subr #
Q ← 0 if addref, 1 if delref, 2 if stkref
Trashes rhTT and rhRx
}
ConsCom: {Q set to Q.AddRef previously}
TT ← TOS, L2 ← L2.ConsAdd, c3;
Rx ← TOSH and 0FF, CALL[GcLookup], c1;
{GcLookup Subroutine here}
{setup for GcLookup:
Rx ← addrHi & 0FF
TT ← addrLo
uGcLov ← 0 {before first call only}
L2 ← subr #
Q ← 0 if addref, 1 if delref, 2 if stkref
Trashes rhTT and rhRx
}
TT ← uAddrNewCellLo, c2,at[L2.ConsAdd,10,GcLookRet];
TOS ← TT, c3;
TOSH ← uConsTemp, c1;
c2;
Rx ← uConsTemp, L2 ← L2.ConsDel, c3;
Q ← Q.DelRef, CALL[GcLookup], c1;
{GcLookup Subroutine here}
Q ← ConsCnt, c2,at[L2.ConsDel,10,GcLookRet];
CALL[ConsMapDTD], 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;
BRANCH[ConsCntBig, ReclX1], c2;
ConsCntBig:
Rx ← AtomGCPUNT {377'b}, L3{ib's} ← 0, c3;
GOTO[ReclOvXit], c1;
{ Cons List}
ConsList:
uGcLov ← 0, L2 ← L2.ConsList, c3;
{ get real address of type table entry}
TT ← 32'b, CALL[NewTyp], c1;
{ pc bumped by one in subroutine}
{ get type table entry}
MAR ← [rhRx, Rx + 0], c1,at[L2.ConsList,10,NewTypRet];
Q ← 0FF, L3 ← L3.CONS, c2;
Rx{entry} ← MD and Q{0FF}, c3;
{ test if Y is of type list}
Ybus ← Rx xor ListType, ZeroBr, c1;
PC ← PC - PC16, BRANCH[ConsOther, $], c2;
rhTT ← TOSH LRot0, c3;
TT ← TOS and ~0FF, c1;
uTOS ← TOS, c2;
uTOSH ← TOSH, CALL[ConsMakeCell], c3;
TT ← uTOS, c1,at[L2.ConsList,10,ConsCMCRet];
TT ← TT and 0FE, c2;
TT ← TT LRot8, c3;
TOSH ← LShift1 TOSH, SE ← 0, c1;
TOSH ← TOSH or TT, c2;
TOSH ← RShift1 TOSH, SE ← 1, c3;
MAR ← [rhRx, Rx + 0], c1;
MDR ← TOSH, c2;
{setup for GcLookup:
Rx ← addrHi & 0FF
TT ← addrLo
uGcLov ← 0 {before first call only}
L2 ← subr #
Q ← 0 if addref, 1 if delref, 2 if stkref
Trashes rhTT and rhRx
}
L2 ← L2.ConsListAdd, c3;
TT ← uTOS , c1;
Rx ← uTOSH, c2;
Rx ← Rx and 0FF, c3;
Q ← Q.AddRef, CALL[GcLookup], c1;
{GcLookup Subroutine here}
Q ← Q.AddRef, GOTO[ConsCom], c2,at[L2.ConsListAdd,10,GcLookRet];
ConsMap1:
CALL[WLMapFix], c2, at[PgClean, 4, ConsMap1];
CALL[WLMapFix], c2, at[PgProt, 4, ConsMap1];
CALL[WLMapFix], c2, at[PgVacant, 4, ConsMap1];
ConsMap2:
CALL[WLMapFix], c2, at[PgClean, 4, ConsMap2];
CALL[WLMapFix], c2, at[PgProt, 4, ConsMap2];
CALL[WLMapFix], c2, at[PgVacant, 4, ConsMap2];
ConsNoRoom1:
GOTO[ufnX3], c2;
ConsNxtPg0:
GOTO[ufnX1], c3;
ConsOther: {ufn for now}
GOTO[ufnX1], c3;
{ E N D }