Google
 

Trailing-Edge - PDP-10 Archives - BB-AS80B-SM_1985 - sources/byte.mic
There are 5 other files named byte.mic in the archive. Click here to see a list.
.TOC	"BYTE GROUP -- IBP, ILDB, LDB, IDPB, DPB"

	.DCODE
;133:	R,		J/IBP		;OR ADJBP
134:	RW,		J/ILDB		;CAN'T USE RPW BECAUSE OF FPD
	R,		J/LDB		;
	RW,		J/IDPB		;
	R,		J/DPB		;
	.UCODE

;ALL FIVE INSTRUCTIONS OF THIS GROUP ARE CALLED WITH THE BYTE POINTER
;IN THE AR.  ALL INSTRUCTIONS SHARE COMMON SUBROUTINES, SO THAT
;THE 10/11 INTERFACE AND STRING MAY ALSO USE THESE SUBROUTINES

=0****00*000
.IFNOT/OWGBP
ILDB:	BR/AR,P_P-S,BYTE DISP,		;START IBP
		CALL.M,J/IBPS		;AND CALL SUBR
=100
.IFNOT/XADDR
LDB:	ARX_AR,SC_P,CALL,J/BYTEA	;BEGIN EA COMPUTATION
.IF/XADDR
LDB:	ARX_AR,SC_P,BYTE DISP,
		CALL,J/BYTEA		;BEGIN EA COMPUTATION
.ENDIF/XADDR
	SC_FE+SC,CALL,J/LDB1		;SC_P+S WHILE LOADING AR
=111	AC0_AR,CLR FPD,I FETCH,J/NOP	;DONE
=
.IF/OWGBP				;[265][251]
ILDB:	SKP PC SEC0,CALL,J/GTST		;TEST FOR NOT SEC 0 AND OWGBP [266]
	BR/AR,J/ILDB0			; NO, CONTINUE
	BYTE PREV & CLR SR3,
		CALL [GBYTE]		;[255]YES, ENA PREVIOUS
	GEN AR, EXT BYTE READ,		;GET BYTE
		SR_#, J/LDB01		;[255]ALLOW PREVIOUS ENABLE.
=100
LDB:	SKP PC SEC0,CALL,J/GTST		;TEST FOR NOT SEC 0 AND OWGBP [266]
	ARX_AR,BR/AR,J/LDB0		;NO, CONTINUE
	BYTE PREV & SET SR3,
		CALL [GBYTE]		;[255]YES, ENA PREVIOUS
	GEN AR,EXT BYTE READ,		;GET BYTE
		SR_#, J/LDB01		;[255]ALLOW PREVIOUS ENABLE.
=
=000
ILDB0:	P_P-S,BYTE DISP,
		CALL.M,J/IBPS		;START IBP
=100
LDB0:	ARX_AR,SC_P,BYTE DISP,
		CALL,J/BYTEA		;DO EA COMP
LDB01:	SC_FE+SC,CALL,J/LDB1		;SC_P+S WHILE LOAD AR
=111	AC0_AR,CLR FPD,I FETCH,J/NOP	;DONE
=0
GBYTE:	BR/AR,CALL,J/CNV2WD		;CONVERT TO A 2WD FORMAT
	SC_P,SR DISP			;SAVE P, INC POINTER ?
=1110	AR_BR,BYTE DISP,CALL,J/INC2WD	;YES, (INC ADDR) AND STORE
	AR_BR,SR_#,#/300,RETURN1	;[335][353] GET whole ADDRESS and
					; reset memory state
=0
GTST:	SC_P-#,#/45, SKP SCAD0,J/GTST1	;TEST FOR ONE WORD GLOBAL [265]
	RETURN1				;NOT IN SEC 0
=0
GTST1:	BR/AR,RETURN2			;DO OWG CODE
	RETURN1				;NOT OWG
.ENDIF/OWGBP				;[265][251]
=
=0****00*000
.IFNOT/OWGBP				;[265]
IDPB:	BR/AR,P_P-S,BYTE DISP,		;START IBP
		CALL.M,J/IBPS		
=100
.IFNOT/XADDR
.IFNOT/SMP
DPB:	ARX_AR,SC_P,CALL,J/BYTEA	;COMPUTE EFFECTIVE BYTE ADDR
.IF/SMP
DPB:	ARX_AR,SC_P,CALL,J/BYTEAP	;COMPUTE EFFECTIVE BYTE ADDR
.ENDIF/SMP
.IF/XADDR
.IFNOT/SMP				;[324]
DPB:	ARX_AR,SC_P,BYTE DISP,
		CALL,J/BYTEA		;COMPUTE EFFECTIVE BYTE ADDR
