:Title[LOPS];
* Edit history:
* Masinter, August 7, 1985  8:25 PM, add EQL, EQUAL
* March 29, 1985  2:01 PM, make MISC1 also turn on ether
* March 29, 1985  11:00 AM, Masinter, make CREATECELL ufn if free list NIL
* March 22, 1985, 12:04, Masinter, change TYPEMASK, reformat
* January 21, 1985  12:00 PM,  Masinter, unglobal REPSMALLT
* January 19, 1985  1:56 PM, Masinter, add TYPEMASK, assume TYPREV masks bits
* March 5, 1984  7:30 PM, JonL, added opMISC1 (alpha 9) for opRWMufMan
*	 (and retracted opRWMufMan as an opcode).  GLOBALized REPSMALLT
* February 18, 1984  2:47 PM, JonL, added opRWMufMan
* February 18, 1984  12:53 PM, JonL, fix parity of branch condition for
*	opEVAL of litatom; tried BDispatch in opEVAL again
* February 2, 1984  5:08 PM, JonL, opBIN checks bits[4:7] of BR for zero
* January 26, 1984  7:40 PM, JonL, spawned LLISTP off from this file;
*		opEVAL uses BDispatch.
* January 26, 1984  6:59 PM, JonL, opNOP and NEXTOP to LJUMP
* January 7, 1984  5:38 PM, JonL, added commentary on TYPEP
* January 6, 1984, 8:18 AM, JonL, fixed TL.CREATECELL to take an arg in
*	NARGS which is the number of words to "pull back" on TSP
* December 29, 1983  6:59 PM, JonL, "bubbled" inst in CREATECELL 
*	{memBase← StackM2BR, T← TSP} into previous inst, and replaced 
*	a few "0c"'s with (atomHiVal)'s;  changed (MaxConsCount) test in
*	CREATECELL to use carry'; TYPEP tails into REPSMT2; shortened BIN 
*	by saving CCOFF in T over DOGETBYTE, and tailing into REPSMALLT
*	Put error checking into WRITEPRINTERPORT; CDR tails into
*	TL.PUSHNIL etc
* December 27, 1983  6:30 PM, JonL, changed calls to GCLOOKT1 into calls 
*	to GCADDREF or GCDELREF
* December 26, 1983  6:53 PM, JonL, move in opEQ and opNOP from LOW,
*	let opEQ call ABFETCH and tail-out into TL.PUSHTRUE (or NIL)
* December 26, 1983  6:40 PM, JonL, fixed callers of TYPREV to watch out 
*	for non-zero TT.*** bits
* December 21, 1983  5:15 AM, JonL, opRCLK from LOW, NEXTOP from from 
*	LSTACK, moved opPOP to LSTACK, tailed opNTYPX into REPSMALLT
* December 19, 1983  1:01 PM, JonL, TL.CREATECELL. Args in CELLHINUM and
*	CELLLONUM 
* December 15, 1983  3:42 PM, JonL, Put in labels REPSMALLT and TL.REPT
* November 29, 1983  4:42 PM, Masinter, change carry to < on createcell

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


*--------------------------------------------------------------------
SUBROUTINE;	TYPREV:	* Get type of datum from cell being fetched from T
*--------------------------------------------------------------------
* Enter having done 
*  T← (fetch← <someLoc>) + 1,   call[TYPREV];
* Exit with Ahi in LTEMP0
*           Alo in LTEMP1
*           typenumber in T

   T← LTEMP0← Md, fetch← T;
   LTEMP1← Md, memBase← tybaseBR;
   T← RCY[T, LTEMP1, 11];
   fetch← T, T← (rhmask);
   T← (T) and (Md), memBase← StackM2BR, return;

