:Title[LLISTP - CAR, CDR, CONS, RPLACA, RPLACD];
* Edit history:
* February 9, 1984  4:22 AM, JonL, fixed bug in .CARCDR where it was
*		punting on NIL rather than on non-NIL litatoms
* February 9, 1984  12:36 AM, JonL, squeezed out one inst from CONS,
*		 near comment " LTEMP1_ new CAR"
* January 26, 1984  7:08 PM, JonL, spawned this file off LOPS;
*		opCDR goes directly to REPTMD1
* January 18, 1984  7:41 PM, JonL, added .rplc; modified opRPLACA
* January 18, 1984  6:05 PM, JonL, added subroutine .carcdr; moved
*		REPTMD1 to near opCDR
* January 6, 1984  4:56 AM, JonL, Changed CDR to exit thru TL.REPNIL2
*		rather than TL.PUSHNIL
* January 3, 1984  4:13 PM, JonL, Re-incorporated experimental changes 
*			made 12/30/83 fixing a clobberage of T by some TT.*** code
*			 affecting CAR, CDR, RPLACA, RPLACD
* December 27, 1983  6:30 PM, JonL, changed calls to GCLOOKT1 into calls 
*			to GCADDREF or GCDELREF
* December 26, 1983  6:40 PM, JonL, fixed callers of TYPREV to watch out 
*			for non-zero TT.*** bits

   KnowRBase[LTEMP0];
   TOP LEVEL;
   InsSet[LispInsSet, 1];


