.TOC	"ROTATES AND LOGICAL SHIFTS -- ROT, LSH, JFFO"

	.DCODE
240:	I,	B/0,	J/ASH
	I,	B/0,	J/ROT
	I,	B/2,	J/LSH
	I,		J/JFFO
	I,	B/1,	J/ASHC
	I,		J/ROTC
	I,		J/LSHC
.IFNOT/CIRC
	I,		J/UUO
.IF/CIRC
	I,		J/CIRC
.ENDIF/CIRC
	.UCODE

;ENTER WITH 0,E IN AR
; NOTE THAT VALUES OF SC GREATER THAN 36
; CAUSE THE SHIFTER TO SELECT ARX.

=00***0
LSH:	AR_AC0,ARL/AD,ARX_0.M,SC_EA,
		SKP AR18,J/SHR1

JFFO:	AR_AC0,SKP AD NE,SC_#,#/6
=
=0	AC1_AR,I FETCH,J/NOP		;AC WAS ZERO, NO JUMP
	ARX+MQ_0.M,FE_P,SKP SCAD NE,	;TEST FIRST 6 BITS
		AR_SHIFT,ARL/SH		;DISCARD THEM
=1****0
JFFO1:	AR_SHIFT,FE_P,SKP SCAD NE,	;TEST NEXT 6 BITS
		ARX_ARX-1,J/JFFO1	;LOOP, COUNTING, TILL NE
	P_FE,ARR_0.S,			;RESTORE 6 NON-ZERO BITS
		ARX_ARX*-6		;GET POS GROUP COUNT*6
=*1***0
JFFO2:	SKP AR0,AR_2(AR+1),		;LOOP TO FIND A 1
		ARX_ARX+1,J/JFFO2	;COUNTING AS WE GO
.IFNOT/JPC
	AR_ARX-1,FETCH,J/STRAC1
.IF/JPC
	AR_ARX-1,FETCH,SKP USER
=0	AC1_AR,AR_PC,SC_#,#/32.,J/JPCEX
	AC1_AR,AR_PC,SC_#,#/32.,J/JPCUSR
.ENDIF/JPC

=00***0
ASH:	SC_EA,SKP AR18,			;GET SHIFT AMOUNT
		AR_0S,J/ASHL		;SET LOW PART = 0
ROT:	AR_AC0,ARX_AC0,SC_EA,SKP AR18
=
;SINGLE-WORD LSH/ROT
; FOR ROT, B=0, AR AND ARX BOTH CONTAIN AC
; FOR LSH, B=2, AR HAS AC, ARX IS ZERO

=00
SHR1:	AR_SHIFT,SC_#+SC,#/-36.,	;DO POS (LEFT) SHIFT, CHK RANGE
		SKP SCAD0,J/SHR2
	ARX_AR (AD),AR_ARX (ADX),
		SC_#+SC,#/36.,
		B DISP,SKP SCAD0,J/SHR1	;MAKE NEG SHIFT TO EQUIV POS
SHR2:	AR_SHIFT,SC_#+SC,#/-36.,
		SKP SCAD0,J/SHR2	;BRING SC INTO RANGE
	AC0_AR,I FETCH,J/NOP		;DONE
.TOC	"ROTATE AND LOGICAL SHIFT COMBINED -- ROTC, LSHC"

=00***0
ASHC:	SC_EA,SKP AR18,			;SETUP SHIFT COUNT
		AR_AC1*2,J/ASHL		;GET LOW WORD
ROTC:	ARX_AC1
=	AR_AC0,SC_EA,SKP AR18		;SETUP BOTH AC'S
=1****0
ROT3:	MQ_SHIFT,ARX_AR (AD),
		AR_ARX (ADX),J/ROT4
	ARX_AR (AD),AR_ARX (ADX),
		SC_#+SC,#/36.,SKP SCAD0,J/ROT3

ROT4:	AR_MQ,ARX_SHIFT,
		SC_#+SC,#/-36.,SKP SCAD0
=0	MQ_SHIFT,ARX_AR (AD),
		AR_ARX (ADX),J/ROT4
STDAC:	AC0_AR,AR_ARX,I FETCH,J/STRAC1


.IFNOT/CIRC
1004:					;NEXT TO UUO
.IF/CIRC
=00**00
.ENDIF/CIRC
LSHC:	ARX_AC1,MQ_0.M,J/LSHC1
.IF/CIRC
=01
CIRC:	MQ_AR,AR_AC1,FE_#,SC_#,#/35.,CLR ARX,CALL,J/WDREV
=11	SC_EA,AR_AC0,SKP AR18,J/CIRC3
.ENDIF/CIRC
=
LSHC1:	AR_AC0,SC_EA,FE_#,#/36.,SKP AR18
=*1***0
LSH2:	MQ_SHIFT,AR_ARX (ADX),
		ARX/MQ,FE_#,#/-36.,J/LSH3
	ARX_AR (AD),AR_0.M,MQ_ARX,
		SC_FE+SC,SKP SCAD0,J/LSH2

LSH3:	AR_MQ,ARL/AD,ARX_SHIFT,MQ_0.M,
		SC_FE+SC,SKP SCAD0
=0	MQ_SHIFT,AR_ARX (ADX),ARX/MQ,J/LSH3
	AC0_AR,AR_ARX,I FETCH,J/STRAC1
.TOC	"CIRC INSTRUCTION"

.IF/CIRC
=1****0
CIRC3:	MQ_SHIFT,ARX_AR (AD),AR_ARX (ADX),J/CIRC4
	ARX_AR (AD),AR_ARX (ADX),SC_#+SC,#/36.,SKP SCAD0,J/CIRC3

