Google
 

Trailing-Edge - PDP-10 Archives - BB-JF16A-SB_1986 - simple.mic
There is 1 other file named simple.mic in the archive. Click here to see a list.
	.BIN
.TOC	"POWER UP SEQUENCE"

	.UCODE

;HERE IS WHERE WE FIRE THE MACHINE UP DURING POWER ON


0:	[MASK]_#, #/377777	;BUILD A MASK WITH
	[MASK]_[MASK]*2 	; A ONE IN 36-BITS AND 0
	[MASK]_[MASK].OR.#,#/1	; IN BITS -2,-1,36,37
	[MAG]_[MASK]*.5 	;MAKE CONSTANT
	[XWD1]_#, #/1		;CONSTANT WITH 1 IN EACH
				; HALF WORD
	[ONE]_0 XWD [1],	;THE CONSTANT 1
	CALL/1			;RESET STACK (CAN NEVER RETURN
				; TO WHERE MR LEFT US)
3:	[AR]_0 XWD [376000]	;ADDRESS OF HALT STATUS
				; BLOCK
	WORK[HSBADR]_[AR]	;SAVE FOR HALT LOOP
	[UBR]_0, ABORT MEM CYCLE ;CLEAR THE UBR AND RESET
				; MEMORY CONTROL LOGIC
	[EBR]_0, LOAD AC BLOCKS ;CLEAR THE EBR AND FORCE
				; PREVIOUS AND CURRENT AC
				; BLOCKS TO ZERO
	[FLG]_0, SET APR ENABLES ;CLEAR THE STATUS FLAGS AND
				; DISABLE ALL APR CONDITIONS
	WORK[APR]_[FLG] 	;ZERO REMEMBERED ENABLES

	WORK[TIME0]_[FLG]	;CLEAR TIME BASE
	WORK[TIME1]_[FLG]	; ..
.IF/FULL
	AC[BIN0]_0		;COMPUTE A TABLE OF POWERS OF
	AC[BIN1]_1		; TEN
	[AR]_0, SC_19.		;WE WANT TO GET 22 NUMBERS
	WORK[DECLO]_1		;STARTING WITH 1
	WORK[DECHI]_0		; ..
	[HR]_#, WORK/DECLO	;ADDRESS OF LOW WORD
	[BRX]_#, WORK/DECHI	;ADDRESS OF HIGH WORD
TENLP:	[BRX]_[BRX]+1, LOAD VMA ;ADDRESS THE HIGH WORD
=0*	[ARX]_AC[BIN1], 	;LOW WORD TO ARX
	CALL [DBSLOW]		;MULTIPLY BY TEN
	RAM_[BR]		;SAVE HIGH WORD
	[HR]_[HR]+1, LOAD VMA	;WHERE TO STORE LOW WORD
	RAM_[ARX], STEP SC	;STORE LOW WORD AND SEE IF
				; WE ARE DONE
=0	J/TENLP 		;NOT YET--KEEP GOING
	[BR].XOR.#, 3T, SKIP ADL.EQ.0, #/330656
				;DID WE GET THE RIGHT ANSWER
				; IN THE TOP 18 BITS?
=0**0	HALT [MULERR]		;NO--CPU IS BROKEN
.ENDIF/FULL
=0**1	[PI]_0, CALL [LOADPI]	;CLEAR PI STATE
=1**1				;CLEAR REGISTERS SO NO
				;PARITY ERROR HAPPEN
.IFNOT/FULL
	[ARX]_0 		;WRITTEN WHILE COMPUTING POWERS
	[BR]_0			;OF 10
	[BRX]_0
.ENDIF/FULL
	[T1]_0 XWD [120]	;RH OF 120 CONTAINS START ADDRESS
				; FOR SIMULATOR. FOR THE REAL
				; MACHINE IT IS JUST DATA WITH
				; GOOD PARITY.
=
;THE CODE UNDER .IF/SIM MUST USE THE SAME ADDRESS AS THE CODE
; UNDER .IFNOT/SIM SO THAT MICROCODE ADDRESSES DO NOT CHANGE BETWEEN
; VERSIONS
.IF/SIM
	VMA_[T1], START READ	;READ THE WORD
	MEM READ, [PC]_MEM, HOLD LEFT, J/START
				;GO FIRE UP SIMULATOR AT THE
				; PROGRAMS STARTING ADDRESS
.IFNOT/SIM
	[PC]_0, 		;CLEAR LH OF PC
	LEAVE USER,		;ENTER EXEC MODE
	LOAD FLAGS		;CLEAR TRAP FLAGS
	[T1]_#, HALT/POWER,	;LOAD T1 WITH POWER UP CODE
	J/PWRON			;ENTER HALT LOOP. DO NOT STORE
				; HALT STATUS BLOCK
.ENDIF/SIM
.TOC	"THE INSTRUCTION LOOP -- START NEXT INSTRUCTION"

;ALL INSTRUCTIONS EXCEPT JUMP'S AND UUO'S END UP HERE
1400:
DONE:	DONE
1401:	VMA_[PC]+1, NEXT INST FETCH, FETCH
=0
SKIP:	VMA_[PC]+1, NEXT INST FETCH, FETCH
	DONE


;16-WAY DISPATCH BASED ON NEXT INSTRUCTION
=0000
NICOND:
=0001	[AR]_0 XWD [423],	;TRAP TYPE 3
				; GET ADDRESS OF TRAP INST
	TURN OFF PXCT,		;CLEAR PXCT
	J/TRAP			;PROCESS TRAP (INOUT.MIC)
=0010	[AR]_0 XWD [422],	;TRAP TYPE 2
	TURN OFF PXCT,		;CLEAR PXCT
	J/TRAP			;GO TRAP
=0011	[AR]_0 XWD [421],	;TRAP TYPE 1
	TURN OFF PXCT,		;TURN OF PXCT
	J/TRAP			;GO TRAP
=0101	HALT [CSL]		;"HA" COMMAND TO 8080
=0111
	VMA_[PC],		;LOAD VMA
	FETCH,			;INDICATE INSTRUCTION FETCH
	J/XCTGO 		;GO GET INSTRUCTION
;THE NEXT SET OF CASES ARE USED WHEN THERE IS A FETCH
; IN PROGESS
=1000
NICOND-FETCH:
=1001	[AR]_0 XWD [423],	;TRAP TYPE 3
	TURN OFF PXCT,
	J/TRAP
=1010	[AR]_0 XWD [422],	;TRAP TYPE 2
	TURN OFF PXCT,
	J/TRAP
=1011	[AR]_0 XWD [421],	;TRAP TYPE 1
	TURN OFF PXCT,
	J/TRAP
=1101	HALT [CSL]		;"HA" COMMAND TO 8080
=1111
XCTGO:	MEM READ,		;WAIT FOR MEMORY
	[HR]_MEM,		;PUT DATA IN HR
	LOAD INST,		;LOAD IR & AC #
	J/INCPC 		;GO BUMP PC
=
;HERE WE POINT PC TO NEXT INSTRUCTION WHILE WE WAIT FOR
; EFFECTIVE ADDRESS LOGIC TO SETTLE
INCPC:	VMA_[PC]+1,		;ADDRESS OF NEXT INSTRUCTION
	FETCH/1,		;INSTRUCTION FETCH
	TURN OFF PXCT,		;CLEAR EFFECT OF PXCT
	EA MODE DISP		;DISPACTH OF INDEXING AND @

;MAIN EFFECTIVE ADDRESS CALCULATION
=0001
EACALC:
;
;	THE FIRST 4 CASES ARE USED ONLY FOR JRST
;

;CASE 0 -- JRST 0,FOO(XR)
	[PC]_[HR]+XR,		;UPDATE PC
	HOLD LEFT,		;ONLY RH
	LOAD VMA, FETCH,	;START GETTING IT
	NEXT INST FETCH 	;START NEXT INST

;CASE 2 -- JRST 0,FOO
	[PC]_[HR],		;NEW PC
	HOLD LEFT,		;ONLY RH
	LOAD VMA, FETCH,	;START GETTING IT
	NEXT INST FETCH 	;START NEXT INST

;CASE 4 -- JRST 0,@FOO(XR)
	[HR]_[HR]+XR,		;ADD IN INDEX
	START READ,		;START TO FETCH @ WORD
	LOAD VMA,		;PUT ADDRESS IN VMA
	J/FETIND		;GO DO MEM WAIT (FORGET ABOUT JRST)

;CASE 6 -- JRST 0,@FOO
	VMA_[HR],		;LOAD UP ADDRESS
	START READ,		;START TO FETCH @ WORD
	J/FETIND		;GO DO MEM WAIT (FORGET ABOUT JRST)
;
;THESE 4 ARE FOR THE NON-JRST CASE
;

;CASE 10 -- JUST INDEXING
INDEX:	[HR]_[HR]+XR,		;ADD IN INDEX REGISTER
	HOLD LEFT		;JUST DO RIGHT HALF

;CASE 12 -- NO INDEXING OR INDIRECT
NOMOD:	[AR]_EA,		;PUT 0,,E IN AR
	PXCT DATA, AREAD	;DO ONE OR MORE OF THE FOLLWING
				; ACCORDING TO THE DROM:
				;1. LOAD VMA
				;2. START READ OR WRITE
				;3. DISPATCH TO 40-57
				;   OR DIRECTLY TO EXECUTE CODE

;CASE 14 -- BOTH INDEXING AND INDIRECT
BOTH:	[HR]_[HR]+XR,		;ADD IN INDEX REGISTER
	LOAD VMA, PXCT EA,	;PUT ADDRESS IN VMA
	START READ, J/FETIND	;START CYCLE AND GO WAIT FOR DATA

;CASE 16 -- JUST INDIRECT
INDRCT: VMA_[HR],		;LOAD ADDRESS OF @ WORD
	START READ, PXCT EA	;START CYCLE


;HERE TO FETCH INDIRECT WORD
FETIND: MEM READ, [HR]_MEM,	;GET DATA WORD
	HOLD LEFT,		;JUST RIGHT HALF
	LOAD IND EA		;RELOAD @ AND INDEX FLOPS

XCT2:	VMA_[PC],		;PUT PC BACK IN VMA
	FETCH/1,		;TURN ON FETCH FLAG
	EA MODE DISP,		;REDO CALCULATION FOR
	J/EACALC		; NEW WORD
.TOC	"THE INSTRUCTION LOOP -- FETCH ARGUMENTS"
;HERE ON AREAD DISP TO HANDLE VARIOUS CASES OF ARGUMENT FETCH

;CASE 0 -- READ (E)
40:	MEM READ,		;WAIT FOR DATA
	[AR]_MEM,		;PUT WORD IN AR
	INST DISP		;GO TO EXECUTE CODE

;CASE 1 -- WRITE (E)
41:	[AR]_AC,		;PUT AC IN AR
	INST DISP		;GO TO EXECUTE CODE

;CASE 2 -- DOUBLE READ
42:	MEM READ,		;WAIT FOR DATA
	[AR]_MEM		;PUT HI WORD IN AR
	VMA_[HR]+1, PXCT DATA,	;POINT TO E+1
	START READ		;START MEMORY CYCLE
	MEM READ,		;WAIT FOR DATA
	[ARX]_MEM,		;LOW WORD IN ARX
	INST DISP		;GO TO EXECUTE CODE

;CASE 3 -- DOUBLE AC
43:	[AR]_AC 		;GET HIGH AC
	[ARX]_AC[1],		;PUT C(AC+1) IN ARX
	INST DISP		;GO TO EXECUTE CODE

;CASE 4 -- SHIFT
44:
SHIFT:	READ [AR],		;LOOK AT EFFECTIVE ADDRESS
	SKIP DP18,		;SEE IF LEFT OR RIGHT
	SC_SHIFT-1,		;PUT NUMBER OF PLACES TO SHIFT IN
	LOAD FE,		; SC AND FE
	INST DISP		;GO DO THE SHIFT

;CASE 5 -- SHIFT COMBINED
45:	Q_AC[1] 		;PUT LOW WORD IN Q
	[BR]_AC*.5 LONG 	;PUT AC IN BR & SHIFT BR!Q RIGHT
	[BR]_[BR]*.5 LONG,	;SHIFT BR!Q 1 MORE PLACE RIGHT
	J/SHIFT 		;GO DO SHIFT SETUP
;CASE 6 -- FLOATING POINT IMMEDIATE
46:	[AR]_[AR] SWAP,		;FLIP BITS TO LEFT HALF
	J/FPR0			;JOIN COMMON F.P. CODE

;CASE 7 -- FLOATING POINT
47:	MEM READ,		;WAIT FOR MEMORY (SPEC/MEM WAIT)
	[AR]_MEM		;DATA INTO AR
=0
FPR0:	READ [AR],		;LOOK AT NUMBER
	SC_EXP, FE_EXP, 	;PUT EXPONENT IN SC & FE
	SKIP DP0,		;SEE IF NEGATIVE
	CALL [ARSIGN]		;EXTEND AR SIGN
FPR1:	[ARX]_0,		;ZERO ARX
	INST DISP		;GO TO EXECUTE CODE

;CASE 10 -- READ THEN PREFETCH
50:	MEM READ,		;WAIT FOR DATA
	[AR]_MEM THEN FETCH,	;PUT DATA IN AR AND START A READ
				; VMA HAS PC+1.
	INST DISP		;GO DO IT

;CASE 11 -- DOUBLE FLOATING READ
51:	SPEC MEM READ,		;WAIT FOR DATA
	[BR]_MEM,		;HOLD IN BR
	SC_EXP, FE_EXP, 	;SAVE EXPONENT
	SKIP DP0, 3T		;SEE IF MINUS
=0	[AR]_[AR]+1,		;POINT TO E+1
	LOAD VMA, PXCT DATA,	;PUT IN VMA
	START READ, J/DFPR1	;GO GET POSITIVE DATA
	[AR]_[AR]+1,		;POINT TO E+1
	LOAD VMA, PXCT DATA,	;PUT IN VMA
	START READ		;GO GET NEGATIVE DATA
	[BR]_-SIGN,		;SMEAR MINUS SIGN
	J/DFPR2 		;CONTINUE BELOW
DFPR1:	[BR]_+SIGN		;SMEAR PLUS SIGN
DFPR2:	MEM READ, 3T,		;WAIT FOR MEMORY
	[ARX]_(MEM.AND.[MAG])*.5,
	ASH			;SET SHIFT PATHS
	[AR]_[BR]*.5		;SHIFT AR
	[AR]_[AR]*.5,		;COMPLETE SHIFTING
	SC_FE			;PAGE FAIL MAY HAVE ZAPPED
				; THE SC.
	VMA_[PC], FETCH,	;GET NEXT INST
	INST DISP		;DO THIS ONE
;CASE 12 -- TEST FOR IO LEGAL
52:	SKIP IO LEGAL		;IS IO LEGAL?
=0	UUO			;NO
	INST DISP		;YES--DO THE INSTRUCTION


;CASE 13 -- RESERVED
;53:

;CASE 14 -- RESERVED
;54:

;CASE 15 -- RESERVED
;55:

;CASE 16 -- RESERVED
;56:

;CASE 17 -- RESERVED
;57:

;EXTEND AR SIGN.
;CALL WITH SKIP ON AR0, RETURNS 1 ALWAYS
=0
ARSIGN:	[AR]_+SIGN, RETURN [1]	;EXTEND + SIGN
	[AR]_-SIGN, RETURN [1]	;EXTEND - SIGN
.TOC	"THE INSTRUCTION LOOP -- STORE ANSWERS"

;NOTE:	INSTRUCTIONS WHICH STORE IN BOTH AC AND MEMORY
;	(E.G. ADDB, AOS)  MUST STORE IN MEMORY FIRST
;	SO THAT IF A PAGE FAIL HAPPENS THE  AC IS
;	STILL INTACT.

1500:
BWRITE: ;BASE ADDRESS OF BWRITE DISPATCH

;CASE 0 -- RESERVED
;1500:

;CASE 1  --  RESERVED
;1501:

;CASE 2  --  RESERVED
;1502:

;CASE 3  --  RESERVED
;1503:

;CASE 4 -- STORE SELF
1504:
STSELF: SKIP IF AC0,		;IS AC # ZERO?
	J/STBTH1		;GO TO STORE BOTH CASE

;CASE 5 -- STORE DOUBLE AC
1505:
DAC:	AC[1]_[ARX],		;STORE AC 1
	J/STAC			;GO STORE AC

;CASE 6 -- STORE DOUBLE BOTH (KA10 STYLE MEM_AR ONLY)
1506:
STDBTH: MEM WRITE,		;WAIT FOR MEMORY
	MEM_[AR],		;STORE AR
	J/DAC			;NOW STORE AC & AC+1