.IF/SMP					;[324]
DPB:	ARX_AR,SC_P,BYTE DISP,		;[324] SMP. Must interlock
		CALL,J/BYTEAP		;COMPUTE EFFECTIVE BYTE ADDR
.ENDIF/SMP				;[324]
.ENDIF/XADDR
=101
	AR_AC0,TIME/3T,SC_#-SC,#/36.,	;COMPUTE 36-P
		CALL,SKP SCAD0,J/DPB1	;CALL DEPOSITOR
=111
BFIN:	FIN STORE,I FETCH,J/CLRFPD	;DONE
.IF/OWGBP				;[265][251]
IDPB:	SKP PC SEC0,CALL,J/GTST		;TEST FOR NOT SEC 0 AND OWGBP [266]
	BR/AR,J/IDPB0			; NO, CONTINUE
	BYTE PREV & CLR SR3,
		CALL [GBYTE]		;[255]YES, ENA PREVIOUS
	GEN AR, EXT BYTE READ,		;GET BYTE
		J/DPB01
=100
DPB:	SKP PC SEC0,CALL,J/GTST		;TEST FOR NOT SEC 0 AND OWGBP [266]
	ARX_AR,BR/AR,J/DPB0		;NO, CONTINUE
	BYTE PREV & SET SR3,
		CALL [GBYTE]		;[255]YES, ENA PREVIOUS
	GEN AR,EXT BYTE READ,		;GET BYTE
		J/DPB01			;[256]
=
=000
IDPB0:	P_P-S,BYTE DISP,		;START IBP
		CALL.M,J/IBPS
=100
.IF/SMP
DPB0:	ARX_AR,SC_P,BYTE DISP,
		CALL,J/BYTEAP		;DO EA COMP
.IFNOT/SMP
DPB0:	ARX_AR,SC_P,BYTE DISP,
		CALL,J/BYTEA		;DO EA COMP
.ENDIF/SMP
DPB01:	AR_AC0,TIME/3T,SC_#-SC,#/36.,	;COMPUTE 36-P
		CALL,SKP SCAD0,J/DPB1	;CALL DEPOSITOR
=111
BFIN:	FIN STORE,I FETCH,J/CLRFPD	;DONE
.ENDIF/OWGBP				;[265][251]
=
.TOC	"INCREMENT BYTE POINTER SUBROUTINE"

;THIS SUBROUTINE IS CALLED BY THE INSTRUCTIONS ILDB, IDPB AS
;WELL AS THE MICROCODED 10/11 INTERFACE HANDLER.
;CALL WITH BYTE DISP TESTING FPD AND SIGN OF P-S
;[TIME=2+2(BP OVFLO)]

.IFNOT/XADDR
=010					;BR12 IRELEVANT
IBPS:	STORE,RETURN4			;SIMPLE, NO OVERFLOW
	FE_#,#/36.,GEN AR+1,TIME/2T,	;HERE IF OVRFLO OF WORD
		ARX_AR,J/NXTWRD
	AR_BR,RETURN4			;FPD WAS SET, RESTORE AR
	AR_BR,RETURN4			; AND CONVERT TO LDB OR DPB
					;TEST BR12 ONLY
NXTWRD:	AR_AR+1,P_FE-S,STORE,
		TIME/2T,RETURN4


.TOC	"BYTE EFFECTIVE ADDRESS EVALUATOR - NO XADDR"

;ENTER WITH POINTER IN AR, ARX, AND BR
;RETURN1 WITH (EA) LOADING INTO AR AND ARX,
;FPD SET, P IN SC, AND S IN FE
;[TIME=4+1(INDEXED)+?(INDIRECT)]

BYTEA:	MEM_AR,FE_S,SET FPD,		;PUT AWAY UPDATED POINTER
		EA MOD DISP		;EVAL BP ADDR
=1100
BFETCH:	GEN ARX,BYTE READ,RETURN1	;START DATA FETCH
	GEN ARX+XR,BYTE READ,RETURN1	;ADDRESS IS INDEXED
	GEN ARX,BYTE INDRCT,J/BYTEI	;DO INDIRECT
	GEN ARX+XR,BYTE INDRCT,J/BYTEI	;INDIRECT INDEXED!!!

BYTEI:	ARX_MEM,SKP INTRPT		;WAIT FOR INDIRECT WORD
=0	EA MOD DISP,J/BFETCH		;PROCEED IN ADDR EVAL
	SR DISP,J/CLEAN			;INTERRUPTED, CLEAN UP AS REQ'D
