:Title[LOPS.mc, January 18, 1983  5:15 PM, Masinter];

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

*--------------------------------------------------------------------
opPOP:
*--------------------------------------------------------------------
   TSP_ (TSP) - (2c);
   Left_ (Left) + 1, NextOpcode;

regOP1[277, StackBR, opPOP, noNData];

*--------------------------------------------------------------------
opTYPEP:		* TYPEP, LISTP same code
*--------------------------------------------------------------------
   T_ (fetch_ TSP) + 1, call[TYPREV];
   T_ T and (rhmask);
   pd_ (Id) - T;
   branch[.+2, alu#0];
	NextOpcode;			* continue if type same
   TSP_ (store_ TSP) + 1, dbuf_ 0c;	* return NIL
   TSP_ (store_ TSP) - 1, dbuf_ 0c, NextOpCode;

regOP1[3, StackM2BR, opTYPEP, listType!];
regOP2[5, StackM2BR, opTYPEP, noNData];

*--------------------------------------------------------------------
opNTYPX:
*--------------------------------------------------------------------
   T_ (fetch_ TSP) + 1,   call[TYPREV];
   T_ T and (rhmask);
   TSP_ (store_ TSP) + 1, dbuf_ SmallHi;   
   TSP_ (store_ TSP) - 1, dbuf_ T, NextOpCode;

regOP1[4, StackM2BR, opNTYPX, noNData];
*--------------------------------------------------------------------
opDTEST:		* test if type name of tos = arg, ufn if not
*--------------------------------------------------------------------
   T_ (fetch_ TSP) + 1, call[TYPREV];
   memBase_ dtdBR;
   T_ lsh[T, 4];			* fetch type name of DTD

	PAGEFAULTOK;

   FETCH_ T, T _ LTEMP0, RisID;	* This is really T_ (Id);
   T_ lsh[T, 10];
   T_ (Id) + T;
   pd_ T - (MD);
   branch[.dtestfail, alu#0], Q_ T;
	PAGEFAULTNOTOK;
   NextOpCode;


.dtestfail:
	PAGEFAULTNOTOK;
   CallUFN;				* type disagree

regOP3[6, StackM2BR, opDTEST, noNData];


:if[NOCREATECELL];	* NO CREATECELL AT ALL NOW
	UFNOPS[37];
:else;
*--------------------------------------------------------------------
opCREATECELL:
*--------------------------------------------------------------------
   T_ (fetch_ TSP) + 1;
   T_ Md, fetch_ T;
   pd_ T - (SmallHi);
   branch[.+2, alu=0], T_ Md, memBase_ dtdBR;	* TOS = typenumber
	CallUFN;
   T_ lsh[T, 4];				* get DTD
   T_ T + (DTD.FREE);				* fetch free list
   LTEMP2_ T_ (fetch_ T) + 1;			* fetch head of free list
   LTEMP0_ Md, T_ (fetch_ T) + (sub[DTD.SIZE!, add[DTD.FREE!, 1]]c); 
   LTEMP1_ Md, fetch_ T;		* LTEMP0, 1_ free list head
   LTEMP3_ Cnt_ Md;			* LTEMP3 & Cnt _ Size

:if[Debugging];
	T_ (LTEMP1) and (777c);	* word # in MDSpage of new cell
	T_ T + (LTEMP3);	* plus count
	pd_ T - (1000c);
	branch[.+2, alu<=0];
		UCodeCheck[CreateCrossesPageBoundary];
:endif;

   branch[.+2, Cnt#0&-1], memBase_ ScratchLZBR;
   	UCodeCheck[allocateZeroSizeCell];
   BrHi_ LTEMP0;

	PAGEFAULTOK;

   T_ (FETCH_ LTEMP1) + 1;		* fetch contents of free
   LTEMP4_ MD, T_ (fetch_ T) - (2c);

	PAGEFAULTNOTOK;

   LTEMP3_ Md, T_ T + (LTEMP3);		* loloc + size - 1

*	T_ (STORE_ T) - 1, branch[.+2, Cnt=0&-1];
*	branch[.clearnew];
*	PAGEFAULTNOTOK, branch[.cleardone];


.clearnew:
	PAGEFAULTOK;

   T_ (STORE_ T) - 1, dbuf_ 0c, branch[., Cnt#0&-1];

	PAGEFAULTNOTOK;

:if[Debugging];
	pd_ (LTEMP1) - T - 1;
	branch[.+2, alu=0];
	UCodeCheck[];
:endif;

.cleardone:
   memBase_ dtdBR, T_ LTEMP2;
   T_ (store_ T) - 1, dbuf_ LTEMP3;
   store_ T, pd_ dbuf_ LTEMP4;	* store back new free cell

   branch[.+2, alu#0],
	LTEMP2_ (LTEMP2)+(sub[DTD.COUNTER!,add[1,DTD.FREE!]]c);
     PSTATE_ (PSTATE) or (PS.HTCNTFULL);	* free list became empty

   fetch_ LTEMP2;
   T_ (Md) + 1;
   store_ LTEMP2, dbuf_ T;
   pd_ T - (MaxConsCount);
   branch[.+2, carry];
	PSTATE_ (PSTATE) or (PS.HTCNTFULL);	* too many createcells

* save return value

   memBase_ StackM2BR, T_ TSP;
   T_ (store_ T) + 1, dbuf_ LTEMP0;
   store_ T, dbuf_ LTEMP1;

   T_ (fetch_ TSP) + 1;
   Case_ 1c, call[GCLOOKUP];
   branch[GCOPTAIL];

regOP1[37, StackM2BR, opCREATECELL, noNData];
:endif;	* NOCREATECELL



*--------------------------------------------------------------------
* subroutine to get type of datum
*--------------------------------------------------------------------
* leaves rbase alone, returns with membase_ StackBR
* ptr in LTEMP0,,LTEMP1, rbase[LTEMP0], T_ type
   SUBROUTINE;   

TYPREV:
   T_ LTEMP0_ Md, fetch_ T;
   LTEMP1_ Md, memBase_ tybaseBR;
   T_ rcy[T, LTEMP1, 11];
   fetch_ T;
   T_ Md, memBase_ StackM2BR, return;

   TOP LEVEL;


:if[NOBIN];
	UfnOps[40];
:else;

*--------------------------------------------------------------------
opBIN:
*--------------------------------------------------------------------
   T_ (fetch_ TSP) + 1, call[TYPREV];		* returns with type in T
   PD_ (Id) - T, memBase_ ScratchLZBR;
   branch[.+2, alu=0], BrHi_ LTEMP0;
	CallUFN;

	PAGEFAULTOK;

   T_ (FETCH_ LTEMP1) + 1;
   LTEMP0_ MD, T_ (fetch_ T) + 1;		* LTEMP0= CCOFF

	PAGEFAULTNOTOK;

   T_ Md, LTEMP1_ (fetch_ T) + 1;		* T=NCCHARS
   LTEMP0_ Md, pd_ T - (Q_ LTEMP0) - 1;		* T_ HiBuf, pd_ NCCHARS-CCOFF
   branch[.+2, carry], LTEMP1_ (fetch_ LTEMP1) - (3c);
	CallUFN;
   branch[.+2, R<0], LTEMP0, memBase_ ScratchBR;
	CallUFN;				* readable bit is off
   T_ Md, BrHi_ LTEMP0;
   BrLo_ T, LTEMP0_ Q, call[DOGETBYTE];		* actually fetch byte
   memBase_ StackM2BR, T_ LTEMP0;
   TSP_ (store_ TSP) + 1, dbuf_ SmallHi;
   TSP_ (store_ TSP) - 1, dbuf_ T;
   memBase_ ScratchLZBR;
   T_ (Q) + 1;
   store_ LTEMP1, dbuf_ T, NextOpCode;



regOP1[40, StackM2BR, opBIN, streamType!];
:endif; *NOBIN

*--------------------------------------------------------------------
opREADPRINTERPORT:
*--------------------------------------------------------------------
	T_ NOT(EventCntA'), branch[PUSHSMALLT];
regOP1[164, StackM2BR, opREADPRINTERPORT, noNData];
*--------------------------------------------------------------------
opWRITEPRINTERPORT:
*--------------------------------------------------------------------
   T_ (TSP) - 1;
   fetch_ T;
   EventCntB_ Md, NextOpCode;

regOP1[165, StackBR, opWRITEPRINTERPORT, noNData];


*--------------------------------------------------------------------
opCAR:
*--------------------------------------------------------------------
   T_ (fetch_ TSP) + 1, call[TYPREV]; * returns with type in T
   PD_ (Id) - T, memBase_ ScratchLZBR;
.car1:
   branch[.carnlist, alu#0], BrHi_ LTEMP0;

	PAGEFAULTOK;

   T_ (FETCH_ LTEMP1) + 1;
   LTEMP0_ MD, fetch_ T;		* CAN FAULT

	PAGEFAULTNOTOK;

   T_ (LTEMP0) and (lhmask);
   branch[.+2, alu#0], LTEMP0_ T_ (LTEMP0) - T, memBase_ StackM2BR;
	LTEMP1_ Md, memBase_ ScratchLZBR, pd_ A0, branch[.car1];


   T_ Md, TSP_ (store_ TSP) + 1, dbuf_ T;
   TSP_ (store_ TSP) - 1, dbuf_ T, NextOpCode;

.carnlist:
   T_ (LTEMP1);
.crnlist:
   pd_ (LTEMP0) or T;
   branch[.+2, alu#0];
	NextOpCode;
	CallUFN;

regOP1[1, StackM2BR, opCAR, listType!];
*--------------------------------------------------------------------
opCDR:
*--------------------------------------------------------------------
   T_ (fetch_ TSP) + 1, call[TYPREV]; * returns with type in T
   pd_ (Id) - T, memBase_ ScratchLZBR;
.cdr1:
   branch[.cdrnlist, alu#0], BrHi_ LTEMP0;

	PAGEFAULTOK;

   T_ (FETCH_ LTEMP1) + 1;
   LTEMP0_ MD, T_ (fetch_ T) and (lhmask);

	PAGEFAULTNOTOK;

   LTEMP1_ T;

   branch[.cdrind, R>=0], LTEMP0, T_ ldf[LTEMP0, 7, 10];
   T_ T + T;
   branch[.cdrnil, alu=0], T_ T + (LTEMP1), memBase_ StackM2BR;

.cdronpage:
   TSP_ (TSP) + 1;
   TSP_ (store_ TSP) - 1, dbuf_ T, NextOpCode;

.cdrnil:
   TSP_ (store_ TSP) + 1, dbuf_ 0c;
   TSP_ (store_ TSP) - 1, dbuf_ 0c, NextOpCode;

.cdrind:	* indirect or local indirect
   T_ T + T;
   branch[.+2, alu#0];
	LTEMP1_ Md, memBase_ ScratchLZBR, pd_ A0, branch[.cdr1];

.cdrlocalind:
   T_ (LTEMP1) + T;
   T_ (fetch_ T) + 1;
   T_ Md, fetch_ T, branch[REPTMD];

.cdrnlist:
   T_ (LTEMP1), branch[.crnlist];

regOP1[2, StackM2BR, opCDR, listType!];

:if[NORPLACS];
	UfnOps[30];
	UfnOps[31];
	UfnOps[32];
:else;
*--------------------------------------------------------------------
opRPLACA:
*--------------------------------------------------------------------
   T_ (TSP) - (4c);
   T_ (fetch_ T) + 1, call[TYPREV];	* returns with type in T,
				* pointer in LTEMP0, LTEMP1
   PD_ T - (listType);
   branch[.+2, alu=0], LEFT_ (LEFT) + 1, memBase_ LScratchBR; 
	CallUFN;			* not a list

.rplaca1:
   BrHi_ LTEMP0;
   BrLo_ LTEMP1;

	PAGEFAULTOK;

   T_ (FETCH_ 0s) + 1;
   LTEMP0_ MD;

	PAGEFAULTNOTOK;

   PD_ (LTEMP0) and (lhmask);
   branch[.rplacaind, alu=0];
   branch[RPLPTR1];


.rplacaind:
   fetch_ T;
   LTEMP1_ Md, branch[.rplaca1];

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


*--------------------------------------------------------------------
opRPLACD:
*--------------------------------------------------------------------
   T_ (TSP) - (4c);
   T_ (fetch_ T) + 1, call[TYPREV];	* returns with type in T,
				* pointer in LTEMP0, LTEMP1
   PD_ T - (listType);
   branch[.+2, alu=0], LEFT_ (LEFT) + 1, memBase_ LScratchBR; 
	CallUFN;			* not a list

.rplacd1:
   BrHi_ LTEMP0, T_ A0;
   BrLo_ T;		* set LScratchBR to point to list cell's segment

	PAGEFAULTOK;

   LTEMP1_ (FETCH_ LTEMP1) + 1, Q_ LTEMP1;	 
   LTEMP2_ MD;			* LTEMP2 now has high word of cell

	PAGEFAULTNOTOK;

   branch[.rplacdind, R>=0], T_ (LTEMP2) and (77400c); * test hi bit of cell

* 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;
   branch[.rplacdnil, alu=0], pd_ T - (LTEMP0);
   branch[.rplacdnewcell, alu#0], LTEMP1_ Md, T_ (Md) xor (LTEMP1);
   pd_ T and not (rhmask);
   branch[.rplacdonpage, alu=0], T_ LTEMP0;
   	branch[.rplacdnewcell];

.rplacdonpage:
* must addref new cell
   CASE_ 0c, call[GCLOOKT1];
   memBase_ LScratchBR;
   LTEMP1_ (fetch_ Q) + 1;
   LTEMP4_ LSH[LTEMP4, 7];
   T_ Md, LTEMP4_ (LTEMP4) or (100000c);
   T_ T and (77400c), branch[.rplacdlocal];

.rplacdnil:
   LTEMP4_ 100000c;
   T_ (LTEMP2) and (77400c);

.rplacdlocal:
   branch[.rplacdnoref, alu=0], T_ RSH[T, 7]; * potentially deleteref old ptr
   LTEMP1_ (LTEMP1) and (lhmask);
   LTEMP1_ T + (LTEMP1);
   T_ LTEMP0;
   CASE_ 1c, call[GCLOOKT1];			* deleteref T,,LTEMP1
   memBase_ LScratchBR;	

.rplacdnoref:	* store new cdrcode
   fetch_ Q;
   T_ (rhmask);
   T_ T and (Md);
   T_ T + (LTEMP4);
   store_ Q, dbuf_ T, branch[GCOPTAIL];


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

.rplacdind:	* "local" bit was off
   branch[.rplacdlocalind, alu#0], T_ RSH[T, 7];
   LTEMP0_ Md, fetch_ LTEMP1;		* full indirect, fetch new cell
   LTEMP1_ Md, branch[.rplacd1];	* use new pointer

.rplacdlocalind:	* use CDR code as offset 
   LTEMP1_ (LTEMP1) and (lhmask);
   T_ T + (LTEMP1);
   BrLo_ T;
   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 have CDR
* LTEMP2, 3 hold new cons (and LScratchBR)
* LTEMP4 has CDR code (also used by .makeconscell subroutine)

   T_ (fetch_ TSP) + 1, call[TYPREV];
   pd_ (Id) - T, memBase_ LScratchBR;
   branch[.conslist, alu=0], T_ BRHi_ LTEMP0;
   pd_ T or (LTEMP1), memBase_ ListpDTDBR;
   dblbranch[.consnil, .consother, alu=0], LTEMP4_ (200c);	* cdrcode

.conslist:
   T_ ldf[LTEMP1, 7, 1];				* [src, size, pos];
   LTEMP4_ T + (200c);					* new cdr code
   T_ (LTEMP1) and (lhmask), branch[.constail];		* base of CDR's page

.consnil:
   fetch_ DTD.NEXTPAGEs;
   T_ Md, memBase_ LScratchBR;				* T_ nxtpage
   LTEMP0_ RSH[T, 10];
   branch[.+2, alu#0], BRHi_ LTEMP0;
	branch[.consfail];
   T_ LSH[T, 10];

.constail:
   LTEMP1_ BrLo_ T;

	PAGEFAULTOK;

   FETCH_ 0s;
   LTEMP3_ MD;					* word 0 of page: [cnt, nxt]

	PAGEFAULTNOTOK;

   branch[.cnsod1, R odd], LTEMP3,
      T_ LTEMP3_ (LTEMP3) - (400c);
   branch[.+2, alu>=0], T_ T and (rhmask);	* "next"
	branch[.consfail];			* no cells left
   branch[.cnszer, alu=0],
     LTEMP1_ (fetch_ T) + (LTEMP1);		* fetch next
   T_ Md, LTEMP3_ RSH[LTEMP3, 10];		* T_ [nxt,x], LTEMP3_ cnt
   LTEMP3_ RCY[LTEMP3, T, 10];			* [cnt,nxt]
   branch[.cnsod2, R odd], store_ 0s, dbuf_ LTEMP3;

   BRLo_ LTEMP1;

   T_ LTEMP0;
   Case_ 1c, call[GCLOOKT1];			* deleteref new cell


   memBase_ ListpDTDBR;				* increment conscount
   fetch_ DTD.COUNTERs;
   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;
   LTEMP0_ Md, T_ (store_ T) + 1, dbuf_ LTEMP0;
   fetch_ T;
   LTEMP1_ Md, store_ T, dbuf_ LTEMP1;		 * save new cell on stack


   T_ lsh[LTEMP4, 10];				* shift cdrcode
   T_ (LTEMP0) or T;				* merge with new CAR
   LTEMP1_ Md, memBase_ LScratchBR;
   store_ 0s, dbuf_ T;
   store_ 1s, dbuf_ LTEMP1;

   T_ LTEMP0;
   Case_ A0, call[GCLOOKT1];			* addref new CDR

   Case_ A0, memBase_ StackBR;
   T_ (fetch_ TSP) + 1, call[GCLOOKUP];		* addref new CDR
   branch[GCOPTAIL];

.consother:
   CallUFN;

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

.cnsod1:
   uCodeCheck[badcons];

.cnsod2:
   uCodeCheck[badcons];

.cnszer:
   uCodeCheck[badcons];

.consfail:
   CallUFN;

:endif;	* NORPLACS

z19650(1792)\5632f8 10f0 2212f8 2f0 5287f8 2f0 15f8 4f0 16f8 4f0