PDP-10 Archive: sources/arith.mic from BB-AS80B-SM

Trailing-Edge - PDP-10 Archives - BB-AS80B-SM_1985 - sources/arith.mic

There are 5 other files named arith.mic in the archive. Click here to see a list.

.TOC	"ADD, SUB"

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

=0****00****
ADD:	AR_AR*AC0,AD/A+B,AD FLAGS,EXIT
=


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

=0****00****
SUB:	AR_AC0,BR/AR
=	AR_AR-BR,AD FLAGS,EXIT

.TOC	"MUL, IMUL"

	.DCODE
220:	R,	AC,	J/IMUL
	I,	AC,	J/IMULI
	RW,	M,	J/IMUL
	RW,	B,	J/IMUL
	.UCODE

.IFNOT/IMULI.OPT
=0****00*01*
IMULI:
.IF/IMULI.OPT
=0****00*000
IMULI:	SKP AR18,GEN AC0,SIGNS DISP,	;OPTIMIZE SPECIAL CASE
		TIME/3T,SC_#,#/17.
=010	MQ_AR,AR_AC0,			;HERE FOR IMULI OF + BY +
		CLR ARX,FE_#,#/-9.,	; 9 STEPS WILL DO
		CALL,J/MULSUB
.ENDIF/IMULI.OPT
IMUL:	MQ_AR,AR_AC0,			;M'IER TO MQ, M'CAND TO AR
		CLR ARX,FE_#,#/-18.,
		CALL,J/MULSUB		;CALL MULTIPLY SUBROUTINE
.IF/IMULI.OPT
=110	AR_SHIFT,SKP AR NE,INH CRY18,	;HERE FROM IMULI
		I FETCH,J/MUL1		; AFTER SHORT MULTIPLY
.ENDIF/IMULI.OPT
	SC_#,#/35.,SKP AR SIG		;CHECK OVERFLOW AND STORE
=
=0
IMUL2:	AR_SHIFT,B WRITE,J/ST6		;STORE LOW WORD OF PRODUCT
	SET AROV,AR_SIGN,J/IMUL2	;NOTE OVERFLOW...


	.DCODE
224:	R,	DBL AC,	J/MUL
	I,	DBL AC,	J/MUL
	RW,	M,	J/MUL
	RW,	DBL B,	J/MUL
	.UCODE

=0****00*000
MUL:	MQ_AR,CLR ARX,			;MULTIPLIER TO MQ
		AR_AC0,FE_#,#/-18.,	;SETUP MULTIPLICAND AND STEP CNT
		CALL,J/MULSUB		;AND GO TO SUBROUTINE
=100	GEN AR*BR,AD/AND,SKP AD0	;M'IER NEG, CHECK M'CAND & PROD TOO
=110
MUL1:	SC_#,#/35.,EXIT			;STORE DOUBLE RESULT
	SET AROV,J/MUL1			;MUST HAVE SQUARED 400000,,0
=