.IF/SMP
BYTEAP:	MEM_AR,FE_S,SET FPD,		;PUT AWAY UPDATED POINTER
		EA MOD DISP		;EVAL BP ADR

=1100
BFETCHP:GEN ARX,BYTE RPW,RETURN1	;START DATA FETCH.  RPW CYCLE
	GEN ARX+XR,BYTE RPW,RETURN1	;ADDRESS IS INDEXED
	GEN ARX,BYTE INDRCT,J/BYTEIP	;DO INDIRECT
	GEN ARX+XR,BYTE INDRCT,J/BYTEIP	;INDIRECT INDEXED!!!

BYTEIP:	ARX_MEM,SKP INTRPT		;WAIT FOR INDIRECT WORD
=0	EA MOD DISP,J/BFETCHP		;[231] PROCEED IN ADR EVAL
	SR DISP,J/CLEAN			;INTERRUPTED.  CLEAN UP AS REQ'D
.ENDIF/SMP
.IF/XADDR
;IBP SUBROUTINE
; CALL WITH BP IN AR, P_P-S, BYTE DISP

=000
IBPS:	STORE,RETURN4			;SIMPLE CASE
	FE_#,#/36.,GEN AR+1,TIME/2T,	;POINTER OVERFLOW, B12=0
		J/NXTWRD
	STORE,RETURN4			;B12=1 BUT NO OVERFLOW
	FE_#,#/36.,GEN AR+1,TIME/2T,	;OVERFLOW, B12=1
		SKP -VMA SEC0,J/NXTWRD
	AR_BR,RETURN4
	AR_BR,RETURN4
	AR_BR,RETURN4
	AR_BR,RETURN4
=0
NXTWRD:	P_FE-S,AR_AR+1,TIME/2T,		;SINGLE WORD BP
		STORE,RETURN4
	VMA_VMA+1,LOAD AR,P_FE-S.S	;DOUBLE... GET OTHER HALF
	ARX_AR,AR_MEM
	SC_P,SKP AR0,BR/AR,AR_AR+1	;IFIW OR EFIW?
=0	P_SC#,STORE,J/NXTW2		;EFIW, CARRY STOPS AT B6
	ARL_BRL,STORE			;IFIW, CARRY STOPS AT B18
NXTW2:	FIN STORE,AR_ARX,
		VMA_VMA-1,STORE,RETURN4
;HERE TO EVALUATE EFFECTIVE ADDRESS OF BYTE POINTER.
; ENTER AT BYTEA WITH BYTE DISP (SCAD0=0), EXCEPT FOR EXTENDED
; INSTRUCTION SET, WHICH MUST GET SECOND PART OF POINTER FROM
; AC AND MUST NOT SET FPD, AND THEREFORE ENTERS AT BFETCH (FOR
; SINGLE-WORD POINTERS) OR BYTEI (FOR LONG POINTERS).

=100
BYTEA:	MEM_AR,FE_S,SET FPD,
		EA MOD DISP,J/BFETCH
	READ BP2,FE_S,J/BPART2		;GET SECOND WORD
	MEM_AR,SKP -VMA SEC0,J/BYTEA	;B12=1.  OBEY IF NOT SEC0
=
=0000
BXA:	GEN ARX,GLOBAL,BYTE INDRCT,
		SKP INTRPT,J/BYTEI
	GEN ARX+XR,GLOBAL,BYTE INDRCT,
		SKP INTRPT,J/BYTEI
	GEN ARX,GLOBAL,BYTE INDRCT,
		SKP INTRPT,J/BYTEI
	GEN ARX+XR,GLOBAL,BYTE INDRCT,
		SKP INTRPT,J/BYTEI

	GEN ARX,GLOBAL,BYTE READ,RETURN1
	GEN ARX+XR,GLOBAL,BYTE READ,RETURN1
	GEN ARX,GLOBAL,BYTE READ,RETURN1
	GEN ARX+XR,GLOBAL,BYTE READ,RETURN1

	FE_#,#/24,J/PF24		;ILLEGAL FORMAT INDIRECT WORD
	FE_#,#/24,J/PF24
	FE_#,#/24,J/PF24
	FE_#,#/24,J/PF24

BFETCH:
	GEN AR,BYTE READ,RETURN1
	GEN AR+XR,INDEXED,BYTE READ,RETURN1
	GEN AR,BYTE INDRCT,
		SKP INTRPT,J/BYTEI
	GEN AR+XR,INDEXED,BYTE INDRCT,
		SKP INTRPT,J/BYTEI