;CASE 7 -- RESERVED
;1507:
;CASE 10  --  RESERVED
;1510:

;CASE 11  --  RESERVED
;1511:

;CASE 12  --  RESERVED
;1512:

;CASE 13  --  RESERVED
;1513:

;CASE 14  --  RESERVED
1514:
FL-BWRITE:			;THE NEXT 4 CASES ARE ALSO 
				;USED IN FLOATING POINT
	HALT	[BW14]

;CASE 15 -- STORE AC
1515:
STAC:	AC_[AR],		;STORE AC
	NEXT INST		;DO NEXT INSTRUCTION

;CASE 16 -- STORE IN MEMORY
1516:
STMEM:	MEM WRITE,		;WAIT FOR MEMORY
	MEM_[AR],		;STORE AR
	J/DONE			;START FETCH OF NEXT

;CASE 17 -- STORE BOTH
1517:
STBOTH: MEM WRITE,		;WAIT FOR MEMORY
	MEM_[AR],		;STORE AR
	J/STAC			;NOW STORE AC

=0
STBTH1: MEM WRITE,		;WAIT FOR MEMORY
	MEM_[AR],		;STORE AR
	J/STAC			;NOW STORE AC
STORE:	MEM WRITE,		;WAIT FOR MEMORY
	MEM_[AR],		;STORE AC
	J/DONE			;START NEXT INST
.TOC	"MOVE GROUP"

	.DCODE
200:	R-PF,	AC,	J/STAC		;MOVE
	I-PF,	AC,	J/STAC		;MOVEI
	W,	M,	J/MOVE		;MOVEM
	RW,	S,	J/STSELF	;MOVES

204:	R-PF,	AC,	J/MOVS		;MOVS
	I-PF,	AC,	J/MOVS		;MOVSI
	W,	M,	J/MOVS		;MOVSM
	RW,	S,	J/MOVS		;MOVSS

210:	R-PF,	AC,	J/MOVN		;MOVN
	I-PF,	AC,	J/MOVN		;MOVNI
	W,	M,	J/MOVN		;MOVNM
	RW,	S,	J/MOVN		;MOVNS

214:	R-PF,	AC,	J/MOVM		;MOVM
	I-PF,	AC,	J/STAC		;MOVMI
	W,	M,	J/MOVM		;MOVMM
	RW,	S,	J/MOVM		;MOVNS
	.UCODE

1402:
MOVS:	[AR]_[AR] SWAP,EXIT

1403:
MOVM:	READ [AR], SKIP DP0, J/MOVE

1404:
MOVE:	EXIT
1405:
MOVN:	[AR]_-[AR],		;NEGATE NUMBER
	AD FLAGS, 3T,		;UPDATE FLAGS
	J/MOVE			;STORE ANSWER
.TOC	"EXCH"

	.DCODE
250:	R,W TEST,	AC,	J/EXCH
	.UCODE

1406:
EXCH:	[BR]_AC,		;COPY AC TO THE BR
	START WRITE		;START A WRITE CYCLE
	MEM WRITE,		;COMPLETE WRITE CYCLE
	MEM_[BR],		;STORE BR (AC) IN MEMORY
	J/STAC			;STORE THE AR IN AC. NOTE: AR
				; WAS LOADED WITH MEMORY OPERAND
				; AS PART OF INSTRUCTION DISPATCH
.TOC	"HALFWORD GROUP"
;	DESTINATION LEFT HALF

	.DCODE
500:	R-PF,	AC,	J/HLL
	I-PF,	AC,	J/HLL
	RW,	M,	J/HRR		;HLLM = HRR EXCEPT FOR STORE
	RW,	S,	J/MOVE		;HLLS = MOVES

	R-PF,	AC,	J/HRL
	I-PF,	AC,	J/HRL
	RW,	M,	J/HRLM
	RW,	S,	J/HRLS

510:	R-PF,	AC,	J/HLLZ
	I-PF,	AC,	J/HLLZ
	W,	M,	J/HLLZ
	RW,	S,	J/HLLZ

	R-PF,	AC,	J/HRLZ
	I-PF,	AC,	J/HRLZ
	W,	M,	J/HRLZ
	RW,	S,	J/HRLZ

520:	R-PF,	AC,	J/HLLO
	I-PF,	AC,	J/HLLO
	W,	M,	J/HLLO
	RW,	S,	J/HLLO

	R-PF,	AC,	J/HRLO
	I-PF,	AC,	J/HRLO
	W,	M,	J/HRLO
	RW,	S,	J/HRLO

530:	R-PF,	AC,	J/HLLE
	I-PF,	AC,	J/HLLE
	W,	M,	J/HLLE
	RW,	S,	J/HLLE

	R-PF,	AC,	J/HRLE
	I-PF,	AC,	J/HRLE
	W,	M,	J/HRLE
	RW,	S,	J/HRLE
;	DESTINATION RIGHT HALF

540:	R-PF,	AC,	J/HRR
	I-PF,	AC,	J/HRR
	RW,	M,	J/HLL		;HRRM = HLL EXCEPT FOR STORE
	RW,	S,	J/MOVE		;HRRS = MOVES

	R-PF,	AC,	J/HLR
	I-PF,	AC,	J/HLR
	RW,	M,	J/HLRM
	RW,	S,	J/HLRS

550:	R-PF,	AC,	J/HRRZ
	I-PF,	AC,	J/HRRZ
	W,	M,	J/HRRZ
	RW,	S,	J/HRRZ

	R-PF,	AC,	J/HLRZ
	I-PF,	AC,	J/HLRZ
	W,	M,	J/HLRZ
	RW,	S,	J/HLRZ

560:	R-PF,	AC,	J/HRRO
	I-PF,	AC,	J/HRRO
	W,	M,	J/HRRO
	RW,	S,	J/HRRO

	R-PF,	AC,	J/HLRO
	I-PF,	AC,	J/HLRO
	W,	M,	J/HLRO
	RW,	S,	J/HLRO

570:	R-PF,	AC,	J/HRRE
	I-PF,	AC,	J/HRRE
	W,	M,	J/HRRE
	RW,	S,	J/HRRE

	R-PF,	AC,	J/HLRE
	I-PF,	AC,	J/HLRE
	W,	M,	J/HLRE
	RW,	S,	J/HLRE

	.UCODE
;FIRST THE GUYS THAT LEAVE THE OTHER HALF ALONE

;THE AR CONTAINS THE MEMORY OPERAND. SO WE WANT TO PUT THE LH OF
; AC INTO AR TO DO A HRR. OBVIOUS THING FOR HLL.
1407:
HRR:	[AR]_AC,HOLD RIGHT,EXIT
1410:
HLL:	[AR]_AC,HOLD LEFT,EXIT

;HRL FLOW:
;AT HRL AR CONTAINS:
;
;	!------------------!------------------!
;	!     LH OF (E)    !	 RH OF (E)    !
;	!------------------!------------------!
;
;AR_AR SWAP GIVES:
;
;	!------------------!------------------!
;	!     RH OF (E)    !	 LH OF (E)    !
;	!------------------!------------------!
;
;AT HLL, AR_AC,HOLD LEFT GIVES:
;
;	!------------------!------------------!
;	!     RH OF (E)    !	 RH OF AC     !
;	!------------------!------------------!
;
;THE EXIT MACRO CAUSES THE AR TO BE STORED IN AC (AT STAC).
; THE REST OF THE HALF WORD IN THIS GROUP ARE VERY SIMILAR.

1411:
HRL:	[AR]_[AR] SWAP,J/HLL
1412:
HLR:	[AR]_[AR] SWAP,J/HRR

1413:
HRLM:	[AR]_[AR] SWAP
	[AR]_AC,HOLD LEFT,J/MOVS
1414:
HRLS:	[AR]_[AR] SWAP,HOLD RIGHT,EXIT

1415:
HLRM:	[AR]_[AR] SWAP
	[AR]_AC,HOLD RIGHT,J/MOVS
1416:
HLRS:	[AR]_[AR] SWAP,HOLD LEFT,EXIT
;NOW THE HALFWORD OPS WHICH CONTROL THE "OTHER" HALF.
; ENTER WITH 0,,E (E) OR (AC) IN AR

1417:
HRRE:	READ [AR],SKIP DP18
1420:
HRRZ:	[AR] LEFT_0, EXIT
1421:
HRRO:	[AR] LEFT_-1, EXIT

1422:
HRLE:	READ [AR],SKIP DP18
1424:
HRLZ:	[AR]_#,#/0,HOLD RIGHT,J/MOVS
1425:
HRLO:	[AR]_#,#/777777,HOLD RIGHT,J/MOVS

1423:
HLRE:	READ [AR],SKIP DP0
1426:
HLRZ:	[AR]_#,#/0,HOLD LEFT,J/MOVS
1427:
HLRO:	[AR]_#,#/777777,HOLD LEFT,J/MOVS

1430:
HLLE:	READ [AR],SKIP DP0
1432:
HLLZ:	[AR] RIGHT_0, EXIT
1433:
HLLO:	[AR] RIGHT_-1, EXIT
.TOC	"DMOVE, DMOVN, DMOVEM, DMOVNM"

	.DCODE
120:	DBL R,	DAC,	J/DAC
	DBL R,	AC,	J/DMOVN
	.UCODE

1434:
DMOVN:	CLEAR ARX0, CALL [DBLNGA]
1436:	AC[1]_[ARX], J/STAC

	.DCODE
124:	DBL AC, 	J/DMOVN1
	W,		J/DMOVNM
	.UCODE


1565:
DMOVNM: [ARX]_AC[1],CALL [DBLNEG]
1567:
DMOVN1: [HR]+[ONE],		;GET E+1
	LOAD VMA,		;PUT THAT IN VMA
	START WRITE,		;STORE IN E+1
	PXCT DATA		;DATA CYCLE
	MEM WRITE, MEM_[ARX]	;STORE LOW WORD
	VMA_[HR],		;GET E
	LOAD VMA,		;SAVE IN VMA
	PXCT DATA,		;OPERAND STORE
	START WRITE,		;START MEM CYCLE
	J/STORE 		;GO STORE AR
.TOC	"BOOLEAN GROUP"

	.DCODE
400:	I-PF,	AC,	J/SETZ
	I-PF,	AC,	J/SETZ
	IW,	M,	J/SETZ
	IW,	B,	J/SETZ
	.UCODE

1441:
SETZ:	[AR]_0, EXIT

	.DCODE
404:	R-PF,	AC,	J/AND
	I-PF,	AC,	J/AND
	RW,	M,	J/AND
	RW,	B,	J/AND
	.UCODE

1442:
AND:	[AR]_[AR].AND.AC,EXIT

	.DCODE
410:	R-PF,	AC,	J/ANDCA
	I-PF,	AC,	J/ANDCA
	RW,	M,	J/ANDCA
	RW,	B,	J/ANDCA
	.UCODE

1443:
ANDCA:	[AR]_[AR].AND.NOT.AC,EXIT

	.DCODE
414:	R-PF,	AC,	J/MOVE	 ;SETM = MOVE
	I-PF,	AC,	J/MOVE
	RW,	M,	J/MOVE	 ;SETMM = NOP THAT WRITES MEMORY
	RW,	B,	J/MOVE	 ;SETMB = MOVE THAT WRITES MEMORY

420:	R-PF,	AC,	J/ANDCM
	I-PF,	AC,	J/ANDCM
	RW,	M,	J/ANDCM
	RW,	B,	J/ANDCM
	.UCODE

1444:
ANDCM:	[AR]_.NOT.[AR],J/AND

	.DCODE
424:	R,		J/DONE
	I,		J/DONE
	W,	M,	J/MOVE		;SETAM = MOVEM
	W,	M,	J/MOVE		;SETAB, TOO
	.UCODE
	.DCODE
430:	R-PF,	AC,	J/XOR
	I-PF,	AC,	J/XOR
	RW,	M,	J/XOR
	RW,	B,	J/XOR
	.UCODE

1445:
XOR:	[AR]_[AR].XOR.AC,EXIT

	.DCODE
434:	R-PF,	AC,	J/IOR
	I-PF,	AC,	J/IOR
	RW,	M,	J/IOR
	RW,	B,	J/IOR
	.UCODE

1446:
IOR:	[AR]_[AR].OR.AC,EXIT

	.DCODE
440:	R-PF,	AC,	J/ANDCB
	I-PF,	AC,	J/ANDCB
	RW,	M,	J/ANDCB
	RW,	B,	J/ANDCB
	.UCODE

1447:
ANDCB:	[AR]_.NOT.[AR],J/ANDCA

	.DCODE
444:	R-PF,	AC,	J/EQV
	I-PF,	AC,	J/EQV
	RW,	M,	J/EQV
	RW,	B,	J/EQV
	.UCODE

1450:
EQV:	[AR]_[AR].EQV.AC,EXIT

	.DCODE
450:	I-PF,	AC,	J/SETCA
	I-PF,	AC,	J/SETCA
	IW,	M,	J/SETCA
	IW,	B,	J/SETCA
	.UCODE

1451:
SETCA:	[AR]_.NOT.AC,EXIT
	.DCODE
454:	R-PF,	AC,	J/ORCA
	I-PF,	AC,	J/ORCA
	RW,	M,	J/ORCA
	RW,	B,	J/ORCA
	.UCODE

1452:
ORCA:	[BR]_.NOT.AC
	[AR]_[AR].OR.[BR],EXIT

	.DCODE
460:	R-PF,	AC,	J/SETCM
	I-PF,	AC,	J/SETCM
	RW,	M,	J/SETCM
	RW,	B,	J/SETCM
	.UCODE

1453:
SETCM:	[AR]_.NOT.[AR],EXIT

	.DCODE
464:	R-PF,	AC,	J/ORCM
	I-PF,	AC,	J/ORCM
	RW,	M,	J/ORCM
	RW,	B,	J/ORCM
	.UCODE

1454:
ORCM:	[AR]_.NOT.[AR],J/IOR

	.DCODE
470:	R-PF,	AC,	J/ORCB
	I-PF,	AC,	J/ORCB
	RW,	M,	J/ORCB
	RW,	B,	J/ORCB
	.UCODE

1455:
ORCB:	[AR]_[AR].AND.AC,J/SETCM

	.DCODE
474:	I-PF,	AC,	J/SETO
	I-PF,	AC,	J/SETO
	IW,	M,	J/SETO
	IW,	B,	J/SETO
	.UCODE

1456:
SETO:	[AR]_-[ONE], EXIT
.TOC	"ROTATES AND LOGICAL SHIFTS -- ROT, LSH, JFFO"

	.DCODE
240:	SH,		J/ASH
	SH,		J/ROT
	SH,		J/LSH
	I,		J/JFFO
	I-PF,		J/ASHC
245:	SHC,		J/ROTC
	SHC,		J/LSHC
	.UCODE


;HERE IS THE CODE FOR LOGICAL SHIFT. THE EFFECTIVE ADDRESS IS
; IN AR.
1612:
LSH:	[AR]_AC,		;PICK UP AC
	FE_-FE-1,		;NEGATIVE SHIFT
	J/LSHL			;SHIFT LEFT
1613:	[AR]_AC.AND.MASK,	;MAKE IT LOOK POSITIVE
	FE_FE+1, 		;UNDO -1 AT SHIFT
	J/ASHR			;GO SHIFT RIGHT

LSHL:	[AR]_[AR]*2,		;SHIFT LEFT
	SHIFT, J/STAC		;FAST SHIFT & GO STORE AC
;HERE IS THE CODE FOR ARITHMETIC SHIFT. THE EFFECTIVE ADDRESS IS
; IN AR.

ASH36 LEFT	"[AR]_[AR]*2 LONG, ASHC, STEP SC, ASH AROV"

1622:
ASH:	Q_0, J/ASHL0		;HARDWARE ONLY DOES ASHC
1623:	[AR]_AC,		;GET THE ARGUMENT
	FE_FE+1 		;FE HAS NEGATIVE SHIFT COUNT
ASHR:	[AR]_[AR]*.5,		;SHIFT RIGHT
	ASH, SHIFT,		;FAST SHIFT
	J/STAC			;STORE AC WHEN DONE

ASHL0:	[AR]_AC*.5,		;GET INTO 9 CHIPS
	STEP SC 		;SEE IF NULL SHIFT
=0
ASHL:	ASH36 LEFT, J/ASHL	;SHIFT LEFT
				;SLOW BECAUSE WE HAVE TO
				; TEST FOR OVERFLOW

ASHX:	[AR]_[AR]*2, J/STAC	;SHIFT BACK INTO 10 CHIPS
;HERE IS THE CODE FOR ROTATE. THE EFFECTIVE ADDRESS IS
; IN AR.
1632:
ROT:	[AR]_AC*.5,		;PICK UP THE AC (& SHIFT)
	FE_-FE-1,		;NEGATIVE SHIFT COUNT
	J/ROTL			;ROTATE LEFT
