TITLE	DPDIV FOR RPGLIB %1
SUBTTL	DOUBLE PRECISION DIVIDES		AL BLACKINGTON/CAM/RBC

;USED TO BE
;COPYRIGHT 1974, DIGITAL EQUIPMENT CORP., MAYNARD, MA.
;BUT CONVERTED TO RPGII VERSION, 24-NOV-75, BOB CURRIER

	HISEG

ENTRY DIV.12	;DIVIDE ONE WORD BY TWO WORDS
ENTRY DIV.21	;DIVIDE TWO WORDS BY ONE WORD
ENTRY DIV.22	;DIVIDE TWO WORDS BY TWO WORDS

EXTERNAL MAG.,NEG.

;CALLING SEQUENCE:
;	MOVE	16,[Z AC,OPERAND]
;	PUSHJ	17,DIV.12/DIV/21/DIV.22

;ENTER WITH DIVIDEND IN ACCUMULATORS AC&AC+1 FOR DIV.21&DIV.22,
;	AND ACCUMULATOR AC FOR DIV.12.
;EXIT WITH QUOTIENT IN AC'S AC&AC+1,
; REMAINDER IN AC+2&AC+3 FOR DIV.12, DIV.22,  REMAINDER IN AC+2 FOR DIV.21

DIV.21:	SKIPN	TD,0(PA)	;IS DIVISIOR ZERO?
	JRST	OVRFLO		;YES--SIZE ERROR

	LDB	RS,[POINT 4,PA,12]; GET OPERAND AC
	MOVE	TA,0(RS)	;GET HIGH OPERAND
	MOVE	TB,1(RS)	;GET LOW OPERAND

	PUSHJ	PP,DIV21X	;DO THE DIVISION

	MOVEM	TA,0(RS)	;STASH HIGH PART
	MOVEM	TB,1(RS)	;STASH LOW PART
	MOVEM	TC,2(RS)	;STASH REMAINDER
	POPJ	PP,
DIV.12:	LDB	RS,[POINT 4,PA,12]; GET OPERAND AC
	MOVE	TA,0(RS)	;GET OPERAND
	MULI	TA,1		;CONVERT TO DOUBLE PRECISION
	JRST	DIV220

DIV.22:	LDB	RS,[POINT 4,PA,12]; GET OPERAND AC
	MOVE	TA,0(RS)	;GET
	MOVE	TB,1(RS)	;  OPERAND

DIV220:	SKIPGE	TD,0(PA)	;IS DIVISOR NEGATIVE?
	JRST	DIV22B		;YES

	MOVE	TE,1(PA)	;NO--GET LOW-ORDER PART OF DIVISOR

DIV22A:	TLZ	TE,1B18		;INSURE LOW-ORDER PART OF DIVISOR IS POSITIVE

	JUMPN	TD,DIV22C	;IS HI-ORDER PART OF DIVISOR ZERO?
	JUMPE	TE,OVRFLO	;YES--IS LOW-ORDER PART ZERO ALSO?

	TLNN	RS,FSIGN	;POSITIVE SIGN?
	SKIPA	TD,TE		;YES
	MOVN	TD,TE		;NO

	PUSHJ	PP,DIV21X	;DO THE DIVIDE

	MULI	TC,1		;CONVERT REMAINDER TO 2-WORDS
	MOVEM	TA,0(RS)	;STASH
	MOVE	TA,RS		; [143] get pointer into safe AC
	MOVEM	TB,1(TA)	; [143]  QUOTIENT
	MOVEM	TC,2(TA)	; [143] STASH
	MOVEM	TD,3(TA)	; [143]  REMAINDER
	POPJ	PP,

DIV22B:	SETCA	TD,		;DIVISOR IS NEGATIVE--GET MAGNITUDE
	TLO	RS,FSIGN	;SET SIGN TO NEGATIVE
	MOVE	TE,1(PA)	;GET LOW-ORDER PART OF DIVISOR
	TLO	TE,1B18		;BE SURE IT'S ALSO NEGATIVE
	MOVMS	TE		;GET IT'S MAGNITUDE
	JUMPG	TE,DIV22A	;IF POSITIVE NOW--OK

	ADDI	TD,1		;MUST HAVE BEEN ZERO
	JUMPGE	TD,DIV22A	;IF HI-ORDER NOW POSITIVE--OK

	JRST	OVRFLO		;IT WASN'T--TROUBLE
;DIVIDEND IS NOW UNSIGNED IN TA&TB, DIVISOR UNSIGNED IN TD&TE

DIV22C:	JUMPGE	TA,DIV22E	;IS DIVIDEND POSITIVE?
	TLC	RS,FSIGN	;NO--COMPLEMENT SIGN OF RESULT
	SETCA	TA,		;COMPLEMENT HI-ORDER PART OF DIVIDEND
	TLO	TB,1B18		;BE SURE LOW-PART AGREES IN SIGN
	MOVMS	TB		;NOW GET IT'S MAGNITUDE

	JUMPG	TB,DIV22F	;WAS LOW-ORDER PART ZERO?
	ADDI	TA,1		;YES--BUMP HI-ORDER PART
	JUMPL	TA,OVRFLO	;TOO BIG?
