{
LispCons.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
}

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[1, 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[1, 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[0, 4, ConsMap1];
	CALL[WLMapFix],	c2, at[2, 4, ConsMap1];
	CALL[WLMapFix],	c2, at[3, 4, ConsMap1];
ConsMap2:
	CALL[WLMapFix],	c2, at[0, 4, ConsMap2];
	CALL[WLMapFix],	c2, at[2, 4, ConsMap2];
	CALL[WLMapFix],	c2, at[3, 4, ConsMap2];


ConsNoRoom1:
	GOTO[ufnX3],	c2;
ConsNxtPg0:
	GOTO[ufnX1],	c3;
ConsOther:	{ufn for now}
	GOTO[ufnX1],	c3;

	{ E N D }