CIRC4:	AR_MQ,ARX_SHIFT,SC_#+SC,#/-36.,SKP SCAD0
=1***00
	MQ_SHIFT,ARX_AR (AD),AR_ARX (ADX),J/CIRC4
	AC0_AR,AR_ARX,FE_#,SC_#,#/35.,ARX_0S,CALL,J/WDREV
=11	AR_ARX,CLR SC,I FETCH,J/STD1


;SUBROUTINE TO REVERSE A WORD IN AR, RETURNING IT IN ARX.
;ON ENTRY, ARX MUST BE CLEAR, AND SC AND FE MUST BOTH CONTAIN 35.
;ON EXIT, MQ IS COPIED INTO AR.

.IFNOT/CIRC.BIG.OPT
=*1***0
WDREV:	BRX/ARX,SH DISP,J/WDREV1
	AR_MQ,RETURN2
=1*0111
WDREV1:	FE_FE-1,SC/SCAD,SKP SCAD0,ARX_BRX*2,J/WDREV
	FE_FE-1,SC/SCAD,SKP SCAD0,ARX_BRX*2+1,J/WDREV
.IF/CIRC.BIG.OPT
=1****0
WDREV:	SH DISP,BR/AR,AR_ARX (ADX),SC_#,#/32.,J/WDREV1
	AR_MQ,RETURN2

=1*0000
WDREV1:	AR_BR,ARX_SHIFT,FE_FE-#,#/4,SC/SCAD,SKP SCAD0,J/WDREV
	AR_SHIFT,SC_#,#/10,J/WDREV2
	AR_SHIFT,SC_#,#/4,J/WDREV2
	AR_SHIFT,SC_#,#/14,J/WDREV2
	AR_SHIFT,SC_#,#/2,J/WDREV2
	AR_SHIFT,SC_#,#/12,J/WDREV2
	AR_SHIFT,SC_#,#/6,J/WDREV2
	AR_SHIFT,SC_#,#/16,J/WDREV2
	AR_SHIFT,SC_#,#/1,J/WDREV2
	AR_SHIFT,SC_#,#/11,J/WDREV2
	AR_SHIFT,SC_#,#/5,J/WDREV2
	AR_SHIFT,SC_#,#/15,J/WDREV2
	AR_SHIFT,SC_#,#/3,J/WDREV2
	AR_SHIFT,SC_#,#/13,J/WDREV2
	AR_SHIFT,SC_#,#/7,J/WDREV2
	AR_SHIFT,SC_#,#/17,J/WDREV2

WDREV2:	AR0-5_AR0-5 OR SC
	AR_BR,ARX_AR,FE_FE-#,#/4,SC/SCAD,SKP SCAD0,J/WDREV
.ENDIF/CIRC.BIG.OPT
.ENDIF/CIRC
.TOC	"ARITHMETIC SHIFTS -- ASH, ASHC"

;COMMON CODE FOR ARITHMETIC SHIFTS

=*1***0
ASHL:	ARX_AR,AR_AC0,			;INPUT NOW IN AR LONG
		SKP SC NE,J/ASHL1	;CHECK FOR NULL SHIFT
	ARX_AR,AR_AC0,			;HERE IF RIGHT SHIFT
		SC_#+SC,#/36.,SKP SCAD0	;CHECK FOR LONG ONE
=1****0
ASHR1:	BR/AR,ARX_SHIFT,AR_SIGN,J/ASHR2	;LOW OUTPUT TO ARX
	ARX_AR,AR_SIGN,			;HERE IF SHIFT COUNT .GT. 36
		SC_#+SC,#/36.,		;BRING COUNT UP BY 36
		SKP SCAD0,J/ASHR1	;LOOP TILL COUNT REASONABLE

ASHR2:	BRX/ARX,ARX_BR,			;HIGH INPUT TO ARX
		B DISP,J/ASHX

;HERE FOR LEFT ARITHMETIC SHIFT

=*1***0
ASHL1:	I FETCH,J/NOP			;SHIFT 0 IS A NOP
	BR_AR LONG,AR_SIGN		;SAVE INPUT, GEN SIGN WORD
	BR/AR,AR_BR*2 LONG		;SAVE SIGN, GET MAGNITUDE BITS
=0*
ASHL2:	BRX/ARX,ARX_AR,AR_BR,		;HI IN TO ARX, LOW TO BRX
		CALL,J/SHIFT		;CALL SHIFTER TO GET BITS LOST
	SKP AR SIG			;ANY SIGNIFICANT BITS?
=1****0
ASHL3:	AR_ARX,ARX_BRX,			;RESTORE HI TO AR, LOW TO ARX
		GEN #+SC,#/-36.,SKP SCAD0,J/ASHL4
	SET AROV,J/ASHL3		;BITS SHIFTED OUT NE SIGN
=*1***0
ASHL4:	AR_ARX,ARX_0S,			;HERE IF E .GT. 36
		SC_#+SC,#/-36.,J/ASHL2	;SHIFT 36 PLACES, TRY AGAIN
	MQ_SHIFT,AR_BRX,CLR ARX,	;HIGH OUTPUT TO MQ,
		SC_#+SC,#/-1,B DISP	;COMPENSATE FOR EXTRA SHIFT
=1****0
ASHL5:	AR_BR,BRX/ARX,ARX/MQ,		;SIGN TO AR, HIGH OUT TO ARX
		SC_#,#/35.,		;READY TO COMBINE THEM
		B DISP,J/ASHX		;STORE AS APPROPRIATE
	ARX_SHIFT,J/ASHL5		;LOW OUTPUT TO ARX

;HERE TO GET FINAL RESULTS.

=*1***0
ASHX:	AR_SHIFT,I FETCH,J/STORAC	;HERE AFTER ASH
	AR_SHIFT,ARX_BRX,		;HERE AFTER ASHC
		SC_#,#/35.,J/ST2AC