DIV22E:	TLZ	TB,1B18		;BE SURE LOW-ORDER PART IS POSITIVE

DIV22F:	MOVE	H1,TA		;SAVE DIVIDEND
	MOVE	H2,TB

	IDIV	TA,TD		;DIVIDE HIGH-ORDER PARTS
	MOVE	Q,TA		;SAVE QUOTIENT
	SKIPA	QI,Q		;CREATE FIRST INCREMENT

DIV22G:	MOVE	TA,Q
	LSH	QI,-1		;DIVIDE INCREMENT BY 2
	SKIPN	QI		;SAFETY
	MOVEI	QI,1		;	VALVE

	MOVE	TB,TA		;COMPUTE
	IMUL	TA,TD		; Q
	MUL	TB,TE		; TIMES
	ADD	TA,TB		; DIVISOR

	SUBM	H1,TA		;COMPUTE
	SUBM	H2,TC		; REMAINDER
	SKIPGE	TC
	SUBI	TA,1
	TLZ	TC,1B18

	JUMPL	TA,DIV22I	;IS REMAINDER NEGATIVE?
	CAMG	TA,TD		;NO--IS IT > DIVISOR?
	JRST	DIV22J		;MAYBE

DIV22H:	ADD	Q,QI		;REMAINDER > DIVISOR, TRIAL QUOTIENT TOO SMALL
	JRST	DIV22G

DIV22I:	SUB	Q,QI		;REMAINDER NEGATIVE, TRIAL QUOTIENT TOO BIG
	JRST	DIV22G

DIV22J:	CAME	TA,TD
	JRST	DIV22K
	CAML	TC,TE
	JRST	DIV22H
;ANSWER TO DIV.22 HAS BEEN FOUND


DIV22K:	SKIPL	0(RS)		;IS DIVIDEND NEGATIVE?
	JRST	DIV22N		;NO
	SETCA	TA,		;YES--NEGATE REMAINDER
	MOVNS	TC
	TLZ	TC,1B18
	SKIPN	TC
	ADDI	TA,1

DIV22N:	MOVE	TD,Q		;GET QUOTIENT
	TLNE	RS,FSIGN	;NO--IS SIGN TO BE NEGATIVE?
	MOVNS	TD
	MULI	TD,1

DIV22L:	SKIPL	TA		;IS REMAINDER NEGATIVE?
	TLZA	TC,1B18		;NO--FORCE LOW-PART TO BE POSITIVE
	TLO	TC,1B18		;YES--FORCE LOW-PART TO BE NEGATIVE

DIV22P:	SKIPL	TD
	TLZA	TE,1B18
	TLO	TE,1B18

	MOVEM	TD,0(RS)	;STASH
	MOVE	TD,RS		; [143] get RS pointer into a safe AC
	MOVEM	TE,1(TD)	; [143]  QUOTIENT
	MOVEM	TC,3(TD)	; [143] STASH
	MOVEM	TA,2(TD)	; [143]  REMAINDER

	POPJ	PP,


;DO DIVIDE OF 2-WORD BY 1-WORD. DIVIDEND IN TA&TB, DIVISIOR IN TD.
;RETURN WITH QUOTIENT IN TA&TB, REMAINDER IN TC.

DIV21X:	JUMPGE	TA,DIV21Y	;POSITIVE DIVIDEND?
	SETCA	TA,		;NO--
	MOVMS	TB		;  GET
	TLZ	TB,1B18		;  MAGNITUDE
	SKIPN	TB		;  OF
	ADDI	TA,1		;  DIVIDEND

	PUSHJ	PP,DIV21Y	;DO DIVISION

	MOVNS	TC		;NEGATE REMAINDER
	SETCA	TA,		;NEGATE
	MOVNS	TB
	TLZ	TB,1B18		;  THE
	SKIPN	TB		;  DOUBLE
	ADDI	TA,1		;  PRECISION
	TLNE	TA,1B18
	TLO	TB,1B18		;  QUOTIENT

	POPJ	PP,

DIV21Y:	TLZ	TB,1B18		;BE SURE LOW-SIGN AGREES
	MOVE	TC,TB		;SAVE LOW-PART
	IDIV	TA,TD		;GET HIGH-PART OF QUOTIENT
	DIV	TB,TD		;GET LOW-PART OF QUOTIENT
	SKIPGE	TB
	SUBI	TA,1

	POPJ	PP,
;DIVISION OVERFLOW -- SET INDICATOR

OVRFLO:	OUTSTR	[ASCIZ /Arithmetic overflow during DIVide
/]
	POPJ	PP,

FSIGN==1B18	;SIGN FLAG JAMMED INTO PA


H1=13
H2=14
Q=15
QI=16
PA=16
PP=17

RS=5
TA=6
TB=TA+1
TC=TB+1
TD=TC+1
TE=TD+1

END