TOP LEVEL;
*--------------------------------------------------------------------
opEQ:
*--------------------------------------------------------------------
	T← (fetch← TSP) - 1, flipMemBase, call[ABFETCH];
	T← Md, TSP← (fetch← T) - 1;
	T← Md, pd← T xor (LTEMP0);
	branch[.+2, alu=0], pd← (T) xor (LTEMP1);
	  LEFT← (LEFT) + 1, branch[.neq];
	branch[.neq, alu#0], LEFT← (LEFT) + 1;
	  TSP← (store← TSP) + 1, dbuf← (atomHiVal), branch[TL.PUSHTRUE];
.neq:
	TSP← (store← TSP) + 1, dbuf← (atomHiVal), branch[TL.PUSHNIL];

regOP1[360, StackM2BR, opEQ, noNData];

*--------------------------------------------------------------------
opEQL:  
*--------------------------------------------------------------------
	T← (fetch← TSP) - 1, flipMemBase, call[ABFETCH];
	T← Md, TSP← (fetch← T) - 1;
	pd← T xor (LTEMP0);
	branch[.+2, alu=0], pd← (Md) xor (LTEMP1);
	  LEFT← (LEFT) + 1, branch[.neql];
	branch[.+2, alu#0], LEFT← (LEFT) + 1;
	  TSP← (store← TSP) + 1, dbuf← (atomHiVal), branch[TL.PUSHTRUE];
.NEQL:
	PD ← LTEMP0;
	branch[.+2, alu#0], pd ← T;
		TSP← (store← TSP) + 1, dbuf← (atomHiVal), branch[TL.PUSHNIL];
	branch[.+2, alu#0];
		TSP← (store← TSP) + 1, dbuf← (atomHiVal), branch[TL.PUSHNIL];

	TSP ← (TSP) + (4C);
opEQUAL:
	CallUFN;

regOP1[72, StackM2BR, opEQL, NoNData];    * EQL
regOP1[364, StackM2BR, opEQL, NoNData]; * EQUAL
*--------------------------------------------------------------------
opNTYPX:
*--------------------------------------------------------------------
	T← (fetch← TSP) + 1,   call[TYPREV];

*--------------------------------------------------------------------
REPSMALLT:  	
*--------------------------------------------------------------------
*    Store a smallp into the Top-of-Stack slot;
*    Assumes TSP is correct and StackM2BR is memBase

	PAGEFAULTNOTOK;
	TSP← (store← TSP) + 1, dbuf← smallHi;
REPSMT2:
	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;				* fetch type name of DTD
	T← LSH[T, 4];
PAGEFAULTOK;
	FETCH← T, T ← LTEMP0, RisID;		* This is like T← (Id);
	T← LSH[T, 10];				* Get the litatom index
	T← (Id) + T;				* same ID
	pd← T - (MD);
PAGEFAULTNOTOK;
	branch[.+2, alu=0];
		CallUFN;			* type disagree
	NextOpCode;

regOP3[6, StackM2BR, opDTEST, noNData]; * this one is "coerce"
regOP3[56, StackM2BR, opDTEST, noNData]; * this one is "typecheck"

*--------------------------------------------------------------------
opTYPEP:		* TYPEP, LISTP same code
*--------------------------------------------------------------------
	T← (fetch← TSP) + 1, call[TYPREV];
	pd← (Id) xor T;
.typepTAIL:
	branch[.+2, alu#0], T← AT.NIL;
		NextOpcode;			* Continue if type same
	TSP← (store← TSP) + 1, dbuf← (atomHiVal), * Otherwise, return NIL
		branch[TL.REPNIL2];

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

*--------------------------------------------------------------------
opTYPEMASK:		* used for NUMBERP, FIXP, etc.
*--------------------------------------------------------------------
   T← (fetch← TSP) + 1;
   T← Md, fetch← T;
   LTEMP1← Md, memBase← tybaseBR;
   T← RCY[T, LTEMP1, 11];
   fetch← T;
   T← Md, memBase← StackM2BR;
   T← RSH[T,10];
   pd← (Id) and T;
   branch[.+2, alu=0], T← AT.NIL;
      NextOpcode;			* Continue if type same
   TSP← (store← TSP) + 1, dbuf← (atomHiVal), branch[TL.REPNIL2];

regOP2[63, StackM2BR, opTYPEMASK, noNData];

*--------------------------------------------------------------------
opCREATECELL:
*--------------------------------------------------------------------
	T← (fetch← TSP) + 1;
	T← Md, CELLHINUM ← (fetch← T) - T;	* TOS = typenumber
	pd← NARGS← T - (SmallHi);		* NARGS← 0 if normal 
	branch[.+2, alu=0], T← Md, memBase← dtdBR, CELLLONUM ← T - T;		  CallUFN;				* non-small arg
	T← LSH[T, 4];				* 2↑4 wds per entry

TL.CREATECELL:
* Enter with T has the datatype number multiplied by the number of 
*  words per DTD entry;
* DEFHI has hiword value for first cell
* DEFLO has loword value for first cell
* NARGS has the number of words to "pull back" on TSP when done
* memBase is dtdBR
	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); 
	pd← LTEMP0;			* LTEMP0, LTEMP1 ← freelist head
	branch[.+2, alu#0], LTEMP1← Md, fetch← T;
	  CallUFN;    			* free list is empty
	LTEMP3← Cnt← Md;		* LTEMP3, Cnt ← size in wds
	branch[.+2, Cnt#0&-1], memBase← ScratchLZBR;
	  UCodeCheck[allocateZeroSizeCell];
	BrHi← LTEMP0;
PAGEFAULTOK;
	T← (FETCH← LTEMP1) + 1;		* fetch contents of free
	branch[.+2, Cnt#0&-1], LTEMP4← MD, T← (fetch← T) - (2c);
		UCodeCheck[allocateOneSizeCell];
PAGEFAULTNOTOK;
	LTEMP3← Md, T← T + (LTEMP3);				* loloc+size-1

.clearnew:
PAGEFAULTOK;
	T← (STORE← T) - 1, dbuf← 0c, branch[., Cnt#0&-1];
PAGEFAULTNOTOK;
.cleardone:

* All but first word has been cleared. Store args into 1st and 2nd word
   T← (store← T) +1, dbuf← CELLHINUM;
   store← T, dbuf← CELLLONUM;

	T← LTEMP2, memBase← dtdBR;		* store new free cell
	T← (store← T) - 1, dbuf← LTEMP3;
	store← T, pd← dbuf← LTEMP4;
	branch[.+2, alu#0], LTEMP2← (LTEMP2) +
		 (sub[DTD.COUNTER!,add[1,DTD.FREE!]]c);
	   PSTATE← (PSTATE) or (PS.HTCNTFULL);	* freelist became empty ?
   fetch← LTEMP2;
   T← (Md) + 1;					* Add 1 to conscounter
   store← LTEMP2, dbuf← T;
   pd← T - (MaxConsCount);
	T← NARGS, FreezeBC;
   branch[.+2, carry'], T← TSP← (TSP) - T, memBase← StackM2BR;	
			* Exceeded MaxConsCount allocations of this type ?
	   PSTATE← (PSTATE) or (PS.HTCNTFULL);	

* Result is address of newly allocated cell, which is smashed onto TOS
   T← (store← T) + 1, dbuf← LTEMP0;
   store← T, dbuf← LTEMP1;
*		DELREF on new cell, so implicit refcnt of 1 goes to 0
	Case← 1c, Call[GCLOOKUP1];	
   LTEMP4← (4c), Branch[GCOPTAIL];

regOP1[37, StackM2BR, opCREATECELL, noNData];


*--------------------------------------------------------------------
opBIN:
*--------------------------------------------------------------------
	T← (fetch← TSP) + 1, call[TYPREV];	* returns with type in T
	PD← (Id) xor T, memBase← ScratchLZBR;	* Set ScratchLZR to base of
	Branch[.+2, alu=0], BrHi← LTEMP0;	*  segment containg STREAMP
	   CallUFN;				* Arg not a STREAMP ?
PAGEFAULTOK;
	T← (FETCH← LTEMP1) + 1;
	LTEMP0← MD, T← (fetch← T) + 1;		* LTEMP0 ← CCOFF
PAGEFAULTNOTOK;
	T← Md, LTEMP2← (fetch← T) + 1;		* T ← NCCHARS
	LTEMP0← Md, pd← T - (Q← LTEMP0) - 1;	* LTEMP0 ← HiBuf, Q  ← CCOFF
															* also pd← NCCHARS-CCOFF-1
	Branch[.+2, carry], LTEMP2← (fetch← LTEMP2) - (3c);
	   CallUFN;				* Punt -- end of bufload
	Branch[.+2, R<0], LTEMP0, memBase← ScratchBR;
	   CallUFN;				* Punt -- readable bit off
	T← Md, pd← (LTEMP0) and (7400c);
	Branch[.+2, alu=0], BrHi← LTEMP0;	*setup BR to base of buffer
	  uCodeCheck[ExtraBitsInBufferAddress];
	BrLo← T, T← LTEMP1← Q, Call[.getByte];	*  and actually fetch byte

	memBase← ScratchLZBR, T← T + 1;		* Now increment CCOFF
	store← LTEMP2, dbuf← T;
	memBase← StackM2BR, T← LTEMP1, Branch[REPSMALLT];

regOP1[40, StackM2BR, opBIN, streamType!];

*--------------------------------------------------------------------
opMISC1:
*--------------------------------------------------------------------
* One arg miscellaneous opcode
	T← ID;
	pd← (T) - (11c);
	Branch[opRWMufMan, alu=0], pd← (T) - (12c);
	Branch[Reset10MBEther, alu=0];
	   callUFN;

regOP2[170, StackM2BR, opMISC1, noNData];

*--------------------------------------------------------------------
opRWMufMan:
*--------------------------------------------------------------------
* One arg, a PosSMALLP, whose low-order 11 bits are a Muffler/Manifold
*	address.  If the high-order bit (i.e., 2↑15) is off, then read the
*	the addressed muffler and return it's bit as the high-order bit of
*	a PosSMALLP; if it is on, then execute the corresponding Manifold
*		operation and return NIL.

	T← (fetch← TSP) - 1, flipMemBase, Call[.UNBOX1];
	T← 13s;
	pd← LTEMP0, Cnt← T;
	Branch[.+2, alu=0],TSP← (TSP) + (2c);	* Restore TSP
		CallUfn;
	flipMemBase;	* Both exits expect memBase to be StackM2Br
.rwmmlp:	
	MidasStrobe← Q;		* 11. iterations of strobe
	Q lsh 1;		* and shift
	nop;
	Branch[.rwmmlp, Cnt#0&-1];

	Branch[.+2, R>=0], LTEMP1;	* Don't do flipMembase here, 
	  UseDMD, Branch[REPNIL];	*  because that constrains 
	T← ALUFMEM, Branch[REPSMALLT];	*  too many locations




*--------------------------------------------------------------------
opRCLK:
*--------------------------------------------------------------------
   T← (fetch← TSP) + 1;
   LTEMP0← Md, fetch← T, T← (30c);		* LTEMP0 ← HiAddr to clobber
   LTEMP1← Md, memBase← MDS;			* LTEMP1 ← LoAddr to clobber
   T← T + (400c);
   taskingOff;
   fetch← T;									* fetch word 430 for hi part of clock
   LTEMP2← Md, rbase← rbase[RTClock];		* LTEMP2 ← hiword of clock
   T← RTClock;					* T ← loword of clock
   taskingOn;	
   rbase← rbase[LTEMP0];
   memBase← ScratchLZBR;
   BrHi← LTEMP0;
PAGEFAULTOK;
   LTEMP1← (store← LTEMP1) + 1, dbuf← Md;
PAGEFAULTNOTOK;
   store← LTEMP1, dbuf← T, nextOpCode;

regOP1[167, StackM2BR, opRCLK, noNData];


*--------------------------------------------------------------------
opREADPRINTERPORT:
*--------------------------------------------------------------------
	T← NOT(EventCntA'), branch[PUSHSMALLT];
regOP1[164, StackM2BR, opREADPRINTERPORT, noNData];

*--------------------------------------------------------------------
opWRITEPRINTERPORT:
*--------------------------------------------------------------------
	T← (fetch← TSP) - 1, flipMemBase; * Using .UNBOX1 here 
	T← Md, fetch← T;		*  would only save 1
	pd← T - (SmallHi), T← Md;	*  IM loc, but cost
	Branch[.+2, alu=0];		*  an extra 3 cycles
		CallUfn;
   EventCntB← T, NextOpCode;

regOP1[165, StackM2BR, opWRITEPRINTERPORT, noNData];

regOP1[54, StackM2BR, opEVAL, noNData];
*--------------------------------------------------------------------
opEVAL:
*--------------------------------------------------------------------
	T← (fetch← TSP) + 1, call[TYPREV];
	pd← T and (370c);			* Only the first 8 type codes 
	Branch[.+2, alu=0], T← T and (7c);	*  are handled by ucode
		CallUFN;

	BDispatch← T;
	Branch[.evdispatch];
.evdispatch:	DispTable[10],
	CallUfn;		* Type 0 is randomness
	NextOpCode;		* Smallp
	NextOpCode;		* Fixp
	NextOpCode;		* Floatp
	FVNAME← pd← (LTEMP1), Branch[.evatom];	* Litatom.  "xor (AT.NIL)"
	NARGS← (1c), Branch[.evListp];	* Listp
	NextOpCode;		* Arrayp
	NextOpCode;		* Stringp

%	code use to read:
	pd← T - (atomType);
	branch[.evalatom, alu=0], pd← T;
	branch[.evalother, alu=0], pd← T - (add[FixpType!, 1]c);
	branch[.evalret, alu<0], pd← T - (ListType);
	branch[.evListp, alu=0], NARGS← 1c;
	CallUFN;		* not atom, fixp, listp
.evalother:
	CallUFN;		* let UFN decide
.evalret: NextOpCode;		* return self
.evalatom:
	FVNAME← pd← (LTEMP1);	* "xor (AT.NIL)"
%

.evatom:
	Branch[.+2, alu#0], pd← (FVNAME) xor (AT.T);
		NextOpCode;		* eval of NIL=NIL
	Branch[.+2, alu#0], T← (FX.PVAR);
		NextOpCode;		* eval of T=T
	nop;		* Call can be false target of conditional branch
	FVEP← (PVAR) - T, Call[DOLOOKUP];
	memBase← ScratchLZBR;
	BrHi← FVHI;
PAGEFAULTOK;
	T← (FETCH← FVLO) + 1;		* Might fault, since it 
	T← Md, fetch← T;		*  may be global cell
PAGEFAULTNOTOK;
	pd← (FVHI) - (StackHi);
	Branch[.+2, alu#0], memBase← StackM2BR;
		Branch[REPTMD1];	* Stack-bound value is OK
	pd← (add[AT.NOBIND!]s) xor (Md);
	Branch[REPTMD1, alu#0];		* Global binding ok
	CallUFN;			* Hmmm, NOBIND in topcell

.evListp:
	DEFLO← AT.EVALFORM, Branch[DOCALLPUNT];

REPTMD:  * Replace value on top of stack with value in T,,MD
	memBase← StackM2BR;
REPTMD1:
	T← Md, TSP← (store← TSP) + 1, dbuf← T;
	TSP← (store← TSP) - 1, dbuf← T, NextOpcode;