BPART2:	SET FPD				;SET BEFORE FAULTING
=0
BYTEI:	ARX_MEM,LONG EN,J/BYTEI2
	ARX_MEM,TAKE INTRPT
BYTEI2:	AR_ARX,XR,EA MOD DISP,TIME/3T,J/BXA
.TOC	"BYTE EFFECTIVE ADDRESS EVALUATOR FOR XADDR SMP LDB"

;
;	The following code segment is virtually identical to the preceding
;	hunk.  Unfortunately, in order to make DPB do an RPW interlock and
;	allow extended addressing, it is necessary to completely duplicate
;	the effective address evaluation code (as it exits from a 16 word
;	dispatch block).  Thus we waste gross amounts of microstore.  Ugh.
;
.IF/SMP					; [303]
=100
BYTEAP:	MEM_AR,FE_S,SET FPD,
		EA MOD DISP,J/BFETCHP
	READ BP2,FE_S,J/BPART2P		;GET SECOND WORD
	MEM_AR,SKP -VMA SEC0,J/BYTEAP	;B12=1.  OBEY IF NOT SEC0
=
=0000
BXAP:	GEN ARX,GLOBAL,BYTE INDRCT,
		SKP INTRPT,J/BYTEIP
	GEN ARX+XR,GLOBAL,BYTE INDRCT,
		SKP INTRPT,J/BYTEIP
	GEN ARX,GLOBAL,BYTE INDRCT,
		SKP INTRPT,J/BYTEIP
	GEN ARX+XR,GLOBAL,BYTE INDRCT,
		SKP INTRPT,J/BYTEIP

	GEN ARX,GLOBAL,BYTE RPW,RETURN1	; [303] Interlock for SMP
	GEN ARX+XR,GLOBAL,BYTE RPW,RETURN1
	GEN ARX,GLOBAL,BYTE RPW,RETURN1
	GEN ARX+XR,GLOBAL,BYTE RPW,RETURN1

	FE_#,#/24,J/PF24		;ILLEGAL FORMAT INDIRECT WORD
	FE_#,#/24,J/PF24
	FE_#,#/24,J/PF24
	FE_#,#/24,J/PF24

BFETCHP: GEN AR,BYTE RPW,RETURN1
	GEN AR+XR,INDEXED,BYTE RPW,RETURN1
	GEN AR,BYTE INDRCT,
		SKP INTRPT,J/BYTEIP
	GEN AR+XR,INDEXED,BYTE INDRCT,
		SKP INTRPT,J/BYTEIP

BPART2P: SET FPD				;SET BEFORE FAULTING
=0
BYTEIP:	ARX_MEM,LONG EN,J/BYTEI2P
	ARX_MEM,TAKE INTRPT
BYTEI2P: AR_ARX,XR,EA MOD DISP,TIME/3T,J/BXAP
.ENDIF/SMP
.ENDIF/XADDR
.TOC	"LOAD BYTE SUBROUTINE"
;ENTER WITH S IN FE, P+S IN SC, AND AR LOAD IN PROGRESS
;SKP INTERRUPT AT ENTRY IS OPTIONAL
;RETURN2 WITH BYTE RIGHT JUSTIFIED IN AR
;[TIME=7]
=0
LDB1:	AR_MEM,SC_#-SC,#/36.,SKP SCAD0,	;36-(P+S)
		TIME/3T,J/LDB2
	AR_MEM,SR DISP,J/CLEAN		;HERE IF INTERRUPT PENDING

=0
LDB2:	ARX_SHIFT,AR_0S,SC_FE,J/SHIFT	;BYTE IN ARX HI, READY TO SHIFT
	ARX_AR,AR_0S,			;P+S > 36, PUT BYTE IN ARX HI
		SC_FE+SC,SKP SCAD0	;ADJUST S AND SHIFT BYTE

;PUT BYTE INTO AR RIGHT-JUSTIFIED
; THIS INSTRUCTION ALSO CALLED ALONE AS A SUBROUTINE

=0
SHIFT:	AR_SHIFT,RETURN2		;RETURN WITH BYTE IN AR
	RETURN2				;BYTE WAS OFF THE END, RETURN AR=0


.TOC	"DEPOSIT BYTE SUBROUTINE"
;ENTER WITH BYTE RIGHT JUSTIFIED IN AR, POINTER IN BR,
; S IN FE, 36-P IN SC, AND LOAD AR-ARX STARTED
; SKP IF P>36
;RETURN3 WITH FINAL STORE IN PROGRESS
;[TIME=11]