1633:	[AR]_AC*.5,		;PICK UP THE AC (& SHIFT)
	FE_FE+1 		;NEGATIVE SHIFT COUNT
	[AR]_[AR]*.5		;PUT IN 9 DIPS
	[AR]_[AR]*.5,		;SHIFT RIGHT
	ROT, SHIFT		;FAST SHIFT
ASHXX:	[AR]_[AR]*2,J/ASHX	;SHIFT TO STD PLACE

ROTL:	[AR]_[AR]*.5		;PUT IN RIGHT 36-BITS
	[AR]_[AR]*2,		;ROTATE LEFT
	ROT, SHIFT,		;FAST SHIFT
	J/ASHXX 		;ALL DONE--SHIFT BACK
1462:
JFFO:	[BR]_AC.AND.MASK, 4T,	;GET AC WITH NO SIGN
	SKIP AD.EQ.0		; EXTENSION. SKIP IF
				; ZERO.
=0	[PC]_[AR],		;NOT ZERO--JUMP
	LOAD VMA, FETCH,	;GET NEXT INST
	J/JFFO1 		;ENTER LOOP
	AC[1]_0, J/DONE 	;ZERO--DONE

JFFO1:	FE_-12. 		;WHY -12.? WELL THE
				; HARDWARE LOOKS AT
				; BIT -2 SO THE FIRST
				; 2 STEPS MOVE THE BR
				; OVER. WE ALSO LOOK AT
				; THE DATA BEFORE THE SHIFT
				; SO WE END UP GOING 1 PLACE
				; TOO MANY. THAT MEANS THE
				; FE SHOULD START AT -3.
				; HOWEVER, WE COUNT THE FE BY
				; 4  (BECAUSE THE 2 LOW ORDER
				; BITS DO NOT COME BACK) SO
				; FE_-12.
=0
JFFOL:	[BR]_[BR]*2,		;SHIFT LEFT
	FE_FE+4,		;COUNT UP BIT NUMBER
	SKIP DP0, J/JFFOL	;LOOP TILL WE FIND THE BIT
	[AR]_FE 		;GET ANSWER BACK
	[AR]_[AR].AND.# CLR LH,#/77 ;MASK TO 1 COPY
	AC[1]_[AR], NEXT INST	;STORE AND EXIT
.TOC	"ROTATES AND LOGICAL SHIFTS -- LSHC"

;SHIFT CONNECTIONS WHEN THE SPECIAL FUNCTION "LSHC" IS DONE:
;
;   !-!   !----!------------------------------------!
;   !0!-->!0000!	 HIGH ORDER 36 BITS	    !  RAM FILE
;   !-!   !----!------------------------------------!
;						   ^
;						   :
;		....................................
;		:
;	  !----!------------------------------------!
;	  !0000!	  LOW ORDER 36 BITS	    !  Q-REGISTER
;	  !----!------------------------------------!
;						   ^
;						   :
;						  !-!
;						  !0!
;						  !-!
;

1464:
LSHC:	STEP SC, J/LSHCL
1465:	READ [AR], SC_-SHIFT-1
	STEP SC
=0
LSHCR:	[BR]_[BR]*.5 LONG,STEP SC,LSHC,J/LSHCR
	[BR]_[BR]*2 LONG,J/LSHCX

=0
LSHCL:	[BR]_[BR]*2 LONG,LSHC,STEP SC,J/LSHCL
	[BR]_[BR]*2 LONG
LSHCX:	[BR]_[BR]*2 LONG
	AC_[BR], J/ASHCQ1
.TOC	"ROTATES AND LOGICAL SHIFTS -- ASHC"


1466:
ASHC:	READ [AR],		;PUT AR ON DP
	SC_SHIFT, LOAD FE,	;PUT SHIFT IN BOTH SC AND FE
	SKIP ADR.EQ.0		;SEE IF NULL SHIFT
=0	Q_AC[1],		;NOT NULL--GET LOW WORD
	J/ASHC1 		;CONTINUE BELOW
NIDISP: NEXT INST		;NULL--ALL DONE
ASHC1:	[BR]_AC*.5 LONG,	;GET HIGH WORD
				;AND SHIFT Q
	SKIP/SC 		;SEE WHICH DIRECTION
=0	[BR]_[BR]*.5,		;ADJUST POSITION
	SC_FE+S#, S#/1776,	;SUBRTACT 2 FROM FE
	J/ASHCL 		;GO LEFT
	[BR]_[BR]*.5,		;ADJUST POSITION
	SC_S#-FE, S#/1776	;SC_-2-FE, SC_+# OF STEPS
=0				;HERE TO GO RIGHT
ASHCR:	[BR]_[BR]*.5 LONG,	;GO RIGHT
	ASHC,			;SET DATA PATHS FOR ASHC (SEE DPE1)
	STEP SC, J/ASHCR	;COUNT THE STEP AND KEEP LOOPING
	[BR]_[BR]*2 LONG,	;PUT BACK WHERE IT GOES
	ASHC, J/ASHCX		;COMPLETE INSTRUCTION

=0
ASHCL:	[BR]_[BR]*2 LONG,	;GO LEFT
	ASHC, ASH AROV, 	;SEE IF OVERFLOW
	STEP SC, J/ASHCL	;LOOP OVER ALL PLACES
	[BR]_[BR]*2 LONG,	;SHIFT BACK WHERE IT GOES
	ASHC, ASH AROV		;CAN STILL OVERFLOW
ASHCX:	AC_[BR]+[BR], 3T,	;PUT BACK HIGH WORD
	SKIP DP0		;SEE HOW TO FIX LOW SIGN
=0	Q_Q.AND.#, #/377777,	;POSITIVE, CLEAR LOW SIGN
	HOLD RIGHT, J/ASHCQ1	;GO STORE ANSWER
	Q_Q.OR.#, #/400000,	;NEGATIVE, SET LOW SIGN
	HOLD RIGHT		;IN LEFT HALF
ASHCQ1: AC[1]_Q, NEXT INST	;PUT BACK Q AND EXIT
.TOC	"ROTATES AND LOGICAL SHIFTS -- ROTC"

;SHIFT CONNECTIONS WHEN THE SPECIAL FUNCTION "ROTC" IS DONE:
;
;	  !----!------------------------------------!
;   .....>!0000!	 HIGH ORDER 36 BITS	    !  RAM FILE
;   :	  !----!------------------------------------!
;   :						   ^
;   :						   :
;   :	............................................
;   :	:
;   :	: !----!------------------------------------!
;   :	..!0000!	  LOW ORDER 36 BITS	    !  Q-REGISTER
;   :	  !----!------------------------------------!
;   :						   ^
;   :						   :
;   :..............................................:
;

1470:
ROTC:	STEP SC, J/ROTCL
1471:	READ [AR], SC_-SHIFT-1
	STEP SC
=0
ROTCR:	[BR]_[BR]*.5 LONG,STEP SC,ROTC,J/ROTCR
	[BR]_[BR]*2 LONG,J/LSHCX

=0
ROTCL:	[BR]_[BR]*2 LONG,ROTC,STEP SC,J/ROTCL
	[BR]_[BR]*2 LONG,
	J/LSHCX
.TOC	"TEST GROUP"

	.DCODE

;SPECIAL MACROS USED ONLY IN B-FIELD OF TEST INSTRUCTIONS
TN-		"B/4"
TNE		"B/0"
WORD-TNE	"B/10"	;USED IN TIOE
TNA		"B/0"
TNN		"B/4"
WORD-TNN	"B/14"	;USED IN TION
TZ-		"B/5"
TZE		"B/1"
TZA		"B/1"
TZN		"B/5"
TC-		"B/6"
TCE		"B/2"
TCA		"B/2"
TCN		"B/6"
TO-		"B/7"
TOE		"B/3"
TOA		"B/3"
TON		"B/7"

600:	I,		J/DONE		;TRN- IS NOP
	I,		J/DONE		;SO IS TLN-
	I,	TNE,	J/TDXX
	I,	TNE,	J/TSXX
	I,	TNA,	J/TDX
	I,	TNA,	J/TSX
	I,	TNN,	J/TDXX
	I,	TNN,	J/TSXX

610:	I,		J/DONE		;TDN- IS A NOP
	I,		J/DONE		;TSN- ALSO
	R,	TNE,	J/TDXX
	R,	TNE,	J/TSXX
	R,	TNA,	J/TDX
	R,	TNA,	J/TSX
	R,	TNN,	J/TDXX
	R,	TNN,	J/TSXX

620:	I,	TZ-,	J/TDX
	I,	TZ-,	J/TSX
	I,	TZE,	J/TDXX
	I,	TZE,	J/TSXX
	I,	TZA,	J/TDX
	I,	TZA,	J/TSX
	I,	TZN,	J/TDXX
	I,	TZN,	J/TSXX
630:	R,	TZ-,	J/TDX
	R,	TZ-,	J/TSX
	R,	TZE,	J/TDXX
	R,	TZE,	J/TSXX
	R,	TZA,	J/TDX
	R,	TZA,	J/TSX
	R,	TZN,	J/TDXX
	R,	TZN,	J/TSXX

640:	I,	TC-,	J/TDX
	I,	TC-,	J/TSX
	I,	TCE,	J/TDXX
	I,	TCE,	J/TSXX
	I,	TCA,	J/TDX
	I,	TCA,	J/TSX
	I,	TCN,	J/TDXX
	I,	TCN,	J/TSXX

650:	R,	TC-,	J/TDX
	R,	TC-,	J/TSX
	R,	TCE,	J/TDXX
	R,	TCE,	J/TSXX
	R,	TCA,	J/TDX
	R,	TCA,	J/TSX
	R,	TCN,	J/TDXX
	R,	TCN,	J/TSXX
660:	I,	TO-,	J/TDX
	I,	TO-,	J/TSX
	I,	TOE,	J/TDXX
	I,	TOE,	J/TSXX
	I,	TOA,	J/TDX
	I,	TOA,	J/TSX
	I,	TON,	J/TDXX
	I,	TON,	J/TSXX

670:	R,	TO-,	J/TDX
	R,	TO-,	J/TSX
	R,	TOE,	J/TDXX
	R,	TOE,	J/TSXX
	R,	TOA,	J/TDX
	R,	TOA,	J/TSX
	R,	TON,	J/TDXX
	R,	TON,	J/TSXX
	.UCODE

;THESE 64 INSTRUCTIONS ARE DECODED BY MASK MODE(IMMEDIATE OR MEMORY)
; IN THE A FIELD, DISPATCH TO HERE ON THE J FIELD, AND RE-DISPATCH
; FOR THE MODIFICATION ON THE B FIELD.

; ENTER WITH 0,E OR (E) IN AR, B FIELD BITS 2 AND 3 AS FOLLOWS:
; 0 0	NO MODIFICATION
; 0 1	0S
; 1 0	COMPLEMENT
; 1 1	ONES
;   THIS ORDER HAS NO SIGNIFICANCE EXCEPT THAT IT CORRESPONDS TO THE
;   ORDER OF INSTRUCTIONS AT TGROUP.

;THE BIT 1 OF THE B FIELD IS USED TO DETERMINE THE SENSE
; OF THE SKIP
; 1	SKIP IF AC.AND.MASK .NE. 0 (TXX- AND TXXN)
; 0	SKIP IF AC.AND.MASK .EQ. 0 (TXXA AND TXXE)

;BIT 0 IS UNUSED AND MUST BE ZERO


1472:
TSX:	[AR]_[AR] SWAP		;TSXX AND TLXX
1473:
TDX:	[BR]_0,TEST DISP	; ALWAYS AND NEVER SKIP CASES

1474:
TSXX:	[AR]_[AR] SWAP		;TSXE, TSXN, TLXE, TLXN
1475:
TDXX:	[BR]_[AR].AND.AC,	;TDXE, TDXN, TRXE, TRXN
	TEST DISP
;TEST DISP DOES AN 8 WAY BRANCH BASED ON THE B-FIELD OF DROM

=1100
TEST-TABLE:

;CASE 0 & 4	-- TXNX
TXXX:	READ [BR], TXXX TEST, 3T, J/DONE

;CASE 1 & 5 -- TXZ AND TXZX
	[AR]_.NOT.[AR],J/TXZX

;CASE 2 & 6 -- TXC AND TXCX
	[AR]_[AR].XOR.AC,J/TDONE

;CASE 3 & 7 -- TXO AND TXOX
	[AR]_[AR].OR.AC,J/TDONE

;THE SPECIAL FUNCTION TXXX TEST CAUSES A MICROCODE SKIP IF
; AD.EQ.0 AND DROM B IS 0-3 OR AD.NE.0 AND DROM B IS 4-7.

TXZX:	[AR]_[AR].AND.AC
TDONE:	AC_[AR],J/TXXX
;	READ BR,TXXX TEST,J/DONE
.TOC	"COMPARE -- CAI, CAM"

	.DCODE

;SPECIAL B-FIELD ENCODING USED BY SKIP-JUMP-COMPARE CLASS
; INSTRUCTIONS:

SJC-	"B/0"	;NEVER
SJCL	"B/1"	;LESS
SJCE	"B/2"	;EQUAL
SJCLE	"B/3"	;LESS EQUAL
SJCA	"B/4"	;ALWAYS
SJCGE	"B/5"	;GREATER THAN OR EQUAL
SJCN	"B/6"	;NOT EQUAL
SJCG	"B/7"	;GREATER

	.UCODE

;COMPARE TABLE
=1000
SKIP-COMP-TABLE:

;CASE 0 -- NEVER
	DONE

;CASE 1 -- LESS
	READ [AR], SKIP DP0,J/DONE

;CASE 2 -- EQUAL
SKIPE:	READ [AR], SKIP AD.EQ.0,J/DONE

;CASE 3 -- LESS OR EQUAL
	READ [AR], SKIP AD.LE.0,J/DONE

;CASE 4 -- ALWAYS
	VMA_[PC]+1, NEXT INST FETCH, FETCH

;CASE 5 -- GREATER THAN OR EQUAL
	READ [AR], SKIP DP0,J/SKIP

;CASE 6 -- NOT EQUAL
	READ [AR], SKIP AD.EQ.0,J/SKIP

;CASE 7 -- GREATER
	READ [AR], SKIP AD.LE.0,J/SKIP
	.DCODE
300:	I,	SJC-,	J/DONE	;CAI
	I,	SJCL,	J/CAIM
	I,	SJCE,	J/CAIM
	I,	SJCLE,	J/CAIM
	I,	SJCA,	J/CAIM
	I,	SJCGE,	J/CAIM
	I,	SJCN,	J/CAIM
	I,	SJCG,	J/CAIM

310:	R,	SJC-,	J/CAIM	;CAM
	R,	SJCL,	J/CAIM
	R,	SJCE,	J/CAIM
	R,	SJCLE,	J/CAIM
	R,	SJCA,	J/CAIM
	R,	SJCGE,	J/CAIM
	R,	SJCN,	J/CAIM
	R,	SJCG,	J/CAIM
	.UCODE

1476:
CAIM:	[AR]_AC-[AR], 3T, SKIP-COMP DISP
.TOC	"ARITHMETIC SKIPS -- AOS, SOS, SKIP"
;ENTER WITH (E) IN AR

	.DCODE
330:	R,	SJC-,	J/SKIPS ;NOT A NOP IF AC .NE. 0
	R,	SJCL,	J/SKIPS
	R,	SJCE,	J/SKIPS
	R,	SJCLE,	J/SKIPS
	R,	SJCA,	J/SKIPS
	R,	SJCGE,	J/SKIPS
	R,	SJCN,	J/SKIPS
	R,	SJCG,	J/SKIPS
	.UCODE

1477:
SKIPS:	FIX [AR] SIGN,
	SKIP IF AC0
=0	AC_[AR],SKIP-COMP DISP
	SKIP-COMP DISP

	.DCODE
350:	RW,	SJC-,	J/AOS
	RW,	SJCL,	J/AOS
	RW,	SJCE,	J/AOS
	RW,	SJCLE,	J/AOS
	RW,	SJCA,	J/AOS
	RW,	SJCGE,	J/AOS
	RW,	SJCN,	J/AOS
	RW,	SJCG,	J/AOS
	.UCODE

1431:
AOS:	[AR]_[AR]+1, 3T, AD FLAGS
XOS:	START WRITE
	MEM WRITE,MEM_[AR],J/SKIPS

	.DCODE
