{
LispCons.mc
Created: 10-Aug-83 20:35:27 by don
Last edit: 2-Sep-83 11:00:55 by don
}
Set[L2.ConsNil, 8],
SetTask[0];
{*******************************************************************
CONS
*******************************************************************}
{ CONS ( X , Y ) returns cons with X as car
Y is initially on top of stack
}
{ConsNot:
Rx ← 32'b, GOTO[ufn2], c1;
}
Cons: opcode[32'b],
{optionally hooked up}
{ TT ← uLispOptions, c1;
TT ← TT and 4, ZeroBr, c2;
BRANCH[$, ConsNot], c3;
}
{ test if Y {top of stack} is NIL}
Ybus ← TOS or TOSH, ZeroBr, L2 ← L2.ConsNil, c1;
Q ← ConsNxtPg, BRANCH[ConsList, ConsNil], c2;
ConsNil:
PC ← PC + PC16, CALL[ConsMapDTD] c3;
{ SUBROUTINE ConsMapDTD}
ConsMapDTD:
rhTT ← DTDspace, c1;
TT ← DTDbasePage, c2;
TT ← TT LRot8, c3;
Map ← [rhTT,TT], L0 ← L0.RedoCons1, c1;
L1 ← L1.DecOnly, c2;
Rx ← rhRx ← MD, XDirtyDisp, c3;
{ fetch ListpDTD:NextPage/Counter}
MAR ← [rhRx, Q + 0], BRANCH[ConsMap1, $, 1], c1,at[L0.RedoCons1,10,WMapFixCaller];
L2Disp, c2;
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.DecOnly, c2;{u ← hi part of Vaddr of cons cell}
Rx ← rhRx ← MD, XDirtyDisp, c3;
{ get first word from cons page
this is: [count,,next]
}
MAR ← [rhRx, 0 + 0], BRANCH[ConsMap2, $, 1], c1,at[L0.RedoCons2,10,WMapFixCaller];
Rx ← Rx and ~0FF, c2;
TT{cnt,,next} ← MD, c3;
{ MakeConsCell}
Q{next} ← TT and 0FF, c1;{lo part of Vaddr of cons cell}
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}, c2;
Q ← rhTT, 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;
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;
, c3;
S ← S - 2, c1;
TT ← uGcLov{set by GcLookup}, c2;
Ybus ← TT, NZeroBr, c3;
Rx ← AtomGCSCAN {371'b}, BRANCH[ConsNoOvXit, ConsOvXit], c1;
ConsNoOvXit:
L2 ← L2.0, IBDisp, GOTO[DNI.nop], c2;
ConsOvXit:
IB ← Rx LRot0, L3{ib's} ← 0, c2;
PC ← PC - PC16, IBPtr ← 0, c3;
MAR ← Q ← [rhS, S + 1], GOTO[FN1Ext], c1;
{ Cons List}
{ConsNoList:
Rx ← 32'b, GOTO[ufn1], c3;
}
ConsList:
{ optionable}
{ Q ← uLispOptions, c3;
Ybus ← Q and 1, ZeroBr, c1;
BRANCH[$, ConsNoList], c2;
}
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, c2;
Rx{entry} ← MD and Q{0FF}, c3;
{ test if Y is of type list}
Ybus ← Rx xor ListType, ZeroBr, c1;
BRANCH[ConsOther, $], c2;
rhTT ← TOSH LRot0, c3;
TT ← TOS and ~0FF, c1;
uKeepTOS ← TOS, c2;
uKeepTOSH ← TOSH, CALL[ConsMakeCell], c3;
TT ← uKeepTOS, 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 ← uKeepTOS , c1;
Rx ← uKeepTOSH, 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;
ConsMap2:
CALL[WLMapFix], c2;
ConsNoRoom1:
GOTO[ConsUfn3], c2;
ConsNxtPg0:
PC ← PC - PC16, GOTO[ConsUfn1], c3;
ConsOther: {ufn for now}
ConsUfn3: PC ← PC - PC16, c3;
ConsUfn1: Rx ← 32'b, GOTO[ufn2], c1;
{ E N D }