=0
DPB1:	MQ_AR,AR_MEM,ARX_MEM,		;GET WORD TO ROTATE 36-P
		GEN FE-SC-1,TIME/3T,	; [303] COMPUTE S-(36-P)-1
		SKP SCAD0,J/DPB2	;CHECK THAT P+S<=36
.IFNOT/SMP				;[335]
	AR_MEM,RETURN3			;[226]P>36, STORE NOTHING
.IF/SMP					;[335]
	AR_MEM,SC_0,J/RELMEM		;[335] Must release memory if RPW
.ENDIF/SMP

=0
DPB2:	FE_SC				;P+S>36, S_36-P
.IFNOT/MODEL.B
.IF/SMP
	ARX_AR				;WORD TO ROTATE TO ARX
.ENDIF/SMP
.ENDIF/MODEL.B
	ARX_SHIFT,AR_MQ,SC_FE,		;ARX HAS P,X,S
		FE_#-SC,#/72.		;SC_S, FE_72-(36-P)=36+P
	SC_#-SC,#/36.			;SC_36-S (KNOWN .LE. P)
	AR_SHIFT,ARX_SHIFT,		;S,P,X
		SC_FE-SC		;SC_(36+P)-(36-S)=P+S
RELMEM:	AR_SHIFT,STORE,RETURN3		;[335] DONE, STORE IT BACK
.TOC	"IBP, ADJBP"

;IBP OR ADJBP
;IBP IF AC#0, ADJBP OTHERWISE
; HERE WITH THE BASE POINTER IN AR

;IBP:	SKP AC#0			;IS THIS IBP OR ADJBP?
.IF/ADJBP
=000
.IFNOT/XADDR
IBP1:	T0_AR,BR/AR,			;SAVE POINTER FOR ADJBP
		SC_S,AR_0S,CALL,J/GETSC	; GET BYTE SIZE
.IF/XADDR
IBP1:	T0_AR,BR/AR,BYTE DISP,		;SAVE POINTER, TEST B12
		SC_S,AR_0S,CALL,J/GETSC	;GET SIZE, SECOND WORD IF NEEDED
.ENDIF/XADDR
.ENDIF/ADJBP
=001
IBP2:	BR/AR,P_P-S,CALL.M,		;NEW P UNLESS OVERFLOW
		BYTE DISP,J/IBPS	;[245]		
.IF/ADJBP
	BR/AR,AR_BR,J/ADJBP		;HOLD S IN BR
.ENDIF/ADJBP
=101	FIN STORE,I FETCH,J/NOP		;IBP DONE
=

;HERE FOR ADJUST BYTE POINTER (IBP WITH NON-ZERO AC)
; BYTE SIZE (S) IS RIGHT ADJUSTED IN BR AND MQ
; FULL POINTER IS IN AR, AND SAVED IN T0

.IF/ADJBP

ADJBP:	SC_P,AR+ARX+MQ_0.M,		;GET P
		SKP BR EQ		;CHECK SIZE IS NON-ZERO

=00	BRX/ARX,P_SC,CALL.M,J/SIXDIV	;DIVIDE P BY S
	AR_T0,J/IFSTAC			;OOPS, S=0, RETURN UNALTERED POINTER
	T1_AR,AR_0S,ARX_0S,		;SAVE P/S
		SC_FE-SC		;36-P IN SC
=
=0*	P_SC,MQ_0.M,CALL.M,J/SIXDIV	;36-P IN AR0-5
	AR_AR+T1,SKP AD NE		;(P/S)+(36-P/S)=BYTES/WORD
=0	I FETCH,J/NODIVD		;ABORT, BYTES/WORD=0
	T1_AR,BR/AR,AR_ARX		;SAVE BYTES/WORD, READY TO
					; DIVIDE BY IT
	T2_AR,AR_MQ			;SAVE REMAIN(36-P/S), GET (36-P)/S
	AR_AR*AC0,AD/A+B,ARL/AD,	;ADJUSTMENT IN AR
		ARX+MQ_0.M
;COMPUTE QUOTIENT Q AND REMAINDER R OF ADJUSTMENT/(BYTES/WORD)
; SUCH THAT ADJUSTMENT=Q*(BYTES/WORD)+R, 1 .LE. R .LE. (BYTES/WORD)
; SINCE ADJUSTMENT IS CALCULATED RELATIVE TO LEFT-MOST BYTE OF
; A WORD, THIS GIVES Q AS THE NUMBER OF WORDS BY WHICH TO INDEX THE
; BYTE POINTER, AND R AS THE NUMBER OF BYTES FROM THE LEFT OF THE
; WORD.  MULTIPLYING R BY THE BYTE SIZE WILL GIVE THE NUMBER OF BITS
; FROM THE LEFTMOST BYTE, AND ADDING REMAIN(36-P/S) WILL GIVE NUMBER
; OF BITS FROM BIT 0.  FINALLY, WE MUST SUBTRACT THIS FROM 36 TO GET
; THE CORRECT P FIELD, WHICH IS ALWAYS RELATIVE TO THE RIGHT EDGE OF
; THE WORD.
;
;  SR1 = 1	DON'T DO FETCH OF NEXT INST (ADJBP WITH OWGBP)

