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