:Title[LMEM];
* Edit History
* March 11, 1985  6:17 PM, Masinter, fix bug where BLT
* 		of number > 2↑15 would always exit
* February 2, 1985  2:55 PM, Masinter, attempt to fix bug where BLT
* January 21, 1985  11:54 AM, Masinter, bum VAG2 a bit, clean up a 
*		PAGEFAULTOK or two
* January 17, 1984  4:02 AM, JonL, added .pbsFetch for PUTBASEN and
*		PUTBITS
* January 17, 1984  2:10 AM, JonL, added .gbsFetch for use by GETBASEN,
*		GETBASEPTRN, and GETBITS; also tailed them out thru REPSMT2
* January 17, 1984  1:25 AM, JonL, abstracted .addrNfetch, changed
*		DOGETBYTE to .getByte and let it use LTEMP1 instead of LTEMP0
* January 17, 1984  12:51 AM, JonL, squeezed one inst out of opADDBASE
* January 13, 1984  10:42 PM, JonL, spawned LMEM off LOW.mc
* January 4, 1984  7:08 PM, JonL, tailed opPUTBASEPTR and opPUTBITS
*		into TL.POP1.  
* December 15, 1983  3:45 PM, JonL,  HILOC to tail into REPTMD1

*--------------------------------------------------------------------
* Low-Level Memory referencing
*--------------------------------------------------------------------

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


*--------------------------------------------------------------------
opHILOC:
*--------------------------------------------------------------------
   fetch← TSP, T← (SmallHi), branch[REPTMD1];

regOP1[322, StackM2BR, opHILOC, noNData];

*--------------------------------------------------------------------
opLOLOC:
*--------------------------------------------------------------------
   store← TSP, dbuf← SmallHi, NextOpCode;

regOP1[323, StackM2BR, opLOLOC, noNData];