370:	RW,	SJC-,	J/SOS
	RW,	SJCL,	J/SOS
	RW,	SJCE,	J/SOS
	RW,	SJCLE,	J/SOS
	RW,	SJCA,	J/SOS
	RW,	SJCGE,	J/SOS
	RW,	SJCN,	J/SOS
	RW,	SJCG,	J/SOS
	.UCODE

1437:
SOS:	[AR]_[AR]-1, 3T, AD FLAGS, J/XOS
.TOC	"CONDITIONAL JUMPS -- JUMP, AOJ, SOJ, AOBJ"
; ENTER WITH E IN AR

=1000
JUMP-TABLE:

;CASE 0 -- NEVER
	AC_[BR], NEXT INST

;CASE 1 -- LESS
	AC_[BR] TEST, SKIP DP0, J/JUMP-

;CASE 2 -- EQUAL
	AC_[BR] TEST, SKIP AD.EQ.0, J/JUMP-

;CASE 3 -- LESS THAN OR EQUAL
	AC_[BR] TEST, SKIP AD.LE.0, J/JUMP-

;CASE 4 -- ALWAYS
JMPA:	AC_[BR], J/JUMPA

;CASE 5 -- GREATER THAN OR EQUAL TO
	AC_[BR] TEST, SKIP DP0, J/JUMPA

;CASE 6 -- NOT EQUAL
	AC_[BR] TEST, SKIP AD.EQ.0, J/JUMPA

;CASE 7 -- GREATER
	AC_[BR] TEST, SKIP AD.LE.0, J/JUMPA

=0
JUMP-:	DONE
	JUMPA

=0
JUMPA:	JUMPA
	DONE

	.DCODE
320:	I,	SJC-,	J/DONE
	I,	SJCL,	J/JUMP
	I,	SJCE,	J/JUMP
	I,	SJCLE,	J/JUMP
	I,	SJCA,	J/JRST
	I,	SJCGE,	J/JUMP
	I,	SJCN,	J/JUMP
	I,	SJCG,	J/JUMP
	.UCODE

1440:
JUMP:	[BR]_AC,JUMP DISP

	.DCODE
340:	I-PF,	SJC-,	J/AOJ
	I,	SJCL,	J/AOJ
	I,	SJCE,	J/AOJ
	I,	SJCLE,	J/AOJ
	I,	SJCA,	J/AOJ
	I,	SJCGE,	J/AOJ
	I,	SJCN,	J/AOJ
	I,	SJCG,	J/AOJ
	.UCODE

1611:
AOJ:	[BR]_AC+1, AD FLAGS, 4T, JUMP DISP

	.DCODE
360:	I-PF,	SJC-,	J/SOJ
	I,	SJCL,	J/SOJ
	I,	SJCE,	J/SOJ
	I,	SJCLE,	J/SOJ
	I,	SJCA,	J/SOJ
	I,	SJCGE,	J/SOJ
	I,	SJCN,	J/SOJ
	I,	SJCG,	J/SOJ
	.UCODE

1542:
SOJ:	[BR]_AC-1, AD FLAGS, 4T, JUMP DISP

	.DCODE
252:	I,	SJCGE,	J/AOBJ
	I,	SJCL,	J/AOBJ
	.UCODE

1547:
AOBJ:	[BR]_AC+1000001,	;ADD 1 TO BOTH HALF WORDS
	INH CRY18, 3T,		;NO CARRY INTO LEFT HALF
	JUMP DISP		;HANDLE EITHER AOBJP OR AOBJN
.TOC	"AC DECODE JUMPS -- JRST, JFCL"

	.DCODE
254:	I,VMA/0, AC DISP,	J/JRST	;DISPATCHES TO 1 OF 16
					; PLACES ON AC BITS
	I,			J/JFCL
	.UCODE

;JRST DISPATCHES TO ONE OF 16 LOC'NS ON AC BITS

=0000
1520:
JRST:	JUMPA			;(0) JRST 0,
1521:	JUMPA			;(1) PORTAL IS SAME AS JRST
1522:	VMA_[PC]-1, START READ, ;(2) JRSTF
	J/JRSTF
1523:	UUO			;(3)
1524:	SKIP KERNEL, J/HALT	;(4) HALT
1525:
XJRSTF0: VMA_[AR], START READ, ;(5) XJRSTF
	J/XJRSTF
1526:	SKIP KERNEL, J/XJEN	;(6) XJEN
1527:	SKIP KERNEL, J/XPCW	;(7) XPCW
1530:	VMA_[PC]-1, START READ, ;(10)
	 SKIP IO LEGAL, J/JRST10
1531:	UUO			;(11)
1532:	VMA_[PC]-1, START READ, ;(12) JEN
	 SKIP IO LEGAL, J/JEN
1533:	UUO			;(13)
1534:	SKIP KERNEL, J/SFM	;(14) SFM
1535:	UUO			;(15)
1536:	UUO			;(16)
1537:	UUO			;(17)
=0*
JRSTF:	MEM READ,		;WAIT FOR DATA
	[HR]_MEM,		;STICK IN HR
	LOAD INST EA,		;LOAD @ AND XR
	CALL [JRST0]		;COMPUTE EA AGAIN
	JUMPA			;JUMP

JRST0:	EA MODE DISP		;WHAT TYPE OF EA?
=100*
	READ XR,		;INDEXED
	LOAD FLAGS,		;GET FLAGS FROM XR
	UPDATE USER,		;ALLOW USER TO SET
	RETURN [2]		;ALL DONE
	READ [HR],		;PLAIN
	LOAD FLAGS,		;LOAD FLAGS FROM INST
	UPDATE USER,		;ALLOW USER TO SET
	RETURN [2]		;RETURN
	[HR]_[HR]+XR,		;BOTH
	LOAD VMA,		;FETCH IND WORD
	START READ,		;START MEM CYCLE
	J/JRST1 		;CONTINUE BELOW
	VMA_[HR],		;INDIRECT
	START READ,		;FETCH IND WORD
	PXCT EA,		;SETUP PXCT STUFF
	J/JRST1 		;CONTINUE BELOW
JRST1:	MEM READ,		;WAIT FOR DATA
	[HR]_MEM,		;LOAD THE HR
	LOAD INST EA,		;LOAD @ AND XR
	J/JRST0 		;LOOP BACK
=0
HALT:	UUO			;USER MODE
	[PC]_[AR]		;EXEC MODE--CHANGE PC
	HALT [HALT]		;HALT INSTRUCTION

=0
JRST10: UUO
	J/JEN2			;DISMISS INTERRUPT
=0000
JEN:	UUO			; FLAGS
	MEM READ,
	[HR]_MEM,		;GET INST
	LOAD INST EA,		;LOAD XR & @
	CALL [JRST0]		;COMPUTE FLAGS
=0011
JEN2:	DISMISS 		;DISMISS INTERRUPT
=0111	CALL LOAD PI		;RELOAD PI HARDWARE
=1111	JUMPA			;GO JUMP
=

1540:
JFCL:	JFCL FLAGS,		;ALL DONE IN HARDWARE
	SKIP JFCL,		;SEE IF SKIPS
	3T,			;ALLOW TIME
	J/JUMP- 		;JUMP IF WE SHOULD
.TOC	"EXTENDED ADDRESSING INSTRUCTIONS"

=0000
XJEN:	UUO			;HERE IF USER MODE
	DISMISS 		;CLEAR HIGHEST INTERRUPT
=0101	READ [MASK], LOAD PI	;NO MORE INTERRUPTS
=1101	ABORT MEM CYCLE,	;AVOID INTERRUPT PAGE FAIL
	J/XJRSTF0		;START READING FLAG WORD
=

XJRSTF: MEM READ, [BR]_MEM	;PUT FLAGS IN BR
	[AR]_[AR]+1,		;INCREMENT ADDRESS
	LOAD VMA,		;PUT RESULT IN VMA
	START READ		;START MEMORY
	MEM READ, [PC]_MEM,	;PUT DATA IN PC
	HOLD LEFT		;IGNORE SECTION NUMBER
	READ [BR], LOAD FLAGS,	;LOAD NEW FLAGS
	UPDATE USER		;BUT HOLD USER FLAG
PISET:	[FLG]_[FLG].AND.NOT.#,	;CLEAR PI CYCLE
	 FLG.PI/1, J/PIEXIT	;RELOAD PI HARDWARE
				; INCASE THIS IS AN
				; INTERRUPT INSTRUCTION

=0
XPCW:	UUO			;USER MODE
	[BR]_FLAGS		;PUT FLAGS IN BR
=0*0
PIXPCW: VMA_[AR], START WRITE,	;STORE FLAGS
	CALL [STOBR]		;PUT BR IN MEMORY
=1*0	VMA_[AR]+1, LOAD VMA,
	START WRITE,		;PREPEARE TO STORE PC
	CALL [STOPC]		;PUT PC IN MEMORY
=1*1	[AR]_[AR]+1,		;DO NEW PC PART
	START READ, J/XJRSTF
=

=0
SFM:	UUO
	VMA_[AR], START WRITE	;STORE FLAGS
	[AR]_FLAGS, J/STORE	;STORE AND EXIT
.TOC	"XCT"

	.DCODE
256:	R,		J/XCT	;OPERAND FETCHED AS DATA
	.UCODE

1541:
XCT:	SKIP KERNEL		;SEE IF MAY BE PXCT
=0
XCT1A:	[HR]_[AR],		;STUFF INTO HR
	DBUS/DP,		;PLACE ON DBUS FOR IR
	LOAD INST,		;LOAD IR, AC, XR, ETC.
	PXCT/E1,		;ALLOW XR TO BE PREVIOUS
	J/XCT1			;CONTINUE BELOW

	READ [HR],		;LOAD PXCT FLAGS
	LOAD PXCT,		; ..
	J/XCT1A			;CONTINUE WITH NORMAL FLOW

XCT1:	WORK[YSAVE]_[HR] CLR LH,;SAVE FOR IO INSTRUCTIONS
	J/XCT2			;GO EXECUTE IT
.TOC	"STACK INSTRUCTIONS -- PUSHJ, PUSH, POP, POPJ"

	.DCODE
260:	I,	B/0,	J/PUSHJ
	IR,	B/2,	J/PUSH
	I,	B/2,	J/POP
	I,		J/POPJ
	.UCODE

;ALL START WITH E IN AR
1543:
PUSH:	MEM READ,		;PUT MEMOP IN BR
	[BR]_MEM		; ..
PUSH1:	[ARX]_AC+1000001,	;BUMP BOTH HALVES OF AC
	INH CRY18,		;NO CARRY
	LOAD VMA,		;START TO STORE ITEM
	START WRITE,		;START MEM CYCLE
	PXCT STACK WORD,	;THIS IS THE STACK DATA WORD
	3T,			;ALLOW TIME
	SKIP CRY0,		;GO TO STMAC, SKIP IF PDL OV
	J/STMAC 		; ..

1544:
PUSHJ:	[BR]_PC WITH FLAGS,	;COMPUTE UPDATED FLAGS
	CLR FPD,		;CLEAR FIRST-PART-DONE
	J/PUSH1 		; AND JOIN PUSH CODE

=0
STMAC:	MEM WRITE,		;WAIT FOR MEMORY
	MEM_[BR],		;STORE BR ON STACK
	B DISP, 		;SEE IF PUSH OR PUSHJ
	J/JSTAC 		;BELOW
;WE MUST STORE THE STACK WORD PRIOR TO SETTING PDL OV IN CASE OF
; PAGE FAIL.
	MEM WRITE,		;WAIT FOR MEMORY
	MEM_[BR]		;STORE BR
SETPDL: SET PDL OV,		;OVERFLOW
	B DISP, 		;SEE IF PUSH OR PUSHJ
	J/JSTAC 		;BELOW

=00
JSTAC:	[PC]_[AR],		;PUSHJ--LOAD PC
	LOAD VMA,		;LOAD ADDRESS
	FETCH			;GET NEXT INST
JSTAC1: AC_[ARX],		;STORE BACK STACK PTR
	NEXT INST		;DO NEXT INST
	AC_[ARX],		;UPDATE STACK POINTER
	J/DONE			;DO NEXT INST
=
1545:
POP:	[ARX]_AC,		;GET POINTER
	LOAD VMA,		;ADDRESS OF STACK WORD
	START READ, 3T,		;START CYCLE
	PXCT STACK WORD 	;FOR PXCT

	MEM READ,		;LOAD BR (QUIT IF PAGE FAIL)
	[BR]_MEM		;STACK WORD TO BR

	[ARX]_[ARX]+#,		;UPDATE POINTER
	#/777777,		;-1 IN EACH HALF
	INH CRY18, 3T,		;BUT NO CARRY
	SKIP CRY0		;SEE IF OVERFLOW

=0	VMA_[AR],		;EFFECTIVE ADDRESS
	PXCT DATA,		;FOR PXCT
	START WRITE,		;WHERE TO STORE RESULT
	J/POPX1			;OVERFLOW

	VMA_[AR],		;EFFECTIVE ADDRESS
	PXCT DATA,		;FOR PXCT
	START WRITE		;WHERE TO STORE RESULT

	MEM WRITE,		;WAIT FOR MEM
	MEM_[BR],		;STORE BR
	B DISP, 		;POP OR POPJ?
	J/JSTAC 		;STORE POINTER


POPX1:	MEM WRITE,		;WAIT FOR MEMORY
	MEM_[BR],		;STORE BR
	J/SETPDL		;GO SET PDL OV

1546:
POPJ:	[ARX]_AC,		;GET POINTER
	LOAD VMA,		;POINT TO STACK WORD
	PXCT STACK WORD, 3T,	;FOR PXCT
	START READ		;START READ
	[ARX]_[ARX]+#,		;UPDATE POINTER
	#/777777,		;-1 IN BOTH HALFS
	INH CRY18, 3T,		;INHIBIT CARRY 18
	SKIP CRY0		;SEE IF OVERFLOW
=0	SET PDL OV		;SET OVERFLOW
	MEM READ, [PC]_MEM,	;STICK DATA IN PC
	HOLD LEFT,		;NO FLAGS
	J/JSTAC1		;STORE POINTER
.TOC	"STACK INSTRUCTIONS -- ADJSP"

	.DCODE
105:	I-PF,	B/0,		J/ADJSP
	.UCODE

1551:
ADJSP:	[AR]_[AR] SWAP, 	;MAKE 2 COPIES OF RH
	HOLD RIGHT
	[BR]_AC,		;READ AC, SEE IF MINUS
	3T,
	SKIP DP0
=0	AC_[BR]+[AR],		;UPDATE AC
	INH CRY18,		;NO CARRY
	SKIP DP0,		;SEE IF STILL OK
	3T,			;ALLOW TIME
	J/ADJSP1		;TEST FOR OFLO
	AC_[BR]+[AR],		;UPDATE AC
	INH CRY18,		;NO CARRY
	SKIP DP0,		;SEE IF STILL MINUS
	3T,			;ALLOW TIME FOR SKIP
	J/ADJSP2		;CONTINUE BELOW

=0
ADJSP1: NEXT INST		;NO OVERFLOW
	SET PDL OV,		;SET PDL OV
	J/NIDISP		;GO DO NICOND DISP

=0
ADJSP2: SET PDL OV,		;SET PDL OV
	J/NIDISP		;GO DO NICOND DISP
	NEXT INST		;NO OVERFLOW
.TOC	"SUBROUTINE CALL/RETURN -- JSR, JSP, JSA, JRA"

	.DCODE
264:	I,		J/JSR
	I,		J/JSP
	I,		J/JSA
	I,		J/JRA
	.UCODE

1550:
JSP:	[BR]_PC WITH FLAGS	;GET PC WITH FLAGS
	CLR FPD,		;CLEAR FIRST-PART-DONE
	AC_[BR],		;STORE FLAGS
	J/JUMPA 		;GO JUMP

1552:
JSR:	[BR]_PC WITH FLAGS,	;GET PC WITH FLAGS
	CLR FPD 		;CLEAR FIRST-PART-DONE
	VMA_[AR],		;EFFECTIVE ADDRESS
	START WRITE		;STORE OLD PC WORD
	MEM WRITE,		;WAIT FOR MEMORY
	MEM_[BR]		;STORE
	[PC]_[AR]+1000001,	;PC _ E+1
	HOLD LEFT,		;NO JUNK IN LEFT
	3T,			;ALLOW TIME FOR DBM
	J/DONE	 		;[127] START AT E+1
				;[127] MUST NICOND TO CLEAR TRAP CYCLE



1554:
JSA:	[BR]_[AR],		;SAVE E
	START WRITE		;START TO STORE
	[ARX]_[AR] SWAP 	;ARX LEFT _ E
=0*0	[AR]_AC, 		;GET OLD AC
	CALL [IBPX]		;SAVE AR IN MEMORY
