*-----------------------------------------------------------
Title[DMesaRWL...March 8, 1981  7:16 PM...Taft];
*-----------------------------------------------------------

%

	CONTENTS, by order of occurence

Read/Write Long
	RBL	Read Byte Long
	WBL	Write Byte Long
	RDBL	Read Double Byte Long
	WDBL	Write Double Byte Long

Read/Write Indexed
	LongIndexedAddress	subroutine supporting these opcodes
	RXLPL	Read Index Local Pair Long
	WXLPL	Write Indexed Local Pair Long
	RXGPL	Read Indexed Global Pair Long
	WXGPL	Write Indexed Global Pair Long

Read/Write Indirect
	LongIndirectAddress	subroutine supporting these opcodes
	RILPM	Read indexed Local Pair Long
	RIGPL	Read Indexed Global Pair Long
	WILPL	Write Indexed Local Pair Long
	WIGPL	Write Indexed Global Pair Long

Read/Write Strings
	RSTRL	Read String Long
	WSTRL	Write STring Long

Read/Write Field
	RFL	Read Field Long
	RFSL	Read Field Stack Long
	WFL	Write Field Long
	WFSL	Write Field Stack Long

Miscellaneous
	LP	Lengthen Pointer
	BLTL	Block Transfer Long

%

TopLevel;

*  Read/Write using long pointer

*-----------------------------------------------------------
IFUR[RBL, 2, LPtr];	* Read Byte Long:
* p: LONG POINTER _ PopLong[]+LONG[alpha]; Push[Fetch[p]^];
*-----------------------------------------------------------

	BRHi_ Stack&-1, Branch[RBLM1];
:IfMEP;
	Stack_ MD, Branch[.-1];
	BRHi_ T, Branch[RBLM1];
:EndIf;

RBLM1:
	BRLo_ Stack&-1, Branch[RILPLM2];
***	Fetch_ ID, T_ StackNoUfl&+1, IFUNext1;


*-----------------------------------------------------------
IFUR[WBL, 2, LPtr];	* Write Byte Long:
* p: LONG POINTER _ PopLong[]+LONG[alpha]; Store[p]^ _ Pop[];
*-----------------------------------------------------------

	BRHi_ Stack&-1, Branch[WBLM1];
:IfMEP;
	Stack_ MD, Branch[.-1];
	BRHi_ T, Branch[WBLM1];
:EndIf;

WBLM1:
	BRLo_ Stack&-1, Branch[WILPLM2];
***	Store_ ID, DBuf_ Stack&-1, IFUNext0CF;


*-----------------------------------------------------------
IFUR[RDBL, 2, LPtr];	* Read Double Byte Long
* p: LONG POINTER _ PopLong[]+LONG[alpha];
* u _ Fetch[p]^; v _ Fetch[p+1]^; Push[u]; Push[v];
*-----------------------------------------------------------

	BRHi_ Stack&-1, Branch[RDBLM1];
:IfMEP;
	Stack_ MD, Branch[.-1];
	BRHi_ T, Branch[RDBLM1];
:EndIf;

RDBLM1:
	BRLo_ Stack;
	T_ (Fetch_ ID)+1;
	Fetch_ T, T_ MD, Branch[RDBM2];
***	Stack&+1_ T, T_ MD, Branch[PushT];


*-----------------------------------------------------------
IFUR[WDBL, 2, LPTR]	* Write Double Byte Long
* p: LONG POINTER _ PopLong[]+LONG[alpha];
* Store[p+1]^ _ Pop[]; Store[p]^ _ Pop[];
*-----------------------------------------------------------

	BRHi_ Stack&-1, Branch[WDBLM1];
:IfMEP;
	Stack_ MD, Branch[.-1];
	BRHi_ T, Branch[WDBLM1];
:EndIf;

WDBLM1:
	BRLo_ Stack&-2, Branch[SDBM2];
***	T_ (Store_ ID)+1, DBuf_ Stack&+1;
***	Store_ T, DBuf_ Stack&-2, IFUNext0CF;

