{
QLispCons.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[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 }