{	QLispRplCons.mc
Created:   26-Nov-84 16:03:47 by don
Last edit:    23-Oct-85 10:48:09 by don
}

SetTask[0];

{
- - - - - - - - - - - - - - - - - - - - - - - - - -
  #      name        len-1    stk level effect   UFN table entry
 46      RPLCONS     0        -1                 \RPLCONS

takes two args (LST ITEM):

check	(LISTP LST)
	LST's pages CNT field # 0 (see CONS below), 
	LST's cdrcode = 200q.
call UFN if any of these are not true

MAKECONSCELL on LST's page
store ITEM as in cell, with cdr code = 200q (\CDR.NIL)

store as LST's new cdrcode (((LOLOC newcell) and 377) rsh 1) + 200q.

ADDREF item
increment LISTPDTD:COUNTER
return new cell

[not required; in D0, Dorado?]

- - - - - - - - - - - - - - - - - - - - - - - - - -
  #      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

- - - - - - - - - - - - - - - - - - - - - - - - - -
}

{	start by verifying that tos-1 is a LISTP 
}


@RPLCONS:	opcode[46'b],
	MAR _ [rhS, S - 1], L3 _ L3.RPLCONS,	c1;
	rhRx _ crhTypeTable, CANCELBR[rplTypC3, 2],	c2;


	uTT _ TT,	c1, at[L3.RPLCONS, 10, rpls];{uTT _ high data of old cell}
	TT _ TT LRot8,	c2;
	TT _ TT xor 200'b,	c3;

	Ybus _ TT - 1, PgCarryBr, L1 _ L1.NoFixes,	c1;{test if old cell cdrcode = 200'b}
	BRANCH[$, rplcNot200ufn],	c2;
	TT _ uTOSm1,	c3;{Lo 16 bits of old cell VA}

	TT _ TT and ~0FF,	c1;{mid 8 bits of cell VA}
	uAddrNewCellLo _ TT,	c2;{uAddrNewCellLo _ mid 8 bits of cell VA}
	Xbus _ PgDirty, XDisp, CALL[ConsMakeCellnoMap],	c3;

		at[L3.RPLCONS, 10, CMCEarly],
{	store new value into new cell }
	TT _ LShift1 TOSH and 0FF,	c1;
	TT _ RShift1 TT, SE _ 1,	c2;{tos hi with cdrcode = 200'b}
	,	c3;

	MAR _ [rhRx, Rx + 0],	c1;
	MDR _ TT,	c2;{tos hi with cdrcode = 200'b}
	TT _ uTT,	c3;{hi data of old cell}

	MAR _ [rhRx, Rx + 1],	c1;
	MDR _ TOS, CANCELBR[$, 2], LOOPHOLE[wok],	c2;{tos lo}
{	change cdr code of old cell to RSH1(loloc new cell) + 200'b }
	TT _ TT and 0FF,	c3;{lo half of hi 16 bits of old cell} 

	Rx _ RShift1 Rx and 0FF,	c1;{lo 8 bits of new cell addr RSH 1}
	Rx _ Rx or 080,	c2;{add 200'b}
	Rx _ Rx LRot8,	c3;{move to hi 8 bits}

	TT _ TT or Rx,	c1;{new hi 16 bits for old cell}
	Rx _ uSavAddr,	c2;{lo 16 bits old cell RA}
	,	c3;

	MAR _ [rhRx, Rx + 0],	c1;
	MDR _ TT,	c2;{new high contents for old cell}

{	set tos to be new cell }
	uTOS _ TOS,	c3;{uTOS _ old tos lo}

	Q _ TOSH and 0FF,	c1;
	uTOSH _ Q,	c2;{uTOSH _ old tos hi and 0FF}
	TOS _ uAddrNewCellLo,	c3;{lo 16 bits of new cell VA}

	TOSH _ uTOSHm1,	c1;{high 8 bits cell VA}
	{setup for GcLookup:
	  Rx _ addrHi & 0FF
	  TT _ addrLo
	  uGcLov _ 0 {before first call only}
	  L2 used for return via GcLookRet {to c2}
	  Q _ Q.AddRef or Q.DelRef
	  Trashes rhTT and rhRx
	  }
{	AddRef to item = tos}
	Rx _ uTOSH, L2 _ L2.ConsDel{share exit},	c2;{old tos hi and 0FF}
	TT _ uTOS,	c3;{old tos lo}

	Q _ Q.AddRef, CALL[GcLookup],	c1;

rplcNot200ufn:
	GOTO[ufnX1],	c3;

	{ E N D }