=1*0	[ARX]_[PC],		;ARX NOW HAS E,,PC
	HOLD LEFT,		; ..
	CALL [AC_ARX]		;GO PUT ARX IN AC
=1*1	[PC]_[BR]+1000001,	;NEW PC
	3T,			;ALLOW TIME
	HOLD LEFT,		;NO JUNK IN PC LEFT
	J/DONE	 		;[127] START AT E+1
				;[127] NICOND MUST CLEAR TRAP CYCLE
=

1555:
JRA:	[BR]_AC 		;GET AC
	[BR]_[BR] SWAP		;OLD E IN BR RIGHT
	VMA_[BR],		;LOAD VMA
	START READ		;FETCH SAVED AC
	MEM READ,		;WAIT FOR MEMORY
	[BR]_MEM,		;LOAD BR WITH SAVE AC
	J/JMPA			;GO JUMP
.TOC	"ILLEGAL INSTRUCTIONS AND UUO'S"
;LUUO'S TRAP TO CURRENT CONTEXT

	.DCODE
030:	I,	B/0,	J/LUUO
	I,	B/1,	J/LUUO
	I,	B/2,	J/LUUO
	I,	B/3,	J/LUUO
	I,	B/4,	J/LUUO
	I,	B/5,	J/LUUO
	I,	B/6,	J/LUUO
	I,	B/7,	J/LUUO

;MONITOR UUO'S -- TRAP TO EXEC

040:	I,		J/MUUO		;CALL
	I,		J/MUUO		;INIT
	I,		J/MUUO
	I,		J/MUUO
	I,		J/MUUO
	I,		J/MUUO
	I,		J/MUUO
	I,		J/MUUO		;CALLI
	I,		J/MUUO		;OPEN
	I,		J/MUUO		;TTCALL
	I,		J/MUUO
	I,		J/MUUO
	I,		J/MUUO
	I,		J/MUUO		;RENAME
	I,		J/MUUO		;IN
	I,		J/MUUO		;OUT
	I,		J/MUUO		;SETSTS
	I,		J/MUUO		;STATO
	I,		J/MUUO		;GETSTS
	I,		J/MUUO		;STATZ
	I,		J/MUUO		;INBUF
	I,		J/MUUO		;OUTBUF
	I,		J/MUUO		;INPUT
	I,		J/MUUO		;OUTPUT
	I,		J/MUUO		;CLOSE
	I,		J/MUUO		;RELEAS
	I,		J/MUUO		;MTAPE
	I,		J/MUUO		;UGETF
	I,		J/MUUO		;USETI
	I,		J/MUUO		;USETO
	I,		J/MUUO		;LOOKUP
	I,		J/MUUO		;ENTER

;EXPANSION OPCODES

100:	I,		J/UUO		;UJEN
	I,		J/UUO101
	I,		J/UUO102	;GFAD
	I,		J/UUO103	;GFSB
;RESERVED OPCODES

000:	I,		J/UUO
104:	I,		J/JSYS		;JSYS
106:	I,		J/UUO106	;GFMP
	I,		J/UUO107	;GFDV
130:	I,	B/0,	J/FP-LONG	;UFA
	I,	B/1,	J/FP-LONG	;DFN
141:	I,	B/2,	J/FP-LONG	;FADL
151:	I,	B/3,	J/FP-LONG	;FSBL
161:	I,	B/4,	J/FP-LONG	;FMPL
171:	I,	B/5,	J/FP-LONG	;FDVL
247:	I,		J/UUO247	;RESERVED
	.UCODE

1661:
UUO101: UUO
1662:
UUO102: UUO
1663:
UUO103: UUO
1664:
JSYS:	UUO
1666:
UUO106: UUO
1667:
UUO107: UUO
1660:
FP-LONG:UUO
1665:
UUO247: UUO
;HERE FOR UUO'S WHICH TRAP TO EXEC
1556:
UUO:	;THIS TAG IS USED FOR ILLEGAL THINGS WHICH DO UUO TRAPS
MUUO:	;THIS TAG IS USED FOR MONITOR CALL INSTRUCTIONS
	[HR]_[HR].AND.#,	;MASK OUT @ AND XR
	#/777740,		;MASK
	HOLD RIGHT		;KEEP RIGHT
;THE UUO MACRO DOES THE ABOVE INSTRUCTION AND GOES TO UUOGO
UUOGO:	[ARX]_0 XWD [424]	;HERE FROM UUO MACRO
				;GET OFFSET TO UPT
=0	[ARX]_[ARX]+[UBR],	;ADDRESS OF MUUO WORD
	CALL [ABORT]		;STOP MEMORY
.IF/KIPAGE
.IF/KLPAGE
	READ [EBR],		;IF BOTH POSSIBLE, SEE WHICH IS ENABLED
	SKIP DP0		;KL PAGING ??
=0
.ENDIF/KLPAGE
	READ [ARX],		;GET THE ADDRESS
	LOAD VMA,		;START WRITE
	VMA PHYSICAL WRITE,	;ABSOLUTE ADDRESS
	J/KIMUUO		;GO STORE KI STYLE
.ENDIF/KIPAGE
.IF/KLPAGE
	[AR]_[HR] SWAP		;PUT IN RIGHT HALF
=0	[AR]_FLAGS,		;FLAGS IN LEFT HALF
	HOLD RIGHT,		;JUST WANT FLAGS
	CALL [UUOFLG]		;CLEAR TRAP FLAGS
	READ [ARX],		;LOOK AT ADDRESS
	LOAD VMA,		;LOAD THE VMA
	VMA PHYSICAL WRITE	;STORE FLAG WORD
=0*	MEM WRITE,		;WAIT FOR MEMORY
	MEM_[AR], CALL [NEXT]	;STORE
	MEM WRITE,		;WAIT FOR MEMORY
	MEM_[PC]		;STORE FULL WORD PC
=000	[HR]_0, 		;SAVE E
	HOLD RIGHT, CALL [NEXT]	;BUT CLEAR OPCODE
.ENDIF/KLPAGE
=010
UUOPCW: MEM WRITE,		;WAIT FOR MEMORY
	MEM_[HR],		;STORE INSTRUCTION IN KI
				; OR FULL WORD E IN KL
	CALL [GETPCW]		;GET PROCESS-CONTEXT-WORD

=011	NEXT [ARX] PHYSICAL WRITE, ;POINT TO NEXT WORD
	CALL [STOBR]		;STORE PROCESS CONTEXT WORD
;NOW WE MUST PICK ONE OF 8 NEW PC WORDS BASED ON PC FLAGS
=111	[BR]_0 XWD [430]	;OFFSET INTO UPT
=
	[BR]_[BR]+[UBR] 	;ADDRESS OF WORD
	[AR]_FLAGS		;GET FLAGS
	TL [AR],		;LOOK AT FLAGS
	#/600			;TRAP SET?
=0	[BR]_[BR].OR.#, 	;YES--POINT TO TRAP CASE
	#/1,			; ..
	HOLD LEFT		;LEAVE LEFT ALONE
	TL [AR],		;USER OR EXEC
	#/10000 		; ..
=0	[BR]_[BR].OR.#, 	;USER
	#/4,			;POINT TO USER WORDS
	HOLD LEFT
	READ [BR],		;LOOK AT ADDRESS
	LOAD VMA,		;PLACE IN VMA
	VMA PHYSICAL,		;PHYSICAL ADDRESS
	START READ		;GET NEW PC WORD
GOEXEC: MEM READ,		;WAIT FOR DATA
	[AR]_MEM		;STICK IN AR
	READ [AR],		;LOOK AT DATA
	LOAD FLAGS,		;LOAD NEW FLAGS
	LEAVE USER,		;ALLOW USER TO LOAD
	LOAD PCU,		;SET PCU FROM USER
	J/JUMPA 		;JUMP

.IF/KIPAGE
;HERE FOR TOPS-10 STYLE PAGING

=00
KIMUUO: MEM WRITE,		;STORE INSTRUCTION
	MEM_[HR], CALL [NEXT]	;IN MEMORY
=10	[AR]_PC WITH FLAGS,	;GET PC WORD
	CALL [UUOFLG]		;CLEAR TRAP FLAGS
=11	MEM WRITE,		;STORE PC WORD
	MEM_[AR],		; ..
	J/UUOPCW		;GO STORE PROCESS CONTEXT
.ENDIF/KIPAGE

UUOFLG:	[AR]_[AR].AND.NOT.#,	;CLEAR TRAP FLAGS
	#/600, HOLD RIGHT,	; IN WORD TO SAVE
	RETURN [1]		; BACK TO CALLER

NEXT:	NEXT [ARX] PHYSICAL WRITE, ;POINT TO NEXT WORD
	RETURN [2]
;HERE FOR LUUO'S
1557:
LUUO:	[AR]_0 XWD [40] 	;AR GET CONSTANT 40
;THE LUUO MACRO DOES THE ABOVE INSTRUCTION AND GOES TO LUUO1
400:				;FOR SIMULATOR
LUUO1:	READ [AR],		;LOAD 40 INTO
	LOAD VMA,		; THE VMA AND
	START WRITE		; PREPARE TO STORE
	[HR]_[HR].AND.#,	;CLEAR OUT INDEX AND @
	#/777740,		; ..
	HOLD RIGHT
	MEM WRITE,		;STORE LUUO IN 40
	MEM_[HR]
	VMA_[AR]+1,		;POINT TO 41
	LOAD VMA,		;PUT 41 IN VMA
	START READ,		;START FETCH
	J/CONT1 		;GO EXECUTE THE INSTRUCTION
.TOC	"ARITHMETIC -- ADD, SUB"

	.DCODE
270:	R-PF,	AC,	J/ADD
	I-PF,	AC,	J/ADD
	RW,	M,	J/ADD
	RW,	B,	J/ADD
	.UCODE

1560:
ADD:	[AR]_[AR]+AC,		;DO THE ADD
	AD FLAGS EXIT, 3T	;UPDATE CARRY FLAGS
				;STORE ANSWER
				;MISSES 3-TICKS BY 3 NS.


	.DCODE
274:	R-PF,	AC,	J/SUB
	I-PF,	AC,	J/SUB
	RW,	M,	J/SUB
	RW,	B,	J/SUB
	.UCODE

1561:
SUB:	[AR]_AC-[AR],		;DO THE SUBTRACT
	AD FLAGS EXIT, 3T	;UPDATE PC CARRY FLAGS
				;ALL DONE
				;MISSES 3-TICKS BY 3 NS.
.TOC	"ARITHMETIC -- DADD, DSUB"

	.DCODE
114:	DBL R,	DAC,	J/DADD
	DBL R,	DAC,	J/DSUB
	.UCODE

1457:
DADD:	[ARX]_[ARX]+AC[1], 4T,	;ADD LOW WORDS
	SKIP CRY1		;SEE IF CARRY TO HIGH WORD
=0
DADD1:	[AR]_[AR]+AC,		;ADD HIGH WORDS
	ADD .25,		;ADD IN ANY CARRY FROM LOW WORD
	AD FLAGS, 4T,		;UPDATE PC FLAGS
	J/CPYSGN		;COPY SIGN TO LOW WORD
	[BR]_.NOT.[MASK]	;SET BITS 35 AND 36 IN
	[AR]_[AR].OR.[BR],	; AR SO THAT ADD .25 WILL
	HOLD LEFT, J/DADD1	; ADD 1.

1615:
DSUB:	[ARX]_AC[1]-[ARX], 4T,	;SUBTRACT LOW WORD
	SKIP CRY1		;SEE IF CARRY
=0	[AR]_AC-[AR]-.25,	;NO CARRY
	AD FLAGS, 4T,		;UPDATE PC FLAGS
	J/CPYSGN		;GO COPY SIGN
	[AR]_AC-[AR], 4T,	;THERE WAS A CARRY
	AD FLAGS		;UPDATE CARRY FLAGS

CPYSGN: FIX [AR] SIGN, SKIP DP0
=0	[ARX]_[ARX].AND.#, #/377777, HOLD RIGHT, J/MOVE
	[ARX]_[ARX].OR.#, #/400000, HOLD RIGHT, J/MOVE

.TOC	"ARITHMETIC -- MUL, IMUL"

	.DCODE
220:	R-PF,	AC,	J/IMUL
	I-PF,	AC,	J/IMUL
	RW,	M,	J/IMUL
	RW,	B,	J/IMUL
	.UCODE
1641:
IMUL:	[BRX]_[AR], AC		;COPY C(E)
	Q_AC, SC_35.		;GET THE AC
=0**	[BRX]_[BRX]*.5 LONG,	;SHIFT RIGHT
	CALL [MULSUB]		;MULTIPLY
	READ [ARX], SKIP AD.EQ.0 ;SEE IF FITS
=0	[ARX]_[ARX]*2, J/IMUL2	;NOT ZERO--SHIFT LEFT
IMUL1:	[AR]_Q, EXIT		;POSITIVE

IMUL2:	[MASK].AND.NOT.[ARX],	;SEE IF ALL SIGN BITS
	SKIP AD.EQ.0		; ..
=0	FIX [ARX] SIGN, 	;NOT ALL SIGN BITS
	SKIP DP0, J/IMUL3	;GIVE + OR - OVERFLOW
	[AR]_[MAG].EQV.Q, EXIT	;NEGATIVE
=0
IMUL3:	[AR]_Q, SET AROV, J/MOVE
	[AR]_[MAG].EQV.Q, SET AROV, J/MOVE


	.DCODE
224:	R-PF,	DAC,	J/MUL
	I-PF,	DAC,	J/MUL
	RW,	M,	J/MUL
	RW,	DBL B,	J/MUL
	.UCODE


1571:
MUL:	Q_[AR], AC		;COPY C(E)
	[T0]_[AR]		;SAVE FOR OVERFLOW TEST
	[BRX]_AC, SC_35.	;GET THE AC
=0**	[BRX]_[BRX]*.5 LONG,	;SHIFT OVER
	CALL [MULSUB]		;MULTIPLY
	[AR]_[ARX]*2		;SHIFT OVER
	FIX [AR] SIGN, SKIP DP0 ;SEE IF NEGATIVE
=0	[ARX]_[MAG].AND.Q,	;POSITIVE
	EXIT
	[T0].AND.[BRX], SKIP DP0 ;TRIED TO SQUARE 1B0?
=0	[ARX]_[MAG].EQV.Q, EXIT	;NO
	[ARX]_[MAG].EQV.Q, 	;YES 
	SET AROV, J/MOVE

.TOC	"ARITHMETIC -- DMUL"

	.DCODE
116:	DBL R,	DAC,		J/DMUL
	.UCODE

.IF/FULL
1566:
DMUL:	[AR]_[AR]*.5		;SHIFT MEM OPERAND RIGHT
	[ARX]_([ARX].AND.[MAG])*.5
	[BR]_[ARX],		;COPY LOW WORD
	SKIP FPD		;SEE IF FIRST PART DONE
;
; BRX * BR ==> C(E+1) * C(AC+1)
;
=000	[BRX]_(AC[1].AND.[MAG])*.5, 3T, ;GET LOW AC
	CALL [DMULGO]		;START MULTIPLY
	[ARX]_(AC[2].AND.[MAG])*.5, 3T, ;FIRST PART DONE
	J/DMUL1 		;GO DO SECOND PART
=100	AC[3]_Q 		;SALT AWAY 1 WORD OF PRODUCT
=
;
; BRX * Q ==> C(E) * C(AC+1)
;
=0**	Q_[AR], SC_35., 	;GO MULT NEXT HUNK
	CALL [QMULT]		; ..
	[T0]_[ARX]		;SAVE PRODUCT
	AC[2]_Q, [ARX]_Q*.5,	;SAVE PRODUCT
	J/DMUL2			;GO DO HIGH HALF
DMUL1:	[T0]_AC[1]*.5		;RESTORE T0
=0*0
;
; BRX * BR ==> C(AC) * C(E+1)
;
DMUL2:	[BRX]_AC*.5,		;PREPARE TO DO HIGH HALF
	CALL [DBLMUL]		; GO DO IT
	AC[1]_[T0]*2, 3T,	;INTERRUPT, SAVE T0
	J/DMLINT		;SET FPD AND INTERRUPT
	AC[2]_Q 		;SAVE PRODUCT
=
	[ARX]_[ARX]+[T0]	;PREPARE FOR LAST MUL
;
; BRX * Q ==> C(AC) * C(E)
;
=0**	Q_[AR], SC_35., 	;DO THE LAST MULTIPLY
	CALL [QMULT]		; GO DO IT
	[ARX]_[ARX]*2,		;SHIFT BACK
	CLR FPD 		;CLEAR FPD
	AC_[ARX] TEST, SKIP DP0 ;PUT BACK INTO AC