=100	AC0_AR,SC_1,CALL,J/DIV2		;DO THE BASIC DIVIDE
=110	ARX_-BRX,FE_#,#/-4,		;NEG QUO ==> NEG REMAIN
		SR DISP,J/ADJD1		;TEST FOR DOUBLE-WORD POINTER
	ARX/MQ,SKP AR NE,FE_#,#/-4,	;POS QUO.  IS REMAIN .GT. 0?
		SR DISP
.IFNOT/XADDR
=10
.IF/XADDR
=100
.ENDIF/XADDR
ADJD1:	AR_AR+T1,J/ADJD2		;INCREASE REM TO MEET CONSTRAINT
	BR/AR,AR_ARX (ADX),		;REMAIN IN RANGE,
		ARL+ARX_0.M,J/ADJD3	; QUOTIENT TO ARR
.IF/XADDR
	AR_AR+T1,J/ADJX2		;INCREASE REMAIN & DECR QUO
.IF/OWGBP
ADJX3:	BR/AR,AR_ARX,SR DISP		;[251] REM TO BR, OWGBP ?
=011	AR_AC1,SKP AD0,J/ADJX4		; NO, WD2 EFIW OR IFIW?
	AR_AR+T0,J/ADJX1		; YES, INC ADDRESS
.IFNOT/OWGBP
ADJX3:	BR/AR,AR_AC1,SKP AD0,J/ADJX4	;REM TO BR, WD2 EFIW OR IFIW?
.ENDIF/OWGBP
ADJX2:	ARX_ARX-1,J/ADJX3
.IF/OWGBP
ADJX1:	T0_AR,ARX_0S			;SAVE NEW ADDRESS
	AR_E0,BRX/ARX,J/ADJD4		;GET P,S, CLEAR BRX
.ENDIF/OWGBP
=0
.IF/OWGBP
ADJX4:	SC_P,SR DISP,J/ADJX7		;[251] EFIW, SAVE 0-5, OWGBP ?
.IFNOT/OWGBP
ADJX4:	SC_P,AR_ARX*AC1,AD/A+B,J/ADJX5	;EFIW, SAVE 0-5
.ENDIF/OWGBP
	ARL_ARL,AR_ARX*AC1,AD/A+B,J/ADJX6
ADJX5:	P_SC				;ADJUSTMENT MUSTN'T TOUCH @,XR
ADJX6:	AC1_AR,ARX_0S
	AR_T0,BRX/ARX,J/ADJD4
.IF/OWGBP
=011
ADJX7:	AR_ARX*AC1,AD/A+B,J/ADJX5	;[251] NO, EFIW
	AR_ARX*E1,AD/A+B,J/ADJX5	;[251] YES, EFIW
.ENDIF/OWGBP
.ENDIF/XADDR

ADJD2:	BR/AR,AR_ARX-1,			;HOLD UPDATED REMAINDER,
		ARL+ARX_0.M		; GET CORRESPONDING QUOTIENT
ADJD3:	AR_AR+T0,INH CRY18,		;ADD Q TO Y OF POINTER,
		BRX/ARX,J/ADJD4		;CLR BRX

;HERE WITH ADDRESS PART OF POINTER UPDATED, P AND S IN AR, AND
; THE REMAINDER IN BR. COMPUTE 36-[ R*S + REMAIN(36-P/S) ].

=00*
ADJD4:	AC0_AR,AR_0S,SC_S,CALL,J/GETSC	;SAVE UPDATED Y, GET SIZE
	MQ_AR,AR_T2,CLR ARX,		;M'IER IS S, GET REMAIN(36-P/S)
		CALL,J/MULREE		;COMPUTE (R*S)+REMAIN(36-P/S)
=11*
.IF/OWGBP
	AR_ARX*2,SR DISP		;[251] OWGBP ?
=011	SR_0,I FETCH,J/ADJD5		; [301] NO, FOLLOW FLOW
	SC_P-#,#/36.,AR_AC0
	P_-SC,J/GADJ1			;[251] YES, THAT'S NEW P, DONE