*--------------------------------------------------------------------
SUBROUTINE;	.CARCDR: 
*--------------------------------------------------------------------
* Call to here has done a TYPREV, so pointer is in LTEMP0,1
*   and typetable entry xor'd with listpType is in T
* Exit with hi.word (of cell pointed to) in LTEMP0, and
*   with lo.word on Md.

   branch[.crnlist, alu#0], pd_ BrHi_ LTEMP0;	*(LTEMP0) xor (AtomHiVal)
.carcdr1:
PAGEFAULTOK;
	T_ (FETCH_ LTEMP1) + 1;
:if[Debugging];
	LTEMP0_ MD, T_ (fetch_ T) and (lhmask);
PAGEFAULTNOTOK, Return;
:else;
	LTEMP0_ MD, T_ (fetch_ T) and (lhmask), Return;
:endif;

.crnlist:
	Branch[.crnlist1, alu#0], pd_ (LTEMP1);		*(LTEMP1) xor (AT.NIL)
		TOPLEVEL;								* Entering here on litatoms
		Branch[.+2, alu#0];
			NextOpCode;							* Both Car, Cdr of NIL = NIL
		CallUFN;									* Punt if arg is non-NIL litatom
		SUBROUTINE;
.crnlist1:
	Pd_ T and (rhmask); 
	branch[.+2, alu#0], T_ (LTEMP1);		* Check for non-zero
		BrHi_ LTEMP0, branch[.carcdr1];	*  TT.*** bits
TOPLEVEL;
	CallUFN;



*--------------------------------------------------------------------
opCAR:
*--------------------------------------------------------------------
	T_ (fetch_ TSP) + 1, Call[TYPREV]; 				* returns with type in T
	T_ (Id) xor T, memBase_ ScratchLZBR, Call[.CARCDR];
.car1:
	T_ (LTEMP0) and (lhmask);
	branch[.+2, alu=0], LTEMP0_ T_ (LTEMP0) xor T, memBase_ StackM2BR;
		T_ Md, TSP_ (store_ TSP) + 1, dbuf_ T, Branch[REPSMT2];	
	LTEMP1_ Md, pd_ A0, memBase_ ScratchLZBR, Call[.CARCDR]; 
	Branch[.car1];										* Cell is an indirection


regOP1[1, StackM2BR, opCAR, listType!];
	
*--------------------------------------------------------------------
opCDR:
*--------------------------------------------------------------------
	T_ (fetch_ TSP) + 1, call[TYPREV]; 				* returns with type in T
	Call[.CARCDR], pd_ (Id) xor T, memBase_ ScratchLZBR;
.cdr1:
	LTEMP1_ T;												* LTEMP1_ page base addr
	branch[.cdrind, R>=0], LTEMP0, 					* Hi order bit of cell is 

					T_ ldf[LTEMP0, 7, 10];				*  "not indirect" flg
	T_ T + T;		* Assuming non-0 cdrcode, this lsh's it by 1,
						*  while properly setting the alu branch conditions
	branch[.+2, alu#0], T_ T + (LTEMP1), memBase_ StackM2BR;
				* Ah, cdr code indicates CDR is NIL
		TSP_ (store_ TSP) + 1, dbuf_ (atomHiVal), branch[TL.REPNIL2];
	TSP_ (TSP) + 1, branch[REPSMT2];					* CDR is on same page

.cdrind:														* Indirection 
	T_ T + T;
	branch[.cdr2, alu#0], T_ (LTEMP1) + T;
		Call[.CARCDR], LTEMP1_ Md, pd_ A0,			* Ah, full indirection
						memBase_ ScratchLZBR; 			*  so go around again.
		Branch[.cdr1];
.cdr2:
	T_ (fetch_ T) + 1;
* Only local indirect, so fetch from that cell
	T_ Md, fetch_ T, Branch[REPTMD];	

regOP1[2, StackM2BR, opCDR, listType!];



:if[Reduced];
	UfnOps[30];	UfnOps[31];	UfnOps[32];			* RPLACA, RPLACD, CONS
:else;

*--------------------------------------------------------------------
SUBROUTINE;	.RPLFETCH:
*--------------------------------------------------------------------
* Enter with LTEMP0, 1 has address of cell to smash
*            typeCode xor listTYpe on pd
*            T has typeTable entry (needed only if # listpType)
* Exit with LScratchBR set up to point to cell to smash.
*           LTEMP2_ has contents of hi.word of that cell
*				Q_ LTEMP1 (for benefit to opRPLACD)
*				T contains 1 (for benefit to opRPLACA)
	branch[.rplc1, alu=0], LEFT_ (LEFT) + 1, memBase_ LScratchBR; 
		Pd_ T and (rhmask);							* Maybe typetable entry has
		branch[.rplc2, alu=0], BrHi_ LTEMP0, T_ A0;	* non-zero TT.*** bits
		TOPLEVEL; CallUFN; SUBROUTINE;				* Not a list, so punt out
.rplc1:
	BrHi_ LTEMP0;										* LTEMP0,1 have address of 
.rplc2:													*  cell to smash
	BrLo_ LTEMP1, T_ A0;
PAGEFAULTOK;
	T_ (FETCH_ T) + 1, Q_ LTEMP1;					* Fetch first word of that
:if[Debugging];										*  cell in to determine if
	LTEMP2_ MD;											*  it is an indirection
PAGEFAULTNOTOK, Return;
:else;
	LTEMP2_ MD, Return;
:endif;

*--------------------------------------------------------------------
.RPLCKVETCH:
*--------------------------------------------------------------------
* Similar to .rplfetch, except that LTEMP2 has hi.word of address of
*    cell to smash; used only by the indirection case.
	BrHi_ LTEMP2, Branch[.rplc2];

TOPLEVEL;



*--------------------------------------------------------------------
opRPLACA:
*--------------------------------------------------------------------
	T_ (TSP) - (4c);
	T_ (fetch_ T) + 1, call[TYPREV];	
*  Returns with memBase set to StackM2BR
.rplaca1:
	Pd_ T xor (listType), Call[.RPLFETCH];
	pd_ (LTEMP2) and (lhmask);
	branch[.+2, alu=0];
		LTEMP4_ (2c), Branch[RPLPTR1];		* Md still valid
	fetch_ T;										* Full indirection cell
TL.RPLAC:											*  so re-fetch and then
	LTEMP1_ Md, Call[.rplckvetch];			*  carry on.
	LTEMP4_ (2c), Branch[RPLPTR1];			* Md still valid

regOP1[30, StackBR, opRPLACA, NoNData];	* RPLACA


*--------------------------------------------------------------------
opRPLACD:
*--------------------------------------------------------------------
   T_ (TSP) - (4c);
   T_ (fetch_ T) + 1, call[TYPREV];
   Pd_ T xor (listType);
   branch[.rplacd1, alu=0], memBase_ LScratchBR,
						LEFT_ (LEFT) + 1; 
		Pd_ T and (rhmask);							* Maybe typetable entry has
		branch[.rplacd2, alu=0], BrHi_ LTEMP0,	* some non-zero TT.*** bits 
						T_ (LTEMP0) - (LTEMP0);
			CallUFN;										* Not a list, so punt out
.rplacd1:
   BrHi_ LTEMP0, T_ (LTEMP0) - (LTEMP0);		* Zero T, and set LScratchBR 
.rplacd2:
   BrLo_ T;												*  to list cell's segment
PAGEFAULTOK;
   LTEMP1_ (FETCH_ LTEMP1) + 1, Q_ LTEMP1;	* Q saves lo.word of cell 
   LTEMP2_ MD;											* LTEMP2_ hi.word of cell
PAGEFAULTNOTOK;
   branch[.rplacdind, R>=0], LTEMP2, 			* Test hi bit of cell
					T_ (LTEMP2) and (77400c); 
* local bit of cdrcode on; look at TSP to see if NIL, samepage
	memBase_ StackM2BR;
	TSP_ (fetch_ TSP) + 1;
	T_ Md, TSP_ (fetch_ TSP) - (3c);
	LTEMP4_ Md, pd_ T or (Md), memBase_ LScratchBR;	* Setup NIL test
	branch[.rplacdnil, alu=0], pd_ T - (LTEMP0);			* Setup SameSegP
	branch[.rplacdnewcell, alu#0], LTEMP1_ Md, T_ (Md) xor (LTEMP1);
	pd_ T and not (rhmask);										* Setup SamePagep
   branch[.+2, alu=0];
   	branch[.rplacdnewcell];
.rplacdonpage:														* AH! on same page
	T_ LTEMP0, call[GCADDREF];									* Addref new cell
   memBase_ LScratchBR;
   LTEMP1_ (fetch_ Q) + 1;
   LTEMP4_ LSH[LTEMP4, 7];
   T_ Md, LTEMP4_ (LTEMP4) or (100000c);
   T_ T and (77400c);
.rplacdlocal:
*		pd has hibyte of former CDR pointer -- maybe Delref it?
	branch[.rplacdl1, alu=0], T_ RSH[T, 7];
		LTEMP1_ (LTEMP1) and (lhmask);
		LTEMP1_ T + (LTEMP1);
		T_ LTEMP0, Call[GCDELREF];
		memBase_ LScratchBR;	
.rplacdl1:															* store new cdrcode
   fetch_ Q;
   T_ (rhmask);
   T_ T and (Md);
   T_ T + (LTEMP4);
   store_ Q, dbuf_ T, branch[GCOPTAIL];


.rplacdnil:															* RPLACD of NIL is 
   LTEMP4_ 100000c;												*  even easier than
   T_ (LTEMP2) and (77400c), Branch[.rplacdlocal];	*  of samepage ptr

.rplacdnewcell:
   TSP_ (TSP) + (2c);
   CallUFN;

.rplacdind:															* "local" bit off
   branch[.rplacdlocalind, alu#0], T_ RSH[T, 7];
 * 		Full indirect, so fetch new cell and go around again
		LTEMP0_ Md, fetch_ LTEMP1;	
		LTEMP1_ Md, branch[.rplacd1];	
.rplacdlocalind:													* Use CDR code as  
   LTEMP1_ (LTEMP1) and (lhmask);							*  offset on page
   T_ T + (LTEMP1);
   BrLo_ T;
   LTEMP4_ T_ (fetch_ 0s) + 1, Branch[RPLPTR1];

regOP1[31, StackBR, opRPLACD, NoNData];	* RPLACD


msc[DTD.NEXTPAGEs, DTD.NEXTPAGE!];
msc[DTD.COUNTERs, DTD.COUNTER!];

*--------------------------------------------------------------------
opCONS:
*--------------------------------------------------------------------
* LTEMP0, 1 will hold CDR value
* LScratchBR, LTEMP3 will hold new cons cell address
* LTEMP4 has CDR code 

	T_ (fetch_ TSP) + 1, call[TYPREV];
	LTEMP2_ (Id) xor T, memBase_ LScratchBR;
	Branch[.consnlist, alu#0], T_ BrHi_ LTEMP0;
.conslist:												* Assume new cell on CDR's page
	T_ ldf[LTEMP1, 7, 1];							* [src, size, pos];
	LTEMP4_ T + (200c);								* new cdr code
	T_ (LTEMP1) and (lhmask);						* base of CDR's page
.constail:
	LTEMP1_ BrLo_ T;
PAGEFAULTOK;
	FETCH_ 0s;
	LTEMP3_ MD;											* word 0 of page: [cnt, nxt]
PAGEFAULTNOTOK;
	Branch[.+2, R even], T_ LTEMP3_ (LTEMP3) - (400c);
															* Sub 1 from cnt
		.cnsod1: uCodeCheck[badcons];
	Branch[.+2, alu>=0], T_ T and (rhmask);	* T_ "next"
		branch[.consfail];							* trap out if no cells left
	Branch[.+2, alu#0], LTEMP1_ (fetch_ T) + (LTEMP1);
															* fetch next
		.cnszer: uCodeCheck[badcons];
	T_ Md, LTEMP3_ RSH[LTEMP3, 10];				* T_ [nxt,x], LTEMP3_ cnt
	LTEMP3_ RCY[LTEMP3, T, 10];					* [cnt,nxt]
	Branch[.+2, R even], store_ 0s, 				* Store back the frlist ptr
				dbuf_ LTEMP3;
		.cnsod2: uCodeCheck[badcons];
   BRLo_ LTEMP1;										* Br now points to new cell

	T_ LTEMP0, Call[GCDELREF];						* Create 0 cnt for new cell
	memBase_ ListpDTDBR;	
	fetch_ DTD.COUNTERs;								* Increment conscounter
	T_ (MaxConsCount);
	T_ Md, pd_ T - (Md);
	Branch[.+2, carry], T_ T + 1;
		PSTATE_ (PSTATE) or (PS.HTOVERFLOW);
	store_ DTD.COUNTERs, dbuf_ T;

	memBase_ StackM2BR, LEFT_ (LEFT) + 1;
	TSP_ (TSP) - (2c);
	T_ fetch_ TSP;										* "pulls back" 1 on TSP
	LTEMP0_ Md, T_ (store_ T) + 1, dbuf_ LTEMP0;
	fetch_ T;										 	* Save new cell on stack
	LTEMP1_ Md, store_ T, dbuf_ LTEMP1;			*  and LTEMP1_ new CAR

	T_ lsh[LTEMP4, 10];								* shift cdrcode, and
	T_ (LTEMP0) or T, memBase_ LScratchBR;		* merge with new CAR
	*	 BR has hiloc of new CDR when room available on that page
	store_ 0s, dbuf_ T;								* Smash the car/cdr value
	store_ 1s, dbuf_ LTEMP1;						*  into the new cell  

	T_ LTEMP0, Call[GCADDREF];						* addref on new CAR
	Case_ T - T, memBase_ StackBR	,				* addref on new CDR
				Call[GCLOOKUP1];
* Since TSP has already been "pulled back" one cell, the setting
*	 of memBase to StackBR instead of StackM2BR causes us to read the
*	 cell just beyond the current TOS -- which was the 2nd arg to CONS,
*	 namely the CDR value.
   LTEMP4_ (3c), Branch[GCOPTAIL];

.consnlist:
* CDR is not a list -- test it first for being NIL
   pd_ T or (LTEMP1), memBase_ ListpDTDBR;
   branch[.consother, alu#0], LTEMP4_ (200c);	
.consnil:
   fetch_ DTD.NEXTPAGEs;
   T_ Md, memBase_ LScratchBR;					* T_ nxtpage, where the new
   LTEMP0_ RSH[T, 10];								*  cons cell will come from
   branch[.+2, alu#0], BRHi_ LTEMP0;
		branch[.consfail];							* nxtpage = 0 ?
   T_ LSH[T, 10], branch[.constail];

.consother:
	Pd_ (LTEMP2) and (rhmask);						* Maybe some non-zero TT.*** bits 
	branch[.+2, alu#0];								*  were in the type table?	
		memBase_ LScratchBR,branch[.conslist];
.consfail:
   CallUFN;

regOP1[32, StackM2BR, opCONS, listType!];	* CONS


:endif;	

(635)\f8 3800G2g7G6g45G1g8087G