=0	AC[1]_Q, J/DMTRAP	;POSITIVE
	AC[1]_[MAG].EQV.Q	;NEGATIVE
	Q_AC[2]
	AC[2]_[MAG].EQV.Q
	Q_AC[3]
	AC[3]_[MAG].EQV.Q
DMTRAP: [AR]_PC WITH FLAGS,	;LOOK AT FLAGS
	SKIP DP0		;SEE IF AROV SET?
=0	DONE			;NO--ALL DONE
	SET AROV, J/DONE	;YES--FORCE TRAP 1 ALSO


;WAYS TO CALL MULTIPLY
DMULGO: [ARX]_0 		;CLEAR ARX
DBLMUL: Q_[BR], SC_35.
	[BRX]_[BRX]*.5
=0**
QMULT:	Q_Q*.5,
	CALL [MULTIPLY]
	[ARX]+[ARX], AD FLAGS,	;TEST FOR OVERFLOW
	3T, RETURN [4]		;AND RETURN

DMLINT: SET FPD, J/FIXPC	;SET FPD, BACKUP PC
				; INTERRUPT
.IFNOT/FULL
1566:
DMUL:	UUO
.ENDIF/FULL
;MULTIPLY SUBROUTINE
;ENTERED WITH:
;	MULTIPLIER IN Q
;	MULTIPLICAND IN BRX
;RETURNS 4 WITH PRODUCT IN ARX!Q

MUL STEP	"A/BRX,B/ARX,DEST/Q_Q*.5,ASHC,STEP SC,MUL DISP"
MUL FINAL	"A/BRX,B/ARX,DEST/Q_Q*2"

MULSUB: [BRX]_[BRX]*.5 LONG
MULSB1: [ARX]_0*.5 LONG,	;CLEAR ARX AND SHIFT Q
	STEP SC,		;COUNT FIRST STEP
	J/MUL+			;ENTER LOOP

;MULTIPLY SUBROUTINE
;ENTERED WITH:
;	MULTIPLIER IN Q
;	MULTIPLICAND IN BRX
;	PARTIAL PRODUCT IN ARX
;RETURNS 4 WITH Q*BRX+ARX IN ARX!Q

MULTIPLY:
	Q_Q*.5, 		;SHIFT Q
	STEP SC,		;COUNT FIRST STEP
	J/MUL+			;ENTER LOOP
;HERE FOR POSITIVE STEPS
=010				;0 IN A POSITIVE STEP
MUL+:	AD/B,			;DON'T ADD
	MUL STEP,		;SHIFT
	J/MUL+			;KEEP POSITIVE
=011				;DONE
	AD/B,			;DON'T ADD
	MUL FINAL,		;SHIFT
	RETURN [4]		;SHIFT Q AND RETURN
=110				;1 IN A POSITIVE STEP
	AD/B-A-.25, ADD .25,	;SUBTRACT
	MUL STEP,		;SHIFT AND COUNT
	J/MUL-			;NEGATIVE NOW
=111				;DONE
	AD/B-A-.25, ADD .25,	;SUBTRACT
	MUL FINAL,		;SHIFT
	RETURN [4]		; AND RETURN

;HERE FOR NEGATIVE STEPS
=010				;0 IN NEGATIVE STEP
MUL-:	AD/A+B, 		;ADD
	MUL STEP,		;SHIFT AND COUNT
	J/MUL+			;POSITIVE NOW
=011				;DONE
	AD/A+B, 		;ADD
	MUL FINAL,		;SHIFT
	RETURN [4]			;FIX Q AND RETURN
=110				;1 IN NEGATIVE STEP
	AD/B,			;DON'T ADD
	MUL STEP,		;SHIFT AND COUNT
	J/MUL-			;STILL NEGATIVE
=111				;DONE
	AD/B,			;DON'T ADD
	MUL FINAL,		;SHIFT
	RETURN [4]			;FIX Q AND RETURN
.TOC	"ARITHMETIC -- DIV, IDIV"

	.DCODE
230:	R-PF,	DAC,	J/IDIV
	I-PF,	DAC,	J/IDIV
	RW,	M,	J/IDIV
	RW,	DBL B,	J/IDIV

234:	R-PF,	DAC,	J/DIV
	I-PF,	DAC,	J/DIV
	RW,	M,	J/DIV
	RW,	DBL B,	J/DIV
	.UCODE

1600:
IDIV:	[BR]_[AR], AC		;COPY MEMORY OPERAND
	Q_AC,			;LOAD Q
	SKIP DP0		;SEE IF MINUS
=0	[AR]_0, 		;EXTEND + SIGN
	J/DIV1			;NOW SAME AS DIV
	[AR]_-1,		;EXTEND - SIGN
	J/DIV1			;SAME AS DIV

1601:
DIV:	[BR]_[AR]		;COPY MEM OPERAND
	[AR]_AC 		;GET AC
	Q_AC[1] 		;AND AC+1
	READ [AR],		;TEST FOR NO DIVIDE
	SKIP AD.EQ.0
=000	.NOT.[AR],		;SEE IF ALL SIGN BITS IN AR
	SKIP AD.EQ.0,		; ..
	J/DIVA			;CONTINUE BELOW
=001
DIV1:	READ [BR],		;SEE IF DIVIDE BY
	SKIP AD.EQ.0		; ZERO
=100
DIV2:	SC_34., 		;NOT ZERO--LOAD STEP COUNT
	CALL [DIVSUB]		;DIVIDE
=101	NO DIVIDE		;DIVIDE BY ZERO
=110	[ARX]_[AR],		;COPY REMAINDER
	J/IMUL1 		;STORE ANSWER
=


=0
DIVA:	[BRX]_[AR],		;HIGH WORD IS NOT SIGNS
	J/DIVB			;GO TEST FOR NO DIVIDE
	READ [BR],		;ALL SIGN BITS
	SKIP AD.EQ.0,		;SEE IF ZERO DIVIDE
	J/DIV2			;BACK TO MAIN FLOW
DIVB:	[ARX]_Q 		;MAKE ABS VALUES
	READ [AR],		;SEE IF +
	SKIP DP0
=00	READ [BR],		;SEE IF +
	SKIP DP0,
	J/DIVC			;CONTINUE BELOW
	CLEAR [ARX]0,		;FLUSH DUPLICATE SIGN
	CALL [DBLNG1]		;NEGATE AR!ARX
=11	READ [BR],		;SEE IF TOO BIG
	SKIP DP0,
	J/DIVC
=
=0
DIVC:	[AR]-[BR],		;COMPUTE DIFFERENCE
	SKIP DP0,		;SEE IF IT GOES
	3T,			;ALLOW TIME
	J/NODIV 		;TEST
	[AR]+[BR],
	SKIP DP0,		;SAME TEST FOR -VE BR
	3T,
	J/NODIV
=0
NODIV:	NO DIVIDE		;TOO BIG
	[AR]_[BRX],		;FITS
	J/DIV1			;GO BACK AND DIVIDE
.TOC	"ARITHMETIC -- DDIV"

	.DCODE
117:	DBL R,	DAC,	J/DDIV
	.UCODE

.IF/FULL
1627:
DDIV:	Q_[ARX].AND.[MAG]	;COPY LOW WORD
	[BR]_[AR]*.5,		;COPY MEMORY OPERAND
	SKIP AD.LE.0		;SEE IF POSITIVE
=0	[BR]_[BR]*.5 LONG,	;POSITIVE
	J/DDIV1 		;CONTINUE BELOW
	[BR]_[BR]*.5 LONG,	;NEGATIVE OR ZERO
	SKIP DP0		;SEE WHICH?
=0	[MAG].AND.Q,		;SEE IF ALL ZERO
	SKIP AD.EQ.0, J/DDIV1	;CONTINUE BELOW
	[T1]_0 XWD [5]		;NEGATE MEM OP
	Q_Q.OR.#, #/600000,	;SIGN EXTEND THE LOW
	HOLD RIGHT		; WORD
	Q_-Q			;MAKE Q POSITIVE
	[BR]_(-[BR]-.25)*.5 LONG, ;NEGATE HIGH WORD
	ASHC, MULTI PREC/1,	;USE CARRY FROM LOW WORD
	J/DDIV3 		;CONTINUE BELOW
=0
DDIV1:	[BR]_[BR]*.5 LONG,	;SHIFT OVER 1 PLACE
	ASHC, J/DDIV2		;CONTINUE BELOW
	NO DIVIDE		;DIVIDE BY ZERO
DDIV2:	[T1]_0 XWD [4]		;MEM OPERAND IS POSITIVE
DDIV3:	[BRX]_Q, AC		;COPY Q

	[AR]_AC*.5, 2T, SKIP DP0 ;GET AC--SEE IF NEGATIVE
=0*1*0
DDIV3A:	Q_AC[1].AND.[MAG],	;POSITIVE (OR ZERO)
	J/DDIV4 		;CONTINUE BELOW
	[T1]_[T1].XOR.#,	;NEGATIVE
	#/7, CALL [QDNEG]	;UPDATE SAVED FLAGS
=1*1*1	[AR]_[AR]*.5,		;SHIFT AR OVER
	J/DDIV3A		;GO BACK AND LOAD Q
=
=0
DDIV4:	[AR]_[AR]*.5 LONG,	;SHIFT AR OVER
	CALL [DDIVS]		;SHIFT 1 MORE PLACE
	[AR]-[BR], 3T, SKIP DP0 ;TEST MAGNITUDE
=0	[AR]-[BR], 2T,
	SKIP AD.EQ.0, J/DDIV5
	[ARX]_Q, J/DDIV5A	;ANSWER FITS

=0
DDIV5:	READ [T1], 3T, DISP/DP, J/NODDIV
	Q-[BRX], 3T, SKIP DP0
=0	READ [T1], 3T, DISP/DP, J/NODDIV
	[ARX]_Q 		;COPY LOW WORD
;HERE WITH EVERYTHING SETUP AND READY TO GO
DDIV5A: Q_AC[2].AND.[MAG]
=0*	Q_Q*.5, SC_34., CALL [DBLDIV]
	[T0]_Q*2 LONG
	Q_Q+[T0]
	AC[0]_Q.AND.[MAG]	;STORE ANSWER
=0	Q_[ARX], CALL [DDIVS]	;SHIFT OUT EXTRA ZERO BIT
	[ARX]_Q 		; ..
	Q_AC[3].AND.[MAG]
=0*	[T0]_[AR]*.5 LONG,	;SHIFT Q, PUT AR ON DP
	SC_34., 		;LOAD SHIFT COUNT
	SKIP DP0,		;LOOK AT AR SIGN
	CALL [DBLDIV]		;GO DIVIDE
	[T0]_Q*2 LONG
	READ [T1], 3T, DISP/DP	;WHAT SIGN IS QUO
=1110	[T0]_[T0]+Q,		;POSITIVE QUO
	J/DDIV5B		;CONTINUE BELOW
	[T0]_-Q*2		;NEGATIVE QUO
	AD/-D-.25, DBUS/RAM, 3T,
	RAMADR/AC#, DEST/Q_AD,
	MULTI PREC/1
	AC_Q, SKIP AD.EQ.0
=0	AC[1]_[T0], J/DDIV5C
	AC[1]_0, J/DDIV6

DDIV5B: AC[1]_[T0].AND.[MAG], J/DDIV6	;STORE LOW WORD IN + CASE

DDIV5C: [T0]_[T0].OR.#, #/400000, HOLD RIGHT
	AC[1]_[T0]

DDIV6:	READ [AR], SKIP DP0	;LOOK AT AR SIGN
=0
DDIV7:	Q_[ARX], J/DDIV8
	Q_[ARX]+[BRX]
	[AR]_[AR]+[BR],
	MULTI PREC/1
	Q_Q+[BRX]
	[AR]_[AR]+[BR],
	MULTI PREC/1
DDIV8:	READ [T1], 3T, DISP/DP
=1101
DDIV8A: [AR]_[AR]*2 LONG, ASHC, ;POSITIVE REMAINDER
	J/DDIV9 		;CONTINUE BELOW
	Q_-Q			;NEGATE REMAINDER IN AR!Q
	[AR]_(-[AR]-.25)*2 LONG,
	MULTI PREC/1, ASHC
DDIV9:	AC[2]_[AR]+[AR], 3T,
	SKIP DP0
=0	AC[3]_Q.AND.[MAG],
	NEXT INST
	Q_Q.AND.[MAG], AC[3]
	AC[3]_[MAG].EQV.Q,
	NEXT INST


;HERE IF WE WANT TO SET NO DIVIDE
=11011
NODDIV: CALL [QDNEG]		;FIXUP AC TO AC+3
	NO DIVIDE		;ABORT DIVIDE

DDIVS:	[AR]_[AR]*.5 LONG, ASHC, RETURN [1]
.IFNOT/FULL
1627:
DDIV:	UUO
.ENDIF/FULL
.TOC	"ARITHMETIC -- DIVIDE SUBROUTINE"

;HERE IS THE SUBROUTINE TO DO DIVIDE
;ENTER WITH:
;	AR!Q = D'END
;	BR = D'SOR
;RETURN 2 WITH:
;	AR = REMAINDER
;	Q = QUOTIENT
;CALLER MUST CHECK FOR ZERO DIVIDE PRIOR TO CALL
;
=1000
DIVSUB:	Q_Q.AND.#,		;CLEAR SIGN BIT IN
	#/377777,		;MASK
	HOLD RIGHT,		;JUST CLEAR BIT 0
	CALL [DIVSGN]		;DO REAL DIVIDE
=1100	RETURN [2]		;ALL POSITIVE
=1101	Q_-Q, RETURN [2]	;-QUO +REM
=1110	Q_-Q			;ALL NEGATIVE
=1111	[AR]_-[AR], RETURN [2]	;NEGATIVE REMAINDER
;HERE IS THE INNER DIVIDE SUBROUTINE
;SAME SETUP AS DIVSUB
;RETURNS WITH AR AND Q POSITIVE AND
;	14 IF ALL POSITIVE
;	15 IF -QUO
;	16 IF ALL NEGATIVE
;	17 IF NEGATIVE REMAINDER

BASIC DIV STEP	"DEST/Q_Q*2, DIV, A/BR, B/AR, STEP SC"
DIV STEP	"BASIC DIV STEP, AD/A+B, DIVIDE/1"
FIRST DIV STEP	"BASIC DIV STEP, AD/B-A-.25, ADD .25"

DIVSGN:	READ [AR], SKIP DP0
=0	[ARX]_0, J/DVSUB2	;REMAINDER IS POSITIVE
	Q_-Q, SKIP AD.EQ.0	;COMPLEMENT LOW WORD
=0	[AR]_.NOT.[AR], J/DVSUB1 ;COMPLEMENT HI WORD
	[AR]_-[AR]		;TWO'S COMPLEMENT HI WORD SINCE
				; LOW WORD WAS ZERO
DVSUB1: [ARX]_#, #/100000	;REMAINDER IS NEGATIVE
DVSUB2: READ [BR], SKIP DP0	;IS THE DIVISOR NEGATIVE
=0
DVSUB3: [AR]_[AR]*.5 LONG,	;START TO PUT IN 9-CHIPS
	J/DIVSET		;JOIN MAIN STREAM
	[BR]_-[BR]		;COMPLEMENT DIVISOR
	[ARX]_[ARX].OR.#, 	;ADJUST SIGN OF QUOTIENT
	#/40000, J/DVSUB3	;USE 9 CHIPS
DIVSET: [AR]_[AR]*.5
	[BR]_[BR]*.5
	[BR]_[BR]*.5
	FIRST DIV STEP
;HERE IS THE MAIN DIVIDE LOOP
=0
DIVIDE: DIV STEP, J/DIVIDE
	[T1]_[T1]*2 LONG, DIVIDE/1, DIV
	[AR]_[AR]*.5, SKIP DP0
=0
FIX++:	[AR]_[AR]*2 LONG, J/FIX1++
	[AR]_[AR]+[BR], J/FIX++
FIX1++: [AR]_[AR]*2 LONG
	Q_[MASK].AND.Q
	READ [ARX], 3T,		;RETURN TO 1 OF 4 PLACES
	DISP/1,			;BASED ON SIGN OF RESULT
	J/14			;RETURN
.TOC	"ARITHMETIC -- DOUBLE DIVIDE SUBROUTINE"
.IF/FULL
;CALL WITH:
;	AR!ARX!Q = 3 WORD DV'END
;	BR!BRX	 = 2 WORD DV'SOR
;RETURN 2 WITH:
;	AR!ARX	 = 2 WORD REMAINDER
;			CORRECT IF POSITIVE (Q IS ODD)
;			WRONG (BY BR!BRX) IF NEGATIVE (Q IS EVEN)
;	Q	 = 1 WORD QUOTIENT
;CALLER MUST CHECK FOR ZERO DIVIDE PRIOR TO CALL
;
;NOTE: THIS SUBROUTINE ONLY WORKS FOR POSITIVE NUMBERS
;
=0
;HERE FOR NORMAL STARTUP
DBLDIV: [ARX]_([ARX]-[BRX])*2 LONG, ;SUBTRACT LOW WORD
	LSHC, J/DIVHI		;GO ENTER LOOP