ADJD5:	SC_P-#,#/36.,AR_AC0
	P_-SC,J/STAC			;NO, THAT'S NEW P, DONE
.IFNOT/OWGBP
	AR_ARX*2,SR_0,I FETCH		; [301] PUT THAT IN AR0-5
	SC_P-#,#/36.,AR_AC0
	P_-SC,J/STAC			; [301] THAT'S NEW P, DONE
.ENDIF/OWGBP
;[251]
;HERE IF WE ARE DOING IBP OR ADJBP ON A ONE WORD GLOBAL BYTE POINTER.

.IF/OWGBP
=0
GIBP:	J/GADJBP			;GO DO ADJBP
	BYTE PREV & CLR SR3		;[256] ENA PREVIOUS
=0	CALL,J/GBYTE			;INC POINTER AND STORE
	I FETCH,CLR FPD,J/NOP		;[263]DONE IBP
=0
GADJBP:	BYTE PREV & SET SR2,
		CALL [CNV2WD]		;[256] ENA PREVIOUS
	[AR]_[AR]*FM[EXPMSK],AD/ANDCB	;SAVE P,S AND CLEAR REST
	SET SR1				;USE E1 INSTEAD OF AC1 IN ADJBP
	E0_AR,SC_S,AR_BR,BRX/ARX	;SAVE S, ADDRESS TO AR
=01	T0_AR,AR_0S,CALL,J/GETSC	;GET BYTE SIZE IN AR,SAVE ADDR
	BR/AR,AR_BR,VMA_#,#/722		;ADDR, P,S IN PLACE, EPT ADDR TO VMA
	E1_AR,AR_BRX,J/ADJBP		;SAVE ADDR, GO ADJ

GADJ1:	FE_S+#,#/-18.,SKP SCAD0		;BYTE SIZE 18 ?
=0
GADJLD:	LOAD AR,EPT REF CACHE,J/GADJ2	;GET DECODE WORD AND CACHE IT [260]
	SC_#,#/8.			;SET UP FOR DISP
	SH DISP,J/GADJL0		;DISPATCH ON SIZE 6-9	[253]
=0000
GADJL0:					;[253]
=0110	VMA_#,#/716,J/GADJLD		;6
=0111	VMA_#,#/717,J/GADJLD		;7
=1000	VMA_#,#/720,J/GADJLD		;8
=1001	VMA_#,#/721,J/GADJLD		;9
=
GADJ2:	MB WAIT,SC_#,#/30.		;BYTE # TO AR 0-5
	BR/AR,AR_BR,ARX_0.M		;DATA TO AR,CLEAR ARX
	AR_SHIFT,SC_#,#/6		;SHIFT IT
	FE_P,AR_BR			;SAVE COUNT,DECODE TO AR
GADJ3:	FE_FE-1,SKP SCAD NE		;DEC DECODE, SKIP TO SHIFT
=0	ARX_T0,J/GADJ4			;GET ADDRESS, NEW P IN AR0-4
	AR_SHIFT,J/GADJ3		;SHIFT AND TRY AGAIN
GADJ4:	AR_ARX,FE_P			;GET ADDRESS, SAVE P
	P_FE				;NEW P
	AC0_AR,I FETCH,J/NOP		;DONE !
.ENDIF/ADJBP
.ENDIF/OWGBP
;[251]
;SUBROUTINE TO GET CONTENTS OF SC RIGHT ALIGNED IN AR
; CALLED BY ADJBP WITH BYTE DISP TO GET SECOND PART OF POINTER, TOO.
;[TIME=6]

=101
GETSC:	AR0-8_SC,J/GETEXP		;PUT SC INTO AR
.IF/XADDR
	AR0-8_SC,SKP -VMA SEC0		;BIT 12=1.  GET 2ND PART OF PTR
=00
.ENDIF/XADDR
GETEXP:	ARX_AR,SC_#,#/9.,J/SHIFT	;HERE WITH DATA IN AR0-8
.IF/XADDR
	VMA_VMA+1,LOAD ARX,SC_#,#/9.,	;LONG POINTER, GET PART 2
		CALL,J/XFERW
=11	ARX_AR (AD),AR_ARX,SR_#,#/2	;READY TO PUT IT AWAY
	AC1_AR,AR_0S,J/SHIFT		;PUT AWAY, FINISH GETTING S
.ENDIF/XADDR


