{
LispRplCons.mc
Created:   26-Nov-84 16:03:47 by don
Last edit:    4-Dec-84 11:08:53 by don
}

SetTask[0];

#LispRplCons:

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

{
rplTypC3:
	rhTT _ TT _ MD,	c3;{tos-1 hi = Hi 8 bits of old cell VA}

	MAR _ [rhS, S + 0],	c1;
	,	c2;
	Rx _ MD,	c3;{tos-1 lo = Lo 16 bits of old cell VA}

	Q _ Rx,	c1;{Lo 16 bits of old cell VA}
	,	c2;
	,	c3;

	MAR _ Rx _ [Rx, TT + 0],	c1;{byte merge}
	Rx _ Rx LRot8, 	c2;
	Rx _ Rx RShift1, getTypemsBit,	c3;

	MAR _ [rhRx, Rx + 0], L1 _ L1.NoFixes,	c1;{type table fetch}
	Rx _ ListType,	c2;
	Rx _ MD xor Rx, L0 _ L0.RedoRplX,	c3;

rplxmap:
	Map _ TT _ [rhTT, Q],	c1;{map the old cell}
	Ybus _ Rx - 1, PgCarryBr,	c2;{check if type = list}
	rhRx _ Rx _ MD, XwdDisp, BRANCH[$, rplUfn],	c3;

	uTOSm1 _ TT, DISP2[rplxremap],	c1, at[L0.RedoRplX, 10, WxMapFixCaller];{uTOSm1 _ Lo 16 bits of old cell VA}
	Q _ rhTT,	c2, at[1, 4, rplxremap];
	uTOSHm1 _ Q,	c3;{uTOSHm1 _ Hi 8 bits of cell VA}

	MAR _ Rx _ [rhRx, TT + 0],	c1;
	uSavAddr _ Rx, L3Disp,	c2;{uSavAddr _ lo 16 bits old cell RA}
	rhTT _ TT _ MD, DISP4[rpls],	c3;{high data of old cell}
}

	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 _ 1, XDisp, CALL[ConsMakeCellnoMap],	c3;

{
ConsMakeCellnoMap:
{	get first word from cons page
	this is: [count,,next]}
	MAR _ [rhRx, 0 + 0], DISP2[ConsMap2],	c1,at[L0.RedoCons2,10,WMapFixCaller];
	Rx _ Rx and ~0FF,	c2, at[1, 4, ConsMap2];{Rx _ mid 8 bits of cell RA}
	TT _ MD,	c3;{cell page cnt,,next}

{	MakeConsCell}
	Q{next} _ TT and 0FF,	c1;{lo 8 bits of new cell addr}
	Rx _ Rx or Q,	c2;{Rx _ lo 16 bits of new cell RA}
	TT _ TT LRot8,	c3;

	TT{cnt} _ TT and 0FF,	c1;{TT now has cnt}
	Q _ Q or uAddrNewCellLo,	c2;{Q _ lo 16 bits of new cell VA}
	TT{cnt-1} _ TT - 1,	NegBr,	c3;{test if no more space, and gen cnt-1}

	TT _ TT LRot8, BRANCH[$, ConsNoRoom1],	c1;{hi 8 bits = cnt-1}
	uNewCount _ TT,	c2;{uNewCount _ hi 8 bits = cnt-1}
	uGcLov _ 0,	c3;{prepare for GcRef}

{	get hi word of new cell}
	MAR _ [rhRx, Rx + 0],	c1;
	uAddrNewCellLo _ Q,	c2;{uAddrNewCellLo _ lo 16 bits of new cell VA}
	Q _ MD,	c3;{Q _ hi 16 bits of data from new cell}

	TT{newnext} _ Q and ~0FF,	c1;{ptr to next free cell from new cell}
	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}
}
		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;
{
{	increment LISTDTD:COUNTER and return }
	Q _ ConsCnt,	c2,at[L2.ConsDel,10,GcLookRet];
	CALL[ConsMapDTD],	c3;


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,	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;


{	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;
	Rx _ uGcLov{set by GcLookup}, BRANCH[ConsCntBig, ReclX1],	c2;
}

rplcNot200ufn:
	GOTO[ufnX1],	c3;

	{ E N D }