*--------------------------------------------------------------------
opADDBASE:
*--------------------------------------------------------------------
	T← (fetch← TSP) - 1, flipMemBase, Call[.addrNfetch];
	branch[.adbs1, alu#0], LTEMP1← (LTEMP1) + (Md);	* + Lo.word of addr
	branch[.+2, carry], LEFT← (LEFT) + 1;
		TSP← (store← T) + 1, dbuf← LTEMP1, NextOpCode; * Done - fast case
   T← (store← T) - 1, dbuf← LTEMP1;			* Carry over into next
   TSP← (fetch← T) + (2c);				*  next segment
   LTEMP0← (1s) + (Md);
   store← T, dbuf← LTEMP0, NextOpCode;

SUBROUTINE;
.addrNfetch:
* Enter and exit with StackBR
* Leaves 0 on pd iff TOS is a smallposp
	LTEMP0← Md, T← (fetch← T) - (2c);	* LTEMP0← Hi.word of n
	LTEMP1← Md, (fetch← T);			* LTEMP1← Lo.word of n
	pd← (LTEMP0) xor (SmallHi), Return;	* Is n a smallP?
TOPLEVEL;

.adbs1:
	CallUFN;
%	*  This could continue something like . . .
	LEFT← (LEFT) - 1, memBase← StackM2BR;
	T← (fetch← TSP) - 1, flipMemBase, Call[.UNBOX1];
	T← (TSP) + 1, flipMemBase;						* Change back to StackM2BR
	T← (fetch← T) - 1;								* TSP was "pulled back" 
	(fetch← T), LTEMP1← Md;							* LTEMP1← lo.word of addr
	T← (LTEMP1) + Q, LTEMP1← T;					* Lo.word sum
	LTEMP0← (LTEMP0) + (Md), XorSavedCarry;	* Hi.word sum
	T← (store← LTEMP1) + 1, dbuf← T;				* Store Lo.word
	(store← T), dbuf← LTEMP0, NextOpCode;		* Store Hi.word
%

regOP1[320, StackM2BR, opADDBASE, noNData];

*--------------------------------------------------------------------
opVAG2:
*--------------------------------------------------------------------
	T← (fetch← TSP) - 1, flipMemBase, Call[.UNBOX2];
	T← (store← TSP) + 1, dbuf← Q;
	TSP← (store← T) + 1, dbuf← LTEMP1, NextOpCode;

regOP1[321, StackM2BR, opVAG2, noNData];

*--------------------------------------------------------------------
opBLT: * (destinationaddr sourceaddr #wds)
*--------------------------------------------------------------------
* Defined to move one word at a time, from the high end to the
*   low end, and be continuable after interrupts.
* These highly-bummed ideas are taken from Taft's implementation of 
*  Mesa BLT and BLTL, found in DMesaRW.mc
* Enter with: 
*		Q set to 20b
*        T set to number of words to move minus one
*        stack has running count (minus 1)
* Branch back around the loop:  
*		stack updated to next value
*        T set up 17 for the next full munch
* Before starting the transfer, touch the last word of the source and
*  destination blocks, to force any page faults that would happen, to
*  happen now rather than in the inner loop.  Maybe need not touch the 
*  first words, since a fault there will abort the loop before it has 
*  done anything permanent.  Also, "pre-warm" the cache for the next 
*  time around.

	T← (fetch← TSP) - 1, flipMemBase, Call[.addrNfetch];
	Branch[.+2, alu=0], T← T - 1;	
		CallUFN;					* Punt: #wds not smallposp
	LTEMP2← Md, T← (fetch← T) - 1;		* Why 2 for StkP? 'Cause
	LTEMP0← Md, T← (fetch← T) - 1;		*  BitBlt does it that way
	LTEMP3← Md, (fetch← T), T← (2c);	* Fetch on hi.word of Dest
	T←  pd← LTEMP1, StkP← T;		* LTEMP1 had #wds to move	branch[.bltxit, alu=0],			* zero words to transfer?
	 T← Md, stack← T - 1, memBase← BBDSTBR;	* Stack← #wds-1
	branch[.+2, alu>=0], BRHi← T;
		CallUFN;		* call UFN if > 2↑15 words
	T← (20c); 
	Q← T, T← T - 1;				* Q← (20c), T← (17c)
	BRLo← LTEMP3;
	T← (stack) and T, memBase← BBSRCBR;	* T← #wds-1 mod 20b
	BRHi← LTEMP0;
	BRLo← LTEMP2;
	PSTATE← (add[PS.PFOK!, PS.INBLT!]c); 

.bltloop:
	Cnt← T;
	LTEMP0← T← (FETCH← stack) - T;		* Fetch on first src wd
	LTEMP2← (FETCH← T) - (Q);			* Fetch on last src wd
	PreFetch← LTEMP2, flipMemBase;
	FETCH← stack;					* Fetch on first dest wd
	FETCH← LTEMP0;					* Fetch on last dest wd
	PreFetch← LTEMP2, T← MD, flipMemBase;	* Synchronize PageFaults
***   Here's the tight inner loop to move a munch
.bltmm:
	fetch← stack, flipMemBase;
	stack← (STORE← stack) - 1, dbuf← Md, flipMembase, 
		Branch[.bltmm, Cnt#0&-1];	
***	
	pd← stack, Branch[.+2, Reschedule'];	* Tails into BitBlt code if 
		Branch[BBXitToContinue];										*  need to xit for interrupt
	T← (17c), Branch[.bltloop, alu>=0];	* Should be 17 or -1, not 0

.bltdone:
	PSTATE← A0;
.bltxit:
	LEFT← (LEFT) + (2c);								* LEFT is re-computed if
	TSP← (TSP) - (4c), NextOpCode;		*  there is a fault-out

%

	T← (fetch← TSP) + 1;
	LTEMP0← Md, T← (fetch← T) - (2c);
	pd← (LTEMP0) xor (SmallHi);
	branch[.+2, alu=0], LTEMP2← Md, T← (fetch← T) - 1;
		CallUFN;
	LTEMP1← Md, T← (fetch← T) - 1;
	LTEMP0← Md, T← (fetch← T) - 1;
	LTEMP3← Md, fetch← T, pd ← T← (LTEMP2);
	branch[.+2, alu#0], LTEMP2← Md, memBase← BBDSTBR, T← T - 1;
		branch[.bltdone];	* no words to copy
	Cnt← T;  			* number of words to transfer - 1
	BRHi← LTEMP2;
	BRLo← LTEMP3;
	memBase← BBSRCBR;
	BRHi← LTEMP0;
	BRLo← LTEMP1;

* and now for the loop. This should really keep state in Stack a la BITBLT:
	PAGEFAULTOK;

	FETCH← T, flipMemBase;
	T← (store← T) - 1, dbuf← MD, flipMembase, branch[.-1, Cnt#0&-1];

	PAGEFAULTNOTOK;

.bltdone:
	Left← (Left) + (2c);
	TSP← (TSP) - (4c), NextOpCode;
%

regOP1[304, StackM2BR, opBLT, noNData];


*--------------------------------------------------------------------
opGETBASEN:
*--------------------------------------------------------------------
	T← (fetch← TSP) + 1, Call[.gbsFetch];
PAGEFAULTOK;
	IFETCH← LTEMP0;
	T← MD, memBase← StackM2BR, Branch[REPSMALLT];

regOP2[310, StackM2BR, opGETBASEN, noNData];

SUBROUTINE;
.gbsFetch:
	T← Md, fetch← T, LTEMP1← (rhmask);
	LTEMP0← Md, memBase← ScratchLZBR;
	BrHi← T, Return;
TOPLEVEL;

*--------------------------------------------------------------------
opGETBITS: 
*--------------------------------------------------------------------
	T← (fetch← TSP) + 1, Call[.gbsFetch];
PAGEFAULTOK;
	IFETCH← LTEMP0, TisID;
	memBase← StackM2BR;
	LTEMP0← MD, RF← Id;
	T← ShiftLMask[LTEMP0], memBase← StackM2BR, Branch[REPSMALLT];

regOP3[312, StackM2BR, opGETBITS, noNData];

*--------------------------------------------------------------------
opGETBASEPTRN: 
*--------------------------------------------------------------------
	T← (fetch← TSP) + 1, Call[.gbsFetch];
PAGEFAULTOK;
	LTEMP0← (IFETCH← LTEMP0) + 1;
	T← MD, ifetch← LTEMP0;
PAGEFAULTNOTOK;
	T← T and (LTEMP1), memBase← StackM2BR;
	T← Md, TSP← (store← TSP) + 1, dbuf← T, Branch[REPSMT2];

regOP2[311, StackM2BR, opGETBASEPTRN, noNData];


*--------------------------------------------------------------------
opGETBASEBYTE:
*--------------------------------------------------------------------
	T← (fetch← TSP) - 1, flipMemBase, Call[.addrNfetch];	* See opADDBASE
	branch[.+2, alu=0], T← T - 1;
		CallUFN;								* Index not smallPosp
	fetch← T, LTEMP0← Md;
   memBase← LScratchBR, LEFT← (LEFT) + 1;
   LTEMP0← Md, BrLo← LTEMP0;
   BrHi← LTEMP0, call[.getByte];
   T← (store← T) + 1, dbuf← SmallHi;
   TSP← (store← T) + 1, dbuf← LTEMP1, NextOpCode;

regOP1[302, StackM2BR, opGETBASEBYTE, noNData];


SUBROUTINE;
.getByte:
* called by BIN, GETBASEBYTE;
* Assumes current memBase is pointer, LTEMP1 is byte offset
* Returns byte in LTEMP1
* Must not clobber T
	dblbranch[.dgbeven, .dgbodd, R even], LTEMP1← (LTEMP1) rsh 1;
.dgbeven:
  PAGEFAULTOK;
	FETCH← LTEMP1;
	LTEMP1← MD, memBase← StackBR;
  PAGEFAULTNOTOK;
	LTEMP1← RSH[LTEMP1, 10], return;
.dgbodd:
  PAGEFAULTOK;
	FETCH← LTEMP1;
	LTEMP1← MD, memBase← StackBR;
  PAGEFAULTNOTOK;
	LTEMP1← (LTEMP1) and (rhmask), return;

TOP LEVEL;

*--------------------------------------------------------------------
opPUTBASEN:
*--------------------------------------------------------------------
	T← (fetch← TSP) + 1, Call[.pbsFetch];			* fetch val hi
	STORE← T, dbuf← LTEMP0;
:if[Debugging];
   T← MD, TSP ← (TSP) - (2c);
	PAGEFAULTNOTOK, NextOpCode;
:else;
   T← MD, TSP ← (TSP) - (2c), NextOpCode;			* wait for faults
:endif;

SUBROUTINE;
.pbsFetch:
	LTEMP0← Md, T← (fetch← T) - (3c);				* LTEMP0← Hi.newByte
	pd← (LTEMP0) xor (SmallHi);						* check for smallPosp
	branch[.+2, alu=0], LTEMP0← Md, Q← Md,			* LTEMP0← newByte
						T← (fetch← T) + 1;
		TOPLEVEL; CallUFN; SUBROUTINE;							
	LTEMP2← Md, fetch← T;								* LTEMP2← Hi.addr
	LEFT← (LEFT) + 1, memBase← ScratchLZBR;
	T← (Id) + (Md);										* T← Lo.addr + alpha
	branch[.+2, carry'], BrHi← LTEMP2;
		LTEMP2← (LTEMP2) + 1, branch[.-1];
:if[Debugging];
	PAGEFAULTOK, Return;
:else;
	Return;
:endif;
TOPLEVEL;

regOP2[315, StackM2BR, opPUTBASEN, noNData];

*--------------------------------------------------------------------
opPUTBITS:
*--------------------------------------------------------------------
   T← (fetch← TSP) + 1, Call[.pbsFetch];			* fetch val hi
	FETCH← T;
	WF← Id, LTEMP1← T;
	T← ShMdBothMasks[LTEMP0];
PAGEFAULTNOTOK;
	store← LTEMP1, dbuf← T, Branch[TL.POP1];

regOP3[317, StackM2BR, opPUTBITS, noNData];


*--------------------------------------------------------------------
opPUTBASEPTRN:
*--------------------------------------------------------------------
	T← (fetch← TSP) + 1;									* fetch val hi
	LTEMP0← Md, T← (fetch← T) - (3c);				* fetch val lo
	Q← Md, T← (fetch← T) + 1;							* fetch addrhi
	LTEMP2← Md, fetch← T;								* LTEMP0, Q have newval
	memBase← ScratchLZBR, LEFT← (LEFT) + 1;
	T← (Id) + (Md);
	branch[.+2, carry'], BrHi← LTEMP2;
		LTEMP2← (LTEMP2) + 1, branch[.-1];
:if[Debugging];
PAGEFAULTOK;
	T← (STORE← T) + 1, dbuf← LTEMP0;
	STORE← T, dbuf← Q;
PAGEFAULTNOTOK, Branch[TL.POP1];
:else;
	T← (STORE← T) + 1, dbuf← LTEMP0;
	STORE← T, dbuf← Q, Branch[TL.POP1];
:endif;

regOP2[316, StackM2BR, opPUTBASEPTRN, noNData];


*--------------------------------------------------------------------
opPUTBASEBYTE:	* PUTBASEBYTE(base, displacement, value)
*--------------------------------------------------------------------
   T← (TSP) - 1;
   T← (fetch← T) - 1;
   LTEMP0← Md, T← (fetch← T) - 1;	* LTEMP0 has new byte
   pd← (LTEMP0) and not (rhmask);
   LTEMP1← Md, T← (fetch← T) - 1, branch[.+2, alu=0];   
	CallUFN;
   pd← (LTEMP1) xor (SmallHi);
   LTEMP1← Md, T← (fetch← T) - 1, branch[.+2, alu=0];* LTEMP1←offset
	CallUFN;
   LTEMP2← Md, T← (fetch← T) - 1;
	pd← (LTEMP2) xor (SmallHi);
   LTEMP2← Md, fetch← T, branch[.+2, alu=0];
	CallUFN;
   LEFT← (LEFT) + 1, memBase← LScratchBR;
   LTEMP2← Md, BrLo← LTEMP2;
   BrHi← LTEMP2;


	PAGEFAULTOK;

   branch[.putRight, R odd], LTEMP1← (LTEMP1) rsh 1;
   FETCH← LTEMP1;
   T← Md, TSP← T;	* CAN FAULT
   T← T and (rhmask);
   Q← LTEMP0;
   LTEMP0← LSH[LTEMP0, 10];
   T← T + (LTEMP0), branch[.restoreByte];

.putRight:
   FETCH← LTEMP1;
   T← Md, TSP← T;	* CAN FAULT
   T← T and (lhmask);
   T← T + (LTEMP0), Q← LTEMP0, branch[.restoreByte];

.restoreByte:
   store← LTEMP1, dbuf← T;

	PAGEFAULTNOTOK;

   LEFT← (LEFT) + 1, memBase← StackBR;
   TSP← (store← TSP) + 1, dbuf← SmallHi;
   TSP← (store← TSP) + 1, dbuf← Q, NextOpCode;



regOP1[307, StackBR, opPUTBASEBYTE, noNData];