;SKIP ENTRY POINT IF FINAL STEP IN PREVIOUS ENTRY WAS IN ERROR
	[ARX]_([ARX]+[BRX])*2 LONG, ;CORRECTION STEP
	LSHC, J/DIVHI		;GO ENTER LOOP

;HERE IS DOUBLE DIVIDE LOOP
DIVHI:	AD/A+B, 		;ADD (HARDWARE MAY OVERRIDE)
	A/BR, B/AR,		;OPERANDS ARE AR AND BR
	DEST/AD*2,		;SHIFT LEFT
	SHSTYLE/NORM,		;SET SHIFT PATHS (SEE DPE1)
	MULTI PREC/1,		;INJECT SAVED BITS
	STEP SC 		;COUNT DOWN LOOP
=0	AD/A+B, 		;ADD (HARDWARE MAY OVERRIDE)
	A/BRX, B/ARX,		;LOW WORDS
	DEST/Q_Q*2,		;SHIFT WHOLE MESS LEFT
	SHSTYLE/DIV,		;SET SHIFT PATHS (SEE DPE1)
	DIVIDE/1,		;SAVE BITS
	J/DIVHI 		;KEEP LOOPING
;HERE WHEN ALL DONE
	DEST/Q_Q*2, DIV,	;SHIFT IN LAST Q BIT
	DIVIDE/1,		;GENERATE BIT
	B/HR, RETURN [2]	;ZERO HR AND RETURN
.TOC	"ARITHMETIC -- SUBROUTINES FOR ARITHMETIC"

;QUAD WORD NEGATE
;ARGUMENT IN AC!AC1!AC2!AC3
;LEAVES COPY OF AC!AC1 IN AR!Q
;RETURNS TO CALL!24
QDNEG:	Q_-AC[3]
	AC[3]_Q.AND.[MAG],	;PUT BACK LOW WORD
	SKIP AD.EQ.0		;SEE IF ANY CARRY
=0
COM2A:	Q_.NOT.AC[2], J/COM2	;CARRY--DO 1'S COMPLEMENT
	Q_-AC[2]		;NEXT WORD
	AC[2]_Q.AND.[MAG],	;PUT BACK WORD
	SKIP AD.EQ.0
=0
COM1A:	Q_.NOT.AC[1], J/COM1
	Q_-AC[1]
	AC[1]_Q.AND.[MAG],
	SKIP AD.EQ.0
=0
COM0A:	[AR]_.NOT.AC, J/COM0
	[AR]_-AC, 3T, J/COM0

COM2:	AC[2]_Q.AND.[MAG], J/COM1A
COM1:	AC[1]_Q.AND.[MAG], J/COM0A
COM0:	AC_[AR], RETURN [24]
.ENDIF/FULL

;DOUBLE WORD NEGATE
;ARGUMENT IN AR AND ARX
;RETURNS TO CALL!2

DBLNEG: CLEAR ARX0		;FLUSH DUPLICATE SIGN
DBLNGA: [ARX]_-[ARX],		;FLIP LOW WORD
	SKIP AD.EQ.0		;SEE IF CARRY
=0	[AR]_.NOT.[AR], 	;NO CARRY-- 1 COMP
	AD FLAGS, J/CLARX0	;CLEAR LOW SIGN
	[AR]_-[AR],		;CARRY
	AD FLAGS, 3T, J/CLARX0

;SAME THING BUT DOES NOT SET PC FLAGS
DBLNG1: [ARX]_-[ARX], SKIP AD.EQ.0
=0	[AR]_.NOT.[AR], J/CLARX0
	[AR]_-[AR], J/CLARX0
	.NOBIN
.TOC	"BYTE GROUP -- IBP, ILDB, LDB, IDPB, DPB"


;ALL FIVE INSTRUCTIONS OF THIS GROUP ARE CALLED WITH THE BYTE POINTER
;IN THE AR.  ALL INSTRUCTIONS SHARE COMMON SUBROUTINES.

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

;HERE IS A MACRO TO DO IBP. WHAT HAPPENS IS:
;	THE AR IS PUT ON THE DP.
;	THE BR IS LOADED FROM THE DP WITH BITS 0-5 FROM SCAD
;	THE SCAD COMPUTES P-S
;	IBPS IS CALLED WITH A 4-WAY DISPATCH ON SCAD0 AND FIRST-PART-DONE
;THE MACRO IS WRITTEN WITH SEVERAL SUB-MACROS BECAUSE OF RESTRICTIONS
; IN THE MICRO ASSEMBLER

IBP DP		"AD/D, DEST/A, A/AR, B/BR, DBUS/DBM, DBM/DP, BYTE/BYTE1"
IBP SCAD	"SCAD/A-B, SCADA/BYTE1, SCADB/SIZE"
IBP SPEC	"SCAD DISP, SKIP FPD"
CALL IBP	"IBP DP, IBP SCAD, IBP SPEC, CALL [IBPS], DT/3T"

SET P TO 36-S	"AD/D,DEST/A,A/BR,B/AR,DBUS/DBM,DBM/DP,SCAD/A-B,SCADB/SIZE,BYTE/BYTE1,SCADA/PTR44"

;THE FOLLOWING MACRO IS USED FOR COUNTING SHIFTS IN THE BYTE ROUTINES. IT
; USES THE FE AND COUNTS BY 8. NOTE: BYTE STEP IS A 2S WEIGHT SKIP NOT 1S.
BYTE STEP	"SCAD/A+B,SCADA/S#,S#/1770,SCADB/FE,LOAD FE, 3T,SCAD DISP"
	.BIN

	.DCODE
133:	R,	AC,	J/IBP		;OR ADJBP
134:	R,W TEST,	J/ILDB		;CAN'T USE RPW BECAUSE OF FPD
	R,		J/LDB
	R,W TEST,	J/IDPB
	R,		J/DPB
	.UCODE
1610:
IBP:	SKIP IF AC0		;SEE IF ADJBP
=000	WORK[ADJPTR]_[AR],	;SAVE POINTER
	J/ADJBP 		;GO ADJUST BYTE POINTER
=001	CALL IBP		;BUMP BYTE POINTER
=101	DONE			;POINTER STORED
=

1620:
ILDB:	CALL IBP		;BUMP BYTE POINTER
1624:
LDB:	READ [AR],		;LOOK AT POINTER
	LOAD BYTE EA, FE_P, 3T, ;GET STUFF OUT OF POINTER
	CALL [BYTEA]		;COMPUTE EFFECTIVE ADDRESS
1625:	VMA_[PC], FETCH 	;START FETCH OF NEXT INST
=0*	READ [AR],		;LOOK AT POINTER
	FE_FE.AND.S#, S#/0770,	;MASK OUT JUNK IN FE
	BYTE DISP,		;DISPATCH ON BYTE SIZE
	CALL [LDB1]		;GET BYTE
	AC_[AR], CLR FPD,	;STORE AC
	J/NIDISP		;GO DO NEXT INST

1630:
IDPB:	CALL IBP		;BUMP BYTE POINTER
1634:
DPB:	[ARX]_AC*2		;PUT 7 BIT BYTE IN 28-34
	AD/A, A/ARX, SCAD/A,	;PUT THE BYTE INTO
	SCADA/BYTE5, 3T,	; INTO THE FE REGISTER
	LOAD FE 		; FE REGISTER
	[ARX]_AC		;PUT BYTE IN ARX
=100	READ [AR],		;LOOK AT BYTE POINTER
	LOAD BYTE EA,		;LOAD UP EFFECTIVE ADDRESS
	CALL [BYTEA]		;COMPUTE EFFECTIVE ADDRESS
	READ [AR],		;LOOK AT POINTER AGAIN
	BYTE DISP,		;DISPATCH ON SIZE
	CALL [DPB1]		;GO STORE BYTE
=111	CLR FPD, J/DONE 	;ALL DONE
=
.TOC	"BYTE GROUP -- INCREMENT BYTE POINTER SUBROUTINE"

=00
IBPS:	[AR]_[BR], START WRITE, J/IBPX	;NO OVERFLOW, BR HAS ANSWER
	RETURN [4]			;FIRST PART DONE SET
	SET P TO 36-S, J/NXTWRD 	;WORD OVERFLOW
	RETURN [4]			;FPD WAS SET IGNORE OVERFLOW
					; AND RETURN

NXTWRD: [AR]_[AR]+1, HOLD LEFT, START WRITE	;BUMP Y AND RETURN
IBPX:	MEM WRITE, MEM_[AR], RETURN [4]


.TOC	"BYTE GROUP -- BYTE EFFECTIVE ADDRESS EVALUATOR"

;ENTER WITH POINTER IN AR
;RETURN1 WITH (EA) IN VMA AND WORD IN BR
BYTEAS: EA MODE DISP,		;HERE TO AVOID FPD
	J/BYTEA0		;GO COMPUTE EA
BYTEA:	SET FPD,		;SET FIRST-PART-DONE
	EA MODE DISP		;DISPATCH
=100*
BYTEA0: VMA_[AR]+XR,		;INDEXING
	START READ,		;FETCH DATA WORD
	PXCT BYTE DATA, 	;FOR PXCT
	J/BYTFET		;GO WAIT
	VMA_[AR],		;PLAIN
	START READ,		;START CYCLE
	PXCT BYTE DATA, 	;FOR PXCT
	J/BYTFET		;GO WAIT
	VMA_[AR]+XR,		;BOTH
	START READ,		;START CYCLE
	PXCT BYTE PTR EA,	;FOR PXCT
	J/BYTIND		;GO DO INDIRECT
	VMA_[AR],		;JUST @
	START READ,		;START READ
	PXCT BYTE PTR EA	;FOR PXCT
BYTIND: MEM READ,		;WAIT FOR @ WORD
	[AR]_MEM,		;PUT IN AR
	HOLD LEFT,		;JUST IN RH (SAVE P & S)
	LOAD BYTE EA,		;LOOP BACK
	J/BYTEAS		; ..

BYTFET: MEM READ,		;WAIT FOR BYTE DATA
	[BR]_MEM.AND.MASK,	; WORD. UNSIGNED
	RETURN [1]		;RETURN TO CALLER
.TOC	"BYTE GROUP -- LOAD BYTE SUBROUTINE"

;CALL WITH:
;	WORD IN BR
;	POINTER IN AR
;	P IN FE
;	BYTE DISPATCH
;RETURN2 WITH BYTE IN AR
LDB SCAD	"SCAD/A,BYTE/BYTE5"
7-BIT LDB	"AD/D,DBUS/DBM,DBM/DP,DEST/A,A/BR,B/BR, LDB SCAD"

=000
LDB1:	GEN 17-FE, 3T,		;GO SEE IF ALL THE BITS
	SCAD DISP,		; ARE IN THE LEFT HALF
	J/LDBSWP		;GO TO LDBSWP & SKIP IF LH

;HERE ARE THE 7-BIT BYTES
=001	7-BIT LDB, SCADA/BYTE1, J/LDB7
=010	7-BIT LDB, SCADA/BYTE2, J/LDB7
=100	7-BIT LDB, SCADA/BYTE3, J/LDB7
=101	7-BIT LDB, SCADA/BYTE4, J/LDB7
=111	7-BIT LDB, SCADA/BYTE5, J/LDB7
=

;FOR 7-BIT BYTES WE HAVE BYTE IN BR 28-35 AND JUNK IN REST OF BR.
; WE JUST MASK THE SELECTED BYTE AND SHIFT ONE PLACE RIGHT.
LDB7:	AD/ZERO,RSRC/DA,	;LH_ZERO, RH_D.AND.A
	DBUS/DBM,DBM/#,#/376,	;D INPUT IS 376
	A/BR,			;A IS BR
	B/AR,			;PUT RESULT IN AR
	DEST/AD*.5, 3T, 	;SHIFT RESULT 1 PLACE
	RETURN [2]		;RETURN TO CALLER
;HERE FOR NORMAL BYTES
=00
LDBSWP: FE_-FE, 		;MAKE P NEGATIVE
	J/LDBSH 		;JOIN MAIN LDB LOOP
=10	[BR]_[BR] SWAP		;SHIFT 18 STEPS
=
	[BR]_0, HOLD RIGHT,	;PUT ZERO IN LH
	FE_-FE+S#, S#/220	;UPDATE FE
LDBSH:	[BR]_[BR]*.5,		;SHIFT RIGHT
	FE_FE+10,		;UPDATE THE FE
	MULTI SHIFT/1		;FAST SHIFT
	READ [AR], FE_-S-10	;GET SIZE
	Q_0			;CLEAR Q
	GEN MSK [AR],		;PUT MASK IN Q (WIPEOUT AR)
	FE_FE+10,		;COUNT UP ALL STEPS
	MULTI SHIFT/1		;FAST SHIFT
	GEN MSK [AR]		;ONE MORE BIT
	[AR]_[BR].AND.Q, RETURN [2]
	.NOBIN
.TOC	"BYTE GROUP -- DEPOSIT BYTE IN MEMORY"

;FLOW FOR DPB (NOT 7-BIT BYTE)
;
;FIRST SET ARX TO -1 AND Q TO ZERO AND ROTATE LEFT
; S PLACES GIVING:

;		ARX		  Q
;	+------------------!------------------+
;	!111111111111000000!000000000000111111!
;	+------------------!------------------+
;					!<--->!
;					S BITS
;

;NOW THE AC IS LOAD INTO THE ARX AND BOTH THE ARX AND Q
; ARE SHIFTED LEFT P BITS GIVING:

;	+------------------!------------------+
;	!??????BBBBBB000000!000000111111000000!
;	+------------------!------------------+
;	 <----><---->		  <----><---->
;	  JUNK	BYTE		   MASK P BITS
;

;AT THIS POINT WE ARE ALMOST DONE. WE NEED TO AND
; THE BR WITH .NOT. Q TO ZERO THE BITS FOR THE BYTE
; AND AND ARX WITH Q TO MASK OUT THE JUNK THIS GIVES:
;
;		ARX
;	+------------------+
;	!000000BBBBBB000000!
;	+------------------!
;
;		AR
;	+------------------+
;	!DDDDDD000000DDDDDD!
;	+------------------+
;
;WE NOW OR THE AR WITH ARX TO GENERATE THE ANSWER.
	.BIN

;DEPOSIT BYTE SUBROUTINE
;CALL WITH:
;	BYTE POINTER IN AR
;	BYTE TO STORE IN ARX
;	WORD TO MERGE WITH IN BR
;	(E) OF BYTE POINTER IN VMA
;	7-BIT BYTE IN FE
;	BYTE DISPATCH
;RETURN2 WITH BYTE IN MEMORY
;
DPB SCAD	"SCAD/A+B,SCADA/S#,SCADB/FE,S#/0"
7-BIT DPB	"AD/D,DEST/A,A/BR,DBUS/DBM,DBM/DP,B/AR, DPB SCAD"

=000
DPB1:	READ [AR], FE_-S-10, J/DPBSLO	;NOT SPECIAL
=001	7-BIT DPB, BYTE/BYTE1, J/DPB7
=010	7-BIT DPB, BYTE/BYTE2, J/DPB7
=100	7-BIT DPB, BYTE/BYTE3, J/DPB7
=101	7-BIT DPB, BYTE/BYTE4, J/DPB7
=111	7-BIT DPB, BYTE/BYTE5, J/DPB7
=
DPB7:	[MAG]_[MASK]*.5, START WRITE
	MEM WRITE, MEM_[AR], RETURN [2]


DPBSLO: Q_0			;CLEAR Q
	GEN MSK [MAG],		;GENERATE MASK IN Q (ZAP MAG)
	FE_FE+10,		;COUNT STEPS
	MULTI SHIFT/1		;FAST SHIFT
	GEN MSK [MAG]		;ONE MORE BITS
	READ [AR], 3T, FE_P	;AMOUNT TO SHIFT
	FE_FE.AND.S#, S#/0770	;MASK OUT JUNK
	Q_Q.AND.[MASK], 	;CLEAR BITS 36 AND 37
	FE_-FE			;MINUS NUMBER OF STEPS
	[ARX]_[ARX]*2 LONG,	;SHIFT BYTE AND MASK
	FE_FE+10,		;COUNT OUT STEPS
	MULTI SHIFT/1		;FAST SHIFT