;SUBROUTINE FOR SHORT DIVISION, BR KNOWN POSITIVE
; CALL WITH MQ CLEAR, DIVISOR RIGHT-ALIGNED IN BR, AND DIVIDEND
;	IN AR0-5 (OR LEFT-ALIGNED IN ARX IF ENTERING AT SDIV)
; RETURN QUOTIENT IN AR AND MQ, REMAIN IN ARX
;[TIME=22+3(RESTORE REQ'D)]

;TO IMPROVE ADJBP PERFORMANCE, INSERT THE INSTRUCTION SHOWN BELOW
; (SIXDZ), AND CHANGE THE CALLS TO SIXDIV TO "SKP SCAD NE,J/SIXDZ"
;=0
;SIXDZ:	AR_0S,ARX_0S,FE_#,#/36.,RETURN2	;HERE IF DIVIDEND IS ZERO

SIXDIV:	ARX_AR,AR_0S,FE_#,#/4,J/SDIV-
=0*0
SDIV:	DIVIDE,AR_2(AR+BR),ARX/ADX*2,J/SDIV
SDIV-:	DIVIDE,AR_2(AR-BR),ARX/ADX*2,J/SDIV
	DIVIDE,AR_AR+BR,J/SDIVR		;NO SHIFT ON FINAL STEP
	DIVIDE,AR_AR-BR
=1*0
SDIVR:	AR_AR+BR			;NO CRY0 MEANS RESTORE REQ'D
	ARX_AR,AR_MQ,			;RETURN QUO IN AR, REMAIN IN ARX
		FE_#,#/36.,RETURN2
.IF/OWGBP
;CNV2WD -- ROUTINE TO CALCULATE NEW P FIELD OF ONE WORD GLOBAL BYTE
;POINTER AND STORE NEW POINTER. A TABLE IS IN THE EPT STARTING AT 700
;AND THIS IS USED TO CONVERT THE OWGBP TO A TWO WORD GLOBAL POINTER
;AND TO CALCULATE THE NEW P FOR THE STORE.
;
;ENTER WITH P-45 IN SC
;	    BYTE POINTER IN BR
;

CNV2WD:	AR_VMA HELD			;[326] GET FULL VMA FOR WRITE
	MQ_AR				;SAVE FOR WRITE BACK
	AR0-8_SC			;P-45 IN AR
=0*	AR_ARX (AD),ARX_AR,SC_#,#/9.,	;SWAP AROUND FOR SHIFT
		CALL [SHIFT]		;NOW SHIFT IT TO BIT 35
	AR_AR*.5 LONG			;MAKE IT AN OFFSET, LSB IN ARX0
	VMA_#+AR32-35,#/700		;POINT TO RIGHT WORD
	LOAD AR,EPT REF CACHE		;GET AND CACHE DATA FROM EPT [260]
	MB WAIT,GEN ARX,SKP AD0		;TEST FOR EVEN/ODD
=0
CNV01:	FE_S,ARX_AR,J/CNV02		;SKIP SWAP
	AR_AR SWAP,J/CNV01		;SWAP HALVES FOR ODD
CNV02:	BRX/ARX,GEN AR,SKP AD NE	;DID WE GET 0 DATA ?
=0	BR/AR,J/UUO			;P=77 OR EPT NOT SET UP
	RSTR VMA_MQ,RETURN1		;[307][326]NO, RESTORE VMA AND EXIT


=1001					;[254]
INC2WD:	SC_#,#/6,J/INC01		;DON'T INC, SET SHIFT
	AR_BR+1,SC_#,#/6,J/INC01	;INC ADDRESS, SET SHIFT
	AR_BRX,J/INC02			;FPD SET. DON'T		[254]
	AR_BRX,J/INC02			;TOUCH POINTER		[254]
INC01:	ARX_SHIFT,AR_BRX,SR_#,#/500	;[256][270]ADDR TO 0-29 IN ARX
					;NEW P TO AR
=0*	AR_AR SWAP,SC_#,#/30.,		;GET NEW P,LOAD SHIFT
		CALL [SHIFT]		;NEW POINTER
;
;	[320] Because of the SR_# above, we must restore the VMA again.
;	[326] Make sure we do a full restore (i.e., include local/global
;	information) so that we distinguish the ACs from shadow memory.
;
	RSTR VMA_MQ,P_P OR #,#/40	;[326] SET BIT 0
	BR/AR,STORE 			;[320] STORE NEW POINTER
	MEM_AR, AR_BRX, SR_#, #/200	;GET DECODE ALLOW PREVIOUS
	P_P-S,SKP SCAD0			;SET UP FOR EXIT
=0
INC02:	SC_P,SET FPD,AR_BR,RETURN1	;DONT ADD
	P_#-S,#/44,J/INC02		;FIX FOR OVERFLOW
.ENDIF/OWGBP