* Read/Write indexed using long pointer

*-----------------------------------------------------------
LongIndexedAddress:
* Entry conditions:
*	T = address of long pointer (relative to current MemBase)
*	ID = alpha2, Stack = index
* Exit conditions:
*	MemBase = LPTR, containing the long pointer
*	T = index+alpha2, stack popped
*-----------------------------------------------------------
Subroutine;
	T_ (Fetch_ T)+1;
	RTemp0_ MD, Fetch_ T;
	MemBase_ LPtr, T_ (ID)+(Stack&-1);
LongAddressR:	* Tail of LongIndirectAddress
	RTemp0_ MD, BRLo_ RTemp0, Branch[.+2, Carry'];
	RTemp0_ (RTemp0)+1;
	BRHi_ RTemp0, Return;
TopLevel;

*-----------------------------------------------------------
IFUR[RXLPL, 2, L, N[4], PackedAlpha];	* Read Indexed Local Pair Long
IFUR[RXGPL, 2, G, N[3], PackedAlpha];	* Read Indexed Global Pair Long
* index _ Pop[]; p: LONG POINTER _ FetchMDSDbl[L+alpha.left]^;	-- or G+...
* Push[Fetch[p+LONG[index+alpha.right]]^];
*-----------------------------------------------------------

	T_ ID, Branch[RXLPLM1];
:IfMEP;
	T_ ID, Stack_ MD, Branch[RXLPLM1];
	T_ ID, StkP+1, Branch[RXLPLM1];		* T_ localBase or globalBase
:EndIf;

RXLPLM1:
	T_ (ID)+T, Call[LongIndexedAddress];	* T_ xxBase+alpha1
	Fetch_ T, T_ StackNoUfl&+1, IFUNext1;


*-----------------------------------------------------------
IFUR[WXLPL, 2, L, N[4], PackedAlpha];	* Write Indexed Local Pair Long
IFUR[WXGPL, 2, G, N[3], PackedAlpha];	* Write Indexed Global Pair Long
* index _ Pop[]; p: LONG POINTER _ FetchMDSDbl[L+alpha.left]^;	-- or G+...
* Store[p+LONG[index+alpha.right]]^ _ Pop[];
*-----------------------------------------------------------

	T_ ID, Branch[WXLPLM1];
:IfMEP;
	T_ ID, Stack_ MD, Branch[WXLPLM1];
	T_ ID, StkP+1, Branch[WXLPLM1];		* T_ localBase or globalBase
:EndIf;

WXLPLM1:
	T_ (ID)+T, Call[LongIndexedAddress];
	Store_ T, DBuf_ Stack&-1, IFUNext0CF;

* Read/Write Indirect using long pointer

*-----------------------------------------------------------
LongIndirectAddress:
* Entry conditions:
*	T = address of long pointer (relative to current MemBase)
* Exit conditions:
*	MemBase = LPTR, containing the long pointer
*-----------------------------------------------------------
Subroutine;
	T_ (Fetch_ T)+1;
	RTemp0_ MD, PD_ Fetch_ T;		* Note this clears Carry
	MemBase_ LPtr, Branch[LongAddressR];
TopLevel;

*-----------------------------------------------------------
IFUR[RILPL, 2, L, N[4], PackedAlpha];	* Read Indirect Local Pair Long
IFUR[RIGPL, 2, G, N[3], PackedAlpha];	* Read Indirect Global Pair Long
* p: LONG POINTER _ FetchMDSDbl[L+alpha.left]^;	-- or G+...
* Push[Fetch[p+LONG[alpha.right]]^];
*-----------------------------------------------------------

	T_ ID, Branch[RILPLM1];
:IfMEP;
	T_ ID, Stack_ MD, Branch[RILPLM1];
	T_ ID, StkP+1, Branch[RILPLM1];		* T_ localBase or globalBase
:EndIf;

RILPLM1:
	T_ (ID)+T, Call[LongIndirectAddress];	* T_ xxBase+alpha1
RILPLM2:					* Tail of RBL
	Fetch_ ID, T_ StackNoUfl&+1, IFUNext1;


*-----------------------------------------------------------
IFUR[WILPL, 2, L, N[4], PackedAlpha];	* Write Indirect Local Pair Long
IFUR[WIGPL, 2, G, N[3], PackedAlpha];	* Write Indirect Global Pair Long
* p: LONG POINTER _ FetchMDSDbl[L+alpha.left]^;	-- or G+...
* Store[p+LONG[alpha.right]]^ _ Pop[];
*-----------------------------------------------------------

	T_ ID, Branch[WILPLM1];
:IfMEP;
	T_ ID, Stack_ MD, Branch[WILPLM1];
	T_ ID, StkP+1, Branch[WILPLM1];		* T_ localBase or globalBase
:EndIf;

WILPLM1:
	T_ (ID)+T, Call[LongIndirectAddress];	* T_ xxBase+alpha1
WILPLM2:					* Tail of WBL
	Store_ ID, DBuf_ Stack&-1, IFUNext0CF;

* Read/Write String using long pointer

*-----------------------------------------------------------
IFUR[RSTRL, 2, LPtr];	* Read String Long
* index _ Pop[]+alpha; p: LONG POINTER _ PopLong[] + index/2;
* data: BytePair _ Fetch[p]^;
* Push[IF (index MOD 2)=0 THEN data.left ELSE data.right];
*-----------------------------------------------------------

* See comments under RSTR for explanation of the Multiply.

	T_ (ID)+(Stack&-1), Multiply, Branch[RSTRLM1];
:IfMEP;
	T_ (ID)+MD, StkP-1, Multiply, Branch[RSTRLM1];
	T_ (ID)+T, Multiply, Branch[RSTRLM1];	* T_ (index+alpha)/2
:EndIf;

RSTRLM1:
	BRHi_ Stack&-1;
	BRLo_ Stack, Branch[RSTRM2], DispTable[1, 2, 2];


*-----------------------------------------------------------
IFUR[WSTRL, 2, LPtr];	* Write String Long
* index _ Pop[]+alpha; p: LONG POINTER _ PopLong[] + index/2;
* byte: BYTE _ Pop[]; data: BytePair _ Fetch[p]^;
* IF (index MOD 2) = 0 THEN data.left _ byte ELSE data.right _ byte;
* Store[p]^ _ data;
*-----------------------------------------------------------

	T_ (ID)+(Stack&-1), Multiply, Branch[WSTRLM1];
:IfMEP;
	T_ (ID)+MD, StkP-1, Multiply, Branch[WSTRLM1];
	T_ (ID)+T, Multiply, Branch[WSTRLM1];	* T_ (index+alpha)/2
:EndIf;

WSTRLM1:
	BRHi_ Stack&-1;
	BRLo_ Stack&-1, Branch[WSTRM2], DispTable[1, 2, 2];

* Read/Write Field Long

:If[AltoMode];		********** Alto version **********
*-----------------------------------------------------------
IFUR[RFL, 3, Code, N[2]];	* Read Field Long
* Alto Mesa: this is an aligned 3-byte instruction
*-----------------------------------------------------------

	T_ (ID)-(PCX'), Branch[RFLM1];	* T_ PCX+3
:IfMEP;
	T_ (ID)-(PCX'), Stack_ MD, Branch[RFLM1];
	T_ (ID)-(PCX'), StkP+1, Branch[RFLM1];
:EndIf;

RFLM1:
	RTemp0_ (T-1) RSH 1, Call[RWFAlphaBeta];
	MemBase_ LPTR;
RFLM2:
	BRHi_ Stack&-1;
	BRLo_ Stack, Branch[RFM3];

*-----------------------------------------------------------
IFUR[RFSL, 1, LPtr, N[1]];	* Read Field Stack Long
* Alto Mesa: this is an aligned 1-byte instruction
*-----------------------------------------------------------

	RTemp0_ T_ Stack&-1, Branch[RFSLM1];
:IfMEP;
	RTemp0_ T_ B_ MD, StkP-1, Branch[RFSLM1];
	RTemp0_ T, Branch[RFSLM1];
:EndIf;

RFSLM1:
	RTemp1_ (ID)-(PCX');		* PCX+2
	T_ RSH[T, 10], RTemp1, Branch[.+2, R odd];
	PCF_ RTemp1;			* Restart IFU at PCX+2
	RTemp0_ (RTemp0) AND (377C), Branch[RFLM2];

:Else;			******** PrincOps version ********
*-----------------------------------------------------------
IFUR[RFL, 3, LPtr];	* Read Field Long
* p: LONG POINTER _ PopLong[]+alpha; Push[ReadField[Fetch[p]^, beta]];
*-----------------------------------------------------------

	BRHi_ Stack&-1, Branch[RFLM1];
:IfMEP;
	Stack_ MD, Branch[.-1];
	BRHi_ T, Branch[RFLM1];
:EndIf;

RFLM1:	BRLo_ Stack;
	Fetch_ ID, Branch[RFM1];

*-----------------------------------------------------------
IFUR[RFSL, 1, LPtr];	* Read Field Stack Long
* desc: FieldDesc _ Pop[]; p: LONG POINTER _ PopLong[]+desc.offset;
* Push[ReadField[Fetch[p]^, desc.field]];
*-----------------------------------------------------------

	T_ RSH[Stack&-1, 10], Branch[RFSLM1]; * T_ offset
:IfMEP;
	Stack_ MD, Branch[.-1];
	T_ RSH[T, 10], Branch[RFSLM1];
:EndIf;

RFSLM1:	BRHi_ Stack&-1;
	BRLo_ Stack&+2;
	Fetch_ T, T_ Stack&-2, Branch[RFSM2];

:EndIf;			**********************************

:If[AltoMode];		********** Alto version **********
*-----------------------------------------------------------
IFUR[WFL, 3, Code, N[2]];	* Write Field Long
* Alto Mesa: this is an aligned 3-byte instruction
*-----------------------------------------------------------

	T_ (ID)-(PCX'), Branch[WFLM1];	* T_ PCX+3
:IfMEP;
	T_ (ID)-(PCX'), Stack_ MD, Branch[WFLM1];
	T_ (ID)-(PCX'), StkP+1, Branch[WFLM1];
:EndIf;

WFLM1:
	RTemp0_ (T-1) RSH 1, Call[RWFAlphaBeta];
	MemBase_ LPTR;
WFLM2:
	BRHi_ Stack&-1;
	BRLo_ Stack&-1, Branch[WFM3];

*-----------------------------------------------------------
IFUR[WFSL, 1, LPtr, N[1]];	* Write Field Stack Long
* Alto Mesa: this is an aligned 1-byte instruction
*-----------------------------------------------------------

	RTemp0_ T_ Stack&-1, Branch[WFSLM1];
:IfMEP;
	RTemp0_ T_ B_ MD, StkP-1, Branch[WFSLM1];
	RTemp0_ T, Branch[WFSLM1];
:EndIf;

WFSLM1:
	RTemp1_ (ID)-(PCX');		* PCX+2
	T_ RSH[T, 10], RTemp1, Branch[.+2, R odd];
	PCF_ RTemp1;			* Restart IFU at PCX+2
	RTemp0_ (RTemp0) AND (377C), Branch[WFLM2];

:Else;			******** PrincOps version ********
*-----------------------------------------------------------
IFUR[WFL, 3, LPtr];	* Write Field Long
* p: LONG POINTER _ PopLong[]+alpha; data _ Pop[];
* Store[p]^ _ WriteField[Fetch[p]^, data, beta];
*-----------------------------------------------------------

	BRHi_ Stack&-1, Branch[WFLM1];
:IfMEP;
	Stack_ MD, Branch[.-1];
	BRHi_ T, Branch[WFLM1];
:EndIf;

WFLM1:	BRLo_ Stack&-1;
	T_ Fetch_ ID, Branch[WFM1];

*-----------------------------------------------------------
IFUR[WFSL, 1, LPtr];	* Write Field Stack Long
* desc: FieldDesc _ Pop[]; p: LONG POINTER _ PopLong[]+desc.offset;
* data _ Pop[]; StoreMDS[p]^ _ WriteField[FetchMDS[p]^, data, desc.field];
*-----------------------------------------------------------

	T_ Stack&-1, Branch[WFSLM2];
:IfMEP;
	T_ Stack&-1_ MD, Branch[WFSLM2];
:EndIf;
WFSLM2:	RTemp0_ T_ RSH[T, 10], Branch[WFSM1]; * T_ offset

WFSM1:	BRHi_ Stack&-1;
	BRLo_ Stack&-1;
	Fetch_ T, T_ Stack&+3;		* T_ data -- so that ShC R/T select
	WF_ Stack&-3, Branch[WFM2];	*   bits don't matter
:EndIf;			**********************************

*-----------------------------------------------------------
IFUR[LP, 1, MDS];	* Lengthen Pointer
* p: POINTER _ Pop[]; PushLong[LengthenPointer[p]];
*-----------------------------------------------------------

	DummyRef_ 0S, PD_ Stack&+1, T_ MD, Branch[LPM1];
:IfMEP;
	DummyRef_ 0S, Stack&+1_ PD_ MD, Branch[LPM1];
	DummyRef_ 0S, PD_ T, StkP+2, T_ MD, Branch[LPM1];
:EndIf;

LPM1:
	Branch[.+2, ALU=0];		* Skip if NIL
	StackT_ VAHi, IFUNext2;		* Lengthen with high part of MDS
	StackT_ A0, IFUNext2;		* LONG[NIL]


*-----------------------------------------------------------
IFUR[BLTL, 1, MDS];	* Block Transfer Long
*   DO
*   dest: LONG POINTER _ PopLong[]; count: CARDINAL _ Pop[];
*   source: LONG POINTER _ PopLong[];
*   IF count=0 THEN EXIT;
*   Store[dest]^ _ Fetch[source]^;
*   PushLong[source+1]; Push[count-1]; PushLong[dest+1];
*   IF InterruptPending[] THEN GOTO Suspend;
*   REPEAT Suspend => PC _ savePC;
*   ENDLOOP;
*-----------------------------------------------------------

	T_ Stack&-1, MemBase_ BBDstBR, Branch[BLTLM1];
:IfMEP;
	T_ Stack&-1_ B_ MD, MemBase_ BBDstBR, Branch[BLTLM1];
	MemBase_ BBDstBR, Branch[BLTLM1];
:EndIf;

BLTLM1:
	RTemp0_ A0, BRHi_ T;
	BRLo_ Stack&-1;
	T_ Stack&-2, FlipMemBase;
	BRLo_ Stack&+1;
	BRHi_ Stack&+3;
	RTemp1_ A0, Call[BLTSetupTransfer];

* See comments under BLTSetupTransfer for how this loop works.
Subroutine;
BLTLMLoop:
	MemBase_ BBSrcBR, CoReturn;
	StkP-2, Branch[BLTLMDone, ALU=0]; * T = words remaining
	T_ (Stack&-2)-(Q_ T);		* T_ words done this time
	Stack&+1_ (Stack&+1)+T;		* Advance dest pointer on stack
	Stack&+1_ A_ Stack&+1, XorSavedCarry;
	Stack&+1_ Q;			* Update count on stack
	Stack&+1_ (Stack&+1)+T;		* Advance source pointer on stack
	Stack_ A_ Stack, XorSavedCarry, Branch[BLTLMLoop];

TopLevel;

BLTLMDone:
	StkP-3, IFUNext0;
(1552)