;AT THIS POINT WE HAVE DONE ALL THE SHIFTING WE NEED. THE BYTE IS
; IN ARX AND THE MASK IS IN Q.
	[AR]_.NOT.Q
	[AR]_[AR].AND.[BR]
	[ARX]_[ARX].AND.Q
	[AR]_[AR].OR.[ARX],
	J/DPB7
.TOC	"BYTE GROUP -- ADJUST BYTE POINTER"
.IF/FULL
;FIRST THE NUMBER OF BYTES PER WORD IS COMPUTED FROM THE
; FOLLOWING FORMULA:
;
;		       (  P  )	    ( 36-P )
;  BYTES PER WORD = INT( --- ) + INT( ---- )
;		       (  S  )	    (  S   )
;
;THIS GIVES 2 BYTES PER WORD FOR THE FOLLOWING 12 BIT BYTE:
;	!=====================================!
;	!  6  !////////////!	12     !  6   !
;	!=====================================!
;		P=18 AND S=12
;
;WE GET 3 BYTES/WORD IF THE BYTES FALL IN THE NATURAL PLACE:
;	!=====================================!
;	!    12     !\\\\\\\\\\\\!     12     !
;	!=====================================!
;	       P=12 AND S=12

;WE COME HERE WITH THE BYTE POINTER IN AR, AND ADJPTR
ADJBP:	[ARX]_[AR] SWAP,	;MOVE SIZE OVER
	SC_9.			;READY TO SHIFT
=0
ADJBP0: [ARX]_[ARX]*.5, 	;SHIFT P OVER
	STEP SC,		; ..
	J/ADJBP0		; ..
	[ARX]_([ARX].AND.#)*.5, ;SHIFT AND MASK
	3T,			;WAIT
	#/176			;6 BIT MASK
	[ARX]_#,		;CLEAR LH
	#/0,			; ..
	HOLD RIGHT		; ..
	WORK[ADJP]_[ARX]	;SAVE P
	[BR]_([AR].AND.#)*.5,	;START ON S
	3T,			;EXTRACT S
	#/007700		; ..
	[BR]_[BR] SWAP, 	;SHIFT 18 PLACES
	SC_3			; ..
	[BR]_0, 		;CLEAR LH
	HOLD RIGHT		; ..
=0
ADJBP1: [BR]_[BR]*.5,		;SHIFT S OVER
	STEP SC,		; ..
	J/ADJBP1		; ..
	WORK[ADJS]_[BR],	;SALT S AWAY
	SKIP AD.EQ.0		;SEE IF ZERO
=0	Q_[ARX],		;DIVIDE P BY S
	SC_34.,			;STEP COUNT
	J/ADJBP2		;SKIP NEXT WORD
	[AR]_WORK[ADJPTR], J/MOVE	;S=0 -- SAME AS MOVE
=0*
ADJBP2: [AR]_#, 		;FILL AR WITH SIGN BITS
	#/0,			;POSITIVE
	CALL [DIVSUB]		;GO DIVIDE
	WORK[ADJQ1]_Q		;SAVE QUOTIENT
	Q_#,			;COMPUTE (36-P)/S
	#/36.,			; ..
	HOLD LEFT		;SMALL ANSWER
	Q_Q-WORK[ADJP]		;SUBTRACT P
	[BR]_WORK[ADJS]		;DIVIDE BY S
	SC_34.			;STEP COUNT
=0*	[AR]_#,			;MORE SIGN BITS
	#/0,			; ..
	CALL [DIVSUB]		;GO DIVIDE
	WORK[ADJR2]_[AR]	;SAVE REMAINDER
	[AR]_#, 		;ASSUME NEGATIVE ADJ
	#/777777		;EXTEND SIGN
	AD/D+Q, 		;BR_(P/S)+((36-P)/S)
	DEST/AD,		; ..
	B/BR,			; ..
	RAMADR/#,		; ..
	DBUS/RAM,		; ..
	WORK/ADJQ1,		; ..
	4T,			; ..
	SKIP AD.EQ.0		;SEE IF ZERO
=0	Q_Q+AC, 		;GET ADJUSTMENT
	SC_34.,			;STEP COUNT
	SKIP DP0,		;GO DO DIVIDE
	4T,			;WAIT FOR DP
	J/ADJBP3		;BELOW
	NO DIVIDE		;0 BYTES/WORD
;WE NOW DIVIDE THE ADJUSTMENT BY THE BYTES PER WORD AND FORCE THE
; REMAINDER (R) TO BE A POSITIVE NUMBER (MUST NOT BE ZERO). THE
; QUOTIENT IS ADDED TO THE Y FIELD IN THE BYTE POINTER AND THE NEW
; P FIELD IS COMPUTED BY:
;
;	     (		     ( 36-P ))
; NEW P = 36-((R * S) +  RMDR( ---- ))
;	     (		     (	 S  ))
;
;WE NOW HAVE BYTES/WORD IN BR AND ADJUSTMENT IN Q. DIVIDE TO GET
; WORDS TO ADJUST BY.
=00
ADJBP3: [AR]_#, 		;POSITIVE ADJUSTMENT
	#/0.
	WORK[ADJBPW]_[BR],	;SAVE BYTES/WORD & COMPUTE
	CALL [DIVSUB]		; ADJ/(BYTES/WORD)
;WE NOW WANT TO ADJUST THE REMAINDER SO THAT IT IS POSITIVE
=11	Q_#,			;ONLY RIGHT HALF
	#/0,			; ..
	HOLD RIGHT		; ..
=
	READ [AR],		;ALREADY +
	SKIP AD.LE.0		; ..
=0
ADJBP4: AD/D+Q, 		;ADD Q TO POINTER AND STORE
	DEST/AD,		; ..
	B/BR,			;RESULT TO BR
	RAMADR/#,		;PTR IS IN RAM
	DBUS/RAM,		; ..
	WORK/ADJPTR,		; ..
	INH CRY18,		;JUST RH
	3T,			;WAIT FOR RAM
	J/ADJBP5		;CONTINUE BELOW
	Q_Q-1,			;NO--MAKE Q SMALLER
	HOLD LEFT		; ..
	[AR]_[AR]+WORK[ADJBPW], ;MAKE REM BIGGER
	J/ADJBP4		;NOW HAVE + REMAINDER
ADJBP5: [BRX]_[AR],		;COMPUTE R*S
	SC_35.			;STEP COUNT
	Q_WORK[ADJS]		;GET S
=01*	[BRX]_[BRX]*.5 LONG,	;SHIFT OVER
	CALL [MULSUB]		; ..
	AD/D+Q, 		;AR_(R*S)+RMDR(36-P)/S
	DEST/AD,		; ..
	B/AR,			; ..
	RAMADR/#,		; ..
	3T,			; ..
	DBUS/RAM,		; ..
	WORK/ADJR2		; ..
	[AR]_(#-[AR])*2,	;COMPUTE 36-AR
	3T,			;AND START LEFT
	#/36.			; ..
	[AR]_[AR] SWAP, 	;PUT THE POSITION BACK
	SC_9.			; ..
	[AR]_#, 		;CLEAR JUNK FROM RH
	#/0,			; ..
	HOLD LEFT		; ..
=0
ADJBP6: [AR]_[AR]*2,		;LOOP OVER ALL BITS
	STEP SC,		; ..
	J/ADJBP6		; ..
	[BR]_[BR].AND.#,	; ..
	#/007777,		; ..
	HOLD RIGHT		; ..
	AC_[AR].OR.[BR],	;ALL DONE
	J/DONE
.IFNOT/FULL

ADJBP:	UUO			;NO ADJBP IN SMALL
					; MICROCODE
.ENDIF/FULL
	.NOBIN
.TOC	"BLT"

;THIS CODE PROVIDES A GUARANTEED RESULT IN AC ON COMPLETION OF
; THE TRANSFER (EXCEPT IN THE CASE AC IS PART OF BUT NOT THE LAST WORD
; OF THE DESTINATION BLOCK).  WHEN AC IS NOT PART OF THE DESTINATION
; BLOCK, IT IS LEFT CONTAINING THE ADDRESSES OF THE FIRST WORD FOLLOWING
; THE SOURCE BLOCK (IN THE LH), AND THE FIRST WORD FOLLOWING THE DEST-
; INATION BLOCK (IN THE RH).  IF AC IS THE LAST WORD OF THE DESTINATION
; BLOCK, IT WILL BE A COPY OF THE LAST WORD OF THE SOURCE BLOCK.

;IN ADDITION, A SPECIAL-CASE CHECK IS MADE FOR THE CASE IN WHICH EACH
; WORD STORED IS USED AS THE SOURCE OF THE NEXT TRANSFER.  IN THIS CASE,
; ONLY ONE READ NEED BE PERFORMED, AND THAT DATA MAY BE STORED FOR EACH
; TRANSFER.  THUS THE COMMON USE OF BLT TO CLEAR CORE IS SPEEDED UP.
	.BIN

;HERE TO SETUP FOR A BLT/UBABLT

SETBLT:	[ARX]_[BRX] SWAP	;COPY TO ARX (SRC IN RH)
=0	VMA_[ARX],		;ADDRESS OF FIRST WORD
	START READ,
	PXCT BLT SRC,
	CALL [CLARXL]		;CLEAR THE LEFT HALF OF
	[BRX]_0,		; BOTH SRC AND DEST
	HOLD RIGHT
	Q_[AR]-[BRX]		;NUMBER OF WORDS TO MOVE
	[BR]_Q+1		;LENGTH +1
	[BR]_[BR] SWAP, 	;COPY TO BOTH HALFS
	HOLD RIGHT
	[BR]_AC+[BR],		;FINAL AC
	INH CRY18		;KEEP AC CORRECT IF DEST IS 777777
	STATE_[BLT],RETURN [2]	;SET PAGE FAIL FLAGS

	.DCODE
251:	I,		J/BLT
	.UCODE

1640:
BLT:	[BRX]_AC,CALL [SETBLT]	;FETCH THE AC (DEST IN RH)
1642:	AC_[BR],		;STORE BACK IN AC
	CALL [LOADQ]		;LOAD FIRST WORD INTO Q
1643:	[BR]_[ARX]+1000001,	;SRC+1
	3T,
	HOLD LEFT
	[BR]-[BRX], 3T,		;IS THIS THE CORE CLEAR CASE
	SKIP ADR.EQ.0
=0
BLTLP1: VMA_[BRX],		;NO, GET DEST ADR
	START WRITE,		;START TO STORE NEXT WORD
	PXCT BLT DEST,		;WHERE TO STORE
	J/BLTGO

	;SKIP TO NEXT PAGE IF CLEARING CORE
;CLEAR CORE CASE
	VMA_[BRX],
	START WRITE,
	PXCT BLT DEST
BLTCLR: MEM WRITE,		;STORE WORD
	MEM_Q,
	SKIP/-1 MS		;1 MS TIMER UP
=0	J/BLTGOT		;GO TAKE INTERRUPT
	[BRX]-[AR],		;BELOW E?
	3T,
	SKIP DP0
=0	END BLT,		;NO--STOP BLT
	J/DONE
	[ARX]_[ARX]+1,		;FOR PAGE FAIL LOGIC
	SKIP IRPT
=0	VMA_[BRX]+1,
	LOAD VMA,
	PXCT BLT DEST,
	START WRITE,		;YES--KEEP STORING
	J/BLTCLR
	VMA_[BRX]+1,		;INTERRUPT
	LOAD VMA,
	PXCT BLT DEST,
	START WRITE,
	J/BLTGO

;HERE FOR NORMAL BLT
BLTLP:	MEM READ,		;FETCH
	Q_MEM,
	J/BLTLP1
BLTGO:	MEM WRITE,		;STORE
	MEM_Q
BLTGOT:	[BRX]-[AR],		;BELOW E?
	3T,
	SKIP DP0
=0	END BLT,		;NO--STOP BLT
	J/DONE
	[BRX]_[BRX]+1		;UPDATE DEST ADDRESS
	VMA_[ARX]+1,
	LOAD VMA,
	PXCT BLT SRC,
	START READ,		;YES--MOVE 1 MORE WORD
	J/BLTLP

;HERE TO CLEAN UP AFTER BLT PAGE FAILS
BLT-CLEANUP:
	[AR]_[AR] SWAP		;PUT SRC IN LEFT HALF
	[AR]_WORK[SV.BRX],
	HOLD LEFT
	AC_[AR],		;STORE THE AC AND RETURN
	J/CLEANED
.IF/UBABLT
.TOC	"UBABLT - BLT BYTES TO/FROM UNIBUS FORMAT"

;THESE INSTRUCTION MOVE WORDS FROM BYTE TO UNIBUS AND UNIBUS TO BYTE
;FORMAT.  FORMATS ARE:
;
;BYTE FORMAT:
;
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;; BYTE 0 ;; BYTE 1 ;; BYTE 2 ;; BYTE 3 ;; 4 BITS ;;
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;UNIBUS FORMAT:
;
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;; 2 BITS ;; BYTE 1 ;; BYTE 0 ;; 2 BITS ;; BYTE 3 ;; BYTE 2 ;;
; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;

=0*
BLTX:	[BRX]_AC,		;FETCH THE AC (DEST IN RH)
	CALL [SETBLT]		;DO THE REST OF THE SETUP
	AC_[BR]			;STORE THE FINAL AC IN AC

BLTXLP:	MEM READ,		;READ THE SOURCE WORD
	Q_MEM,			;FROM MEMORY
	B DISP			;SKIP IF BLTUB (OPCODE 717)
=110	Q_Q*.5,			;BLTBU (OPCODE 716) - SHIFT RIGHT 1 BIT
	J/BLTBU1		;CONTINUE INSTRUCTION

	AD/D.AND.Q,DBUS/DBM,	;BLTUB - MASK LOW BYTES, SHIFT LEFT
	DBM/#,#/377,DEST/AD*2,B/T1	;AND STORE RESULT
=00	FE_S#,S#/1767,		;-9 MORE BITS TO PUT LOW BYTE OF LH
	CALL [T1LSH]		; IN TOP OF LH SHIFT LEFT
=01	FE_S#,S#/1772,		;-6 BITS TO PUT HI BYTE TO RIGHT
	CALL [Q_RSH]		; OF LOW BYTE.  
=11	Q_Q.AND.#,#/001774	;KEEP ONLY HI BYTES
=
	AD/A.OR.Q,A/T1,DEST/AD,	;MERGE PAIRS OF BYTES. NOW SWAPPED,
	B/T1			;BUT STILL IN HALF-WORDS
	AD/57,RSRC/0A,A/T1,	;CLEAR LH OF Q WHILE LOADING
	DEST/Q_AD		;RH WITH LOW WORD
	Q_Q*2			;SHIFT LOW WORD ACROSS 1/2 WORD
	Q_Q*2			;AND INTO FINAL POSITION
	[T1]_[T1].AND.# CLR RH,	;CLEAR ALL BUT HIGH 16-BIT WORD
	#/777774,J/BLTXV	;FROM T1 AND CONTINUE
BLTBU1:	Q_Q*.5			;NOW IN 1/2 WORDS
	Q_Q*.5,HOLD LEFT	;INSERT A NULL BIT IN RH
	Q_Q*.5,HOLD LEFT	;ONE MORE - NOW IN HALF WORDS
	AD/D.AND.Q,DBUS/DBM,	;BUT NOT SWAPPED.  COPY RIGHT BYTE
	DBM/#,#/377,DEST/AD*2,B/T1	;TO T1 AND SHIFT LEFT 1 POSITION
=00	FE_S#,S#/1771,		;-7 BITS MORE
	CALL [T1LSH]		;TO FINAL RESTING PLACE
=01	FE_S#,S#/1770,		;-8. LEFT BYTES MOVE RIGHT
	CALL [Q_RSH]		;TO FINAL RESTING PLACE
=11	Q_Q.AND.#,#/377		;WANT ONLY THE NEW BYTES
=

BLTXV:	Q_[T1].OR.Q,		;MERGE RESULTS
	J/BLTXW			;AND STUFF IN MEMORY

T1LSH:	[T1]_[T1]*2,SHIFT,RETURN [1]
Q_RSH:	Q_Q*.5,SHIFT,RETURN [2]

BLTXW:	VMA_[BRX],START WRITE,	;DEST TO VMA
	PXCT BLT DEST
	MEM WRITE,MEM_Q		;STORE
	[BRX]-[AR],3T,SKIP DP0	;DONE?
=0	END BLT,J/DONE		;YES
	[BRX]_[BRX]+1		;NO, INC DEST
	VMA_[ARX]+1,LOAD VMA,	; AND SOURCE (LOADING VMA)
	PXCT BLT SRC,START READ,;START UP MEMORY
	J/BLTXLP		;AND CONTINUE WITH NEXT WORD
.ENDIF/UBABLT