.TOC	"MULTIPLY SUBROUTINE"
; ENTER WITH MULTIPLIER IN MQ,
; MULTIPLICAND IN AR!ARX, MINUS STEP COUNT IN FE
; RETURNS PRODUCT IN AR!ARX!MQ.
; RETURN 4, 6 TELLS SIGN OF MULTIPLIER
; 4 AND 6 ARE USED SO CALLER CAN IGNORE
; DIFFERENCE BY ALIGNMENT OF CALL LOC'N
;[TIME=4+2(-FE)+(# OF ARITH STEPS)] ... IF FE=-18, 40-58.
;
;Recall:
; MUL		"FE_FE+1,DISP/MUL,MQ/MQ*.25"
;

MULSUB:	BR_AR LONG,AR_0S,ARX_0S,	;M'CAND TO BR LONG, CLEAR PROD
		MUL,J/MULP		;START THE MULTIPLICATION
=000					;GRAB AN 8-WORD BLOCK
MULP:
.IF/MODEL.B
	(AR+ARX+MQ)*2,FE_SC,RETURN6	;XADDR MACHINE HAS
	(AR+ARX+MQ)*2,FE_SC,RETURN6	; NO "CRA MUL DONE"
	(AR+ARX+MQ)*2,FE_SC,RETURN6
.ENDIF/MODEL.B
=011	(AR+ARX+MQ)*2,FE_SC,RETURN6	;DISCARD REDUNDANT SIGN BIT

=100	AR_AR*.25 LONG,MUL,J/MULP	;M'IER BITS 00 AFTER POS STEP
	AR_(AR+BR)*.25,ARX/ADX*.25,	;01 AFTER +
		MUL,J/MULP
	AR_(AR-2BR)*.25,ARX/ADX*.25,	;10 AFTER +
		MUL,J/MULM
	AR_(AR-BR)*.25,ARX/ADX*.25,
		MUL,J/MULM		;11 AFTER +

=000					;ANOTHER 8-WORD BLOCK FOR
MULM:					; AFTER SUBTRACTION STEPS
.IF/MODEL.B
	(AR+ARX+MQ)*2,FE_SC,RETURN4
	(AR+ARX+MQ)*2,FE_SC,RETURN4
	(AR+ARX+MQ)*2,FE_SC,RETURN4
.ENDIF/MODEL.B
=011	(AR+ARX+MQ)*2,FE_SC,RETURN4	;M'IER WAS NEGATIVE

=100	AR_(AR+BR)*.25,ARX/ADX*.25,	;M'IER BITS 00 AFTER NEG STEP
		MUL,J/MULP
	AR_(AR+2BR)*.25,ARX/ADX*.25,	;01 AFTER -
		MUL,J/MULP
	AR_(AR-BR)*.25,ARX/ADX*.25,	;10 AFTER -
		MUL,J/MULM
	AR_AR*.25 LONG,MUL,J/MULM	;11 AFTER -

;HERE TO CONTINUE A LONG MULTIPLICATION
; WITH PARTIAL PRODUCT IN AR LONG

MULREE:	AD/0S,MUL,J/MULP		;DIVE IN WITHOUT CLOBBERING AR

.TOC	"DIV, IDIV"

	.DCODE
230:	R,	DBL AC,	J/IDIV
	I,	DBL AC,	J/IDIV
	RW,	M,	J/IDIV
	RW,	DBL B,	J/IDIV

234:	R,	DBL AC,	J/DIV
	I,	DBL AC,	J/DIV
	RW,	M,	J/DIV
	RW,	DBL B,	J/DIV
	.UCODE

=0****00*000
DIV:	BR/AR,ARX+MQ_0.M,		;DIVISOR TO BR
		AR_AC1*2,ARL/AD*2,	;LOW DIVIDEND TO AR
		CALL.M,J/DIV1		;GET HIGH DIVIDEND
.IF/MODEL.B
IDIV:	BR/AR, AR_1, J/IDIV2		;[236]
IDIV1:	BR/AR,ARX+MQ_0.M,SC_1,		;DIVISOR TO BR
		AR_AC0,ARL/AD,CALL.M,	;DIVIDEND TO AR
		SKP AR0,J/DIV2		;TEST DIVISOR SIGN
.IFNOT/MODEL.B
=10
IDIV:	BR/AR,ARX+MQ_0.M,SC_1,		;DIVISOR TO BR
		AR_AC0,ARL/AD,CALL.M,	;DIVIDEND TO AR
		SKP AR0,J/DIV2		;TEST DIVISOR SIGN
.ENDIF/MODEL.B
=011
NODIVD:	SET NO DIVIDE,J/NOP		;HERE IF DIVIDE IMPOSSIBLE

=110	ARX_AR,AR_-BRX,			;REMAIN TO ARX, GET CORRECT QUOTIENT
		SC_#,#/36.,EXIT
	ARX_AR,AR_BRX,			;HERE FOR POS QUOTIENT
		SC_#,#/36.,EXIT
=
.IF/MODEL.B
IDIV2:	GEN AR-BR, SKP AD NE		;[236] IS DIVISOR = 1?
=0	AR_AC0, CLR ARX, SC_#, #/36.,	;[236] YES, ANSWER IS AC0.
		EXIT			;[236]
	AR_BR, J/IDIV1			;
.ENDIF/MODEL.B
;HERE ON DIVIDE TO SET UP DIVIDEND

DIV1:	BRX/ARX,ARX_AR,AR_AC0,		;CLR BRX, DIVIDEND IN AR LONG
		FE_#,#/33.,TIME/3T,	;SETUP ITERATION COUNT
		SIGNS DISP,J/DIVS1	;ENTER SUBR

;HERE ON IDIV TO SET UP DIVIDEND.  SKIP IF DIVISOR NEG
; ALSO CALLED BY ADJBP
=0
DIV2:	BRX/ARX,ARX_SHIFT,AR_SIGN,	;CLR BRX, DIVIDEND TO AR LONG
		FE_#,#/33.,		;SETUP LOOP COUNT
		SKP AR0,J/DIVS1		;ENTER SUBR ACCORDING TO SIGNS
	BRX/ARX,ARX_SHIFT,AR_SIGN,	;CLR BRX, DIVIDEND TO AR LONG
		FE_#,#/33.,		;SETUP LOOP COUNT
		SKP AR0,J/DIVS2		;ENTER SUBR ACCORDING TO SIGNS

.TOC	"INTEGER DIVIDE SUBROUTINE"
; ENTER WITH SIGNS DISPATCH OF DIVISOR AND DIVIDEND,
; DIVISOR IN BR, BRX CLR; DIVIDEND IN AR!ARX
; STEP COUNT IN FE (# OF QUOTIENT BITS -2)
; IF NO DIVIDE, RETURN 3 WITH IFETCH STARTED
; OTHERWISE, RETURN WITH SIGNED REMAINDER IN AR,
; POSITIVE QUOTIENT IN BRX AND MQ.
; RETURN 6 IF QUOTIENT SHOULD BE NEGATIVE,
; RETURN 7 IF QUOTIENT SHOULD BE POSITIVE.
;[TIME=14+3(FE)+3(D'END NEG)+3(RESTORE REQ'D)+1(REMAINDER NEG)]
; ... IF FE=33, 113-120
;
;Recall:
; DIVIDE	"FE_FE-1,DISP/DIV,MQ/MQ*2"
;
=1100
DIVS1:	DIVIDE,AR_2(AR-BR),
		ARX/ADX*2,J/DIVS3	;BOTH D'END AND D'SOR POS
	AR_-AR LONG,J/DIVS1		;MAKE POS DIVIDEND, THEN CHK
DIVS2:	DIVIDE,AR_2(AR+BR),
		ARX/ADX*2,J/DIVS4	;D'END POS, D'SOR NEG
	AR_-AR LONG,J/DIVS2

=010
DIVS3:	DIVIDE,AR_2(AR+BR),ARX/ADX*2,
		ARL/AD*2,CALL.M,J/DIVLP	;START DIVIDING
	I FETCH,RETURN3			;RETURN TO CALLER WITH NO DIVIDE

	AR_-BR,BRX/ARX,RETURN6		;D'END NEG, SO NEGATE QUO & REM
	BRX/ARX,RETURN7			;EVERYTHING POSITIVE


=010
DIVS4:	DIVIDE,AR_2(AR-BR),ARX/ADX*2,
		ARL/AD*2,CALL.M,J/DIVLP	;BEGIN DIVISION FOR REAL BITS
	I FETCH,RETURN3			;ABORT FOR IMPOSSIBLE DIVISION

	BRX/ARX,RETURN6			;NEGATE QUO
	AR_-BR,BRX/ARX,RETURN7		;NEGATE REM

.TOC	"BASIC DIVIDE LOOP"
; THE LOOP ITSELF IS AN INNER SUBROUTINE, TO MAKE IT SUITABLE
; FOR USE IN DOUBLE-LENGTH DIVISION.
; THE DOUBLE LENGTH REMAINDER IS RETURNED IN BR!BRX (RESTORED)
; THE SINGLE LENGTH QUOTIENT (LOW PART IF DBL-LEN DIVISION) IN ARX
; RETURN 6 IF QUOTIENT (REALLY AC0.XOR.BR) NEGATIVE, OR 7 IF POSITIVE
;[TIME=12+3(FE)+3(RESTORE REQ'D)] ... IF FE=33, 111-114.

=000
DIVLP:	DIVIDE,AR_2(AR+BR),ARX/ADX*2,J/DIVLP
	DIVIDE,AR_2(AR-BR),ARX/ADX*2,J/DIVLP
DIV-:	DIVIDE,AR_2(AR-BR),ARX/ADX*2,J/DIVLP
DIV+:	DIVIDE,AR_2(AR+BR),ARX/ADX*2,J/DIVLP
	DIVIDE,AR_AR+BR,ARX/ADX,J/DIVX
	DIVIDE,AR_AR-BR,ARX/ADX,J/DIVX
	DIVIDE,AR_AR-BR,ARX/ADX,J/DIVX		;NO SHIFT ON FINAL STEP
	DIVIDE,AR_AR+BR,ARX/ADX,J/DIVX

;HERE AFTER FINAL DIVIDE STEP
; MQ HAS POSITIVE FORM QUOTIENT
; AR!ARX HAS REMAINDER, EXCEPT THAT IT MUST BE RESTORED IF IT IS
; NEGATIVE (IT'S NEGATIVE IF THERE WAS NO CARRY ON FINAL STEP)
; THE ORIGINAL DIVIDEND IS STILL IN AC0, SO WE CHECK ITS SIGN
; TO DETERMINE WHETHER TO NEGATE THE (RESTORED) REMAINDER.

=100
DIVX:	AR_AR+BR LONG			;RESTORE REMAIN WITH POS D'SOR
	BR_AR LONG,ARX/MQ,FE_SC,	;LONG REMAIN TO BR, QUO TO ARX
		SKP AC0+,RETURN6	;RETURN TESTING D'END SIGN
	AR_AR-BR LONG			;RESTORE REMAIN WITH NEG D'SOR
	BR_AR LONG,ARX/MQ,FE_SC,
		SKP AC0-,RETURN6


;SUBROUTINE FOR FIRST PART OF LONG DIVISIONS
; ENTER AT DDVSUB WITH SKP BR0
; RETURN3 IF SHOULD RESUME WITH ADD STEP
; RETURN5 IF SHOULD RESUME WITH SUBTRACT

=000
DDVLP:	AR_2(AR+BR),ARX/ADX*2,DIVIDE,J/DDVLP
	AR_2(AR-BR),ARX/ADX*2,DIVIDE,J/DDVLP
DDVSUB:	AR_2(AR-BR),ARX/ADX*2,DIVIDE,J/DDVLP
	AR_2(AR+BR),ARX/ADX*2,DIVIDE,J/DDVLP
	AR_MQ,MQ_AR,FE_#,#/32.,RETURN3
	AR_MQ,MQ_AR,FE_#,#/32.,RETURN5
	AR_MQ,MQ_AR,FE_#,#/32.,RETURN5
	AR_MQ,MQ_AR,FE_#,#/32.,RETURN3

.TOC	"DOUBLE INTEGER ARITHMETIC -- DADD, DSUB, DMUL, DDIV"

	.DCODE
.IFNOT/DBL.INT
114:	EA,	J/UUO
	EA,	J/UUO
	EA,	J/UUO
	EA,	J/UUO
.IF/DBL.INT
114:	R,	B/0,	J/DASMD		;DADD
	R,	B/2,	J/DASMD		;DSUB
	R,	B/4,	J/DASMD		;DMUL
	R,		J/DDIV
	.UCODE

;HERE FOR DOUBLE WORD ADD, SUBTRACT, MULTIPLY, OR DIVIDE
;ENTER WITH (E) IN AR, E IN VMA

=0****00**00
DDIV:	ARX_AC3,CLR MQ,J/DDIV0		;GET LOWEST PART OF D'END

DASMD:	BR/AR,AR_AC1*2,ARL/AD*2,	;HIGH MEM WORD TO BR
		VMA_VMA+1,LOAD ARX,	;ASK FOR LOW WORD
		MQ_0.S,CALL.S,J/XFERW	;AND WAIT FOR IT
=11	ARX_ARX*2			;SHIFT LOW MEM WORD LEFT
=	BRX/ARX,ARX_AR,AR_AC0,		;ALL DATA IN PLACE
		SC_#,#/35.,B DISP	;DO THE OPERATION

;HERE WITH (E) IN BR, (E+1)*2 IN BRX
; (AC) IN AR, (AC+1)*2 IN ARX

=00*	AR_AR+BR LONG,AD FLAGS,EXIT DBL	;DADD

	AR_AR-BR LONG,AD FLAGS,EXIT DBL	;DSUB

	MQ_SHIFT,AR_0S,ARX_0S,		;DMUL, USE AC1 AS INITIAL M'IER
		FE_#,#/-18.,J/DMULT	;SETUP STEP COUNT
=

;HERE FOR DOUBLE WORD MULTIPLY

=00*
DMULT:	AD/0S,MUL,CALL.M,J/MULP		;BEGIN MULTIPLY
=10*	AR_AR+BR LONG			;CANCEL EFFECTS OF LOW BIT 0
	MQ_AR,AR_MQ			;EXCH HI AND LOW PRODUCT WORDS

;HERE AFTER 1ST CALL ON MPY SUBR.  SAVE LOW WORD OF PROD, GET HIGH M'IER

	AC3_AR				;LOW WORD OF PRODUCT
	AR_AC0				;GET HIGH M'IER WORD
=000	MQ_AR,AR_MQ,CALL,		;DIVE IN AGAIN
		FE_#,#/-18.,J/MULREE	;CONTINUE THE MULTIPLY
=100	GEN AR*BR,AD/AND,SKP AD0	;SKP IF M'IER, M'CAND, & PROD NEG
=110
DMUL1:	AC0_AR,AR_SIGN,
		SC_#,#/35.,J/DMUL2	;STORE HIGH WORD OF PRODUCT
	SET AROV,J/DMUL1

;MULTIPLY NOW COMPLETE, STORE RESULTS WITH PROPER SIGN IN BIT 0

DMUL2:	BR/AR,AR_SHIFT			;GET 2ND WITH SIGN, SAVE SIGN
	AC1_AR,AR_ARX,ARX/MQ		;READY TO BUILD 3RD WORD
	ARX_SHIFT,AR_BR,MQ_MQ*2		;SIGNIFICANT BITS TO ARX, SIGN TO AR
	AR_SHIFT,ARX_AC3,		;3RD WORD IN AR, GET LOW
		MQ_MQ*.25		;EXTRA PROD BIT TO MQ 35
	AC2_AR,AR_MQ			;,I FETCH WHEN TIMING FIXED
=0*	ARX_SHIFT,AR_BR,I FETCH,	;LOW WORD AND SIGN READY
		CALL,J/SHIFT		; GET LOW WORD TO AR
STRAC3:	AC3_AR,FINISH			;GANZ GETAN

;HERE FOR DOUBLE INTEGER DIVISION
;AR HAS (E), ARX HAS (AC3), AND MQ IS CLEAR

DDIV0:	T0_AR,AR_ARX,ARX_ARX*8,SC_1	;SAVE (E) IN T0
	BRX/ARX,ARX_SHIFT,		;AC3 3-35 TO BRX, 1-2 TO ARX
		AR_AC2,SC_#,#/2		;GET AC2 READY
	AR_SHIFT,BR/AR,			;AC2 BITS 2-35 WITH AC3 1-2
		ARX_AC1,VMA_VMA+1	;READY TO GET (E+1)
	BR/AR,AR_ARX,ARX_BR*2,		;LOW DOUBLE WORD NOW IN BR LONG
		SC_1,FE_1
	ARX_SHIFT,AR_AC0,SKP AD0	;HIGH DOUBLEWORD IN AR LONG
=0
DDIV1:	BR_AR LONG,AR_BRX,ARX_BR,	;HI POS D'END TO BR
		LOAD AR,J/DDIV2		;GET LOW D'SOR READY
	BR_AR LONG,AR_-BR LONG,		;NEGATE LOW D'END
		FE_-1,SKP CRY0		;TEST FOR CARRY PROPAGATION
=0	BR_AR LONG,AR_BR COMP LONG,J/DDIV1
	BR_AR LONG,AR_-BR LONG,J/DDIV1	;FINISH NEGATION OF D'END
=0*
DDIV2:	T1_AR,MQ_ARX,ARX_0S,		;LOWEST D'END TO T1, NEXT TO MQ
		CALL,J/XFERW		; WAIT FOR (E+1)
	ARX_SHIFT,AR_T0,SKP FE0		;DIVISOR NOW IN AR LONG
=0	AR_BR LONG,BR_AR LONG,		;PUT OPERANDS IN PLACE FOR DIV
		SIGNS DISP,J/DDIV3	;TEST D'SOR SIGN
	AR_BR LONG,BR_AR LONG,SET SR2,	;NOTE D'END NEGATIVE
		SIGNS DISP,J/DDIV3

;HERE WITH THE DIVISOR IN BR LONG,
; THE HIGH PART OF THE MAGNITUDE OF THE DIVIDEND IN AR LONG,
; AND THE LOW PART OF THE MAGNITUDE OF THE DIVIDEND IN MQ AND T1
; SKIP IF DIVISOR NEGATIVE, & CHECK FOR NO-DIVIDE.
=1011
DDIV3:	AR_2(AR-BR),ARX/ADX*2,MQ_MQ*2,	;SEE IF FIRST DIVIDE STEP
		SKP CRY0,J/DDIV4	; GENERATES A 1
	AR_2(AR+BR),ARX/ADX*2,MQ_MQ*2,SKP CRY0
=000
DDIV4:	FE_#,#/33.,SKP BR0,CALL,J/DDVLP	;GO DO FIRST HALF OF DIVIDE
	I FETCH,J/NODIVD		;TOO MANY QUOTIENT BITS
=011	AC1_AR,CLR SC,J/DDIV6		;SAVE HI QUOTIENT IN AC1
=101	AC1_AR,SC_1S			;SET FLAG FOR RESUMPTION
=
DDIV6:	AR_T1				;GET LOWEST DIVIDEND BITS
=100	MQ_AR,AR_MQ,CALL,		;FINISH DIVISION, GENERATING
		SKP SC0,J/DIVLP		; 35 MORE QUOTIENT BITS
=110	AR_AC1,SR DISP,SET SR3,J/DDVX1	;QUOTIENT NEGATIVE.  NOTE
	AR_AC1,SR DISP			;HERE'S HIGH PART OF QUOTIENT
=1101
DDVX1:	BR_AR LONG,AR_BR LONG,J/DDVX2	;POS REMAINDER.  GO STORE
	BR_AR LONG,AR_-BR LONG,J/DDVX2	;NEGATE REMAINDER
DDVX2:	AC2_AR,AR_SIGN,SC_#,#/35.
	AR_SHIFT,SR DISP		;GET LOW WORD OF REM.  TEST QUO SIGN
=1110	AC3_AR,AR_BR,ARX/ADX*2,EXIT DBL	;GET QUOTIENT, SQUEEZE OUT HOLE
	AC3_AR,AR_-BR,ARX/ADX*2,AD LONG,;GET NEGATIVE QUOTIENT
		EXIT DBL
.ENDIF/DBL.INT