.TITLE	DIVIDE		
; JEFFREY KODOSKY	ARL	SEPT76
;
; SUBR
; ENTRY:	2 ARGS		<N1>;<N2>
; EXIT:		1 ARG		((QUOTIENT <N1><N2>)(REMAINDER <N1><N2>))
; ERRORS:	I4, UNDEFINED ARITHMETIC OPERATION
; CALLS:	(QUOTIENT)
;		(REMAINDER)
	.GLOBL	DIVIDE,ZDIVIDE,QUOTIENT,ZQUOTIENT,RECIP,ZRECIP
	.GLOBL	REMAINDER,ZREMAINDER,QDVI,QDVR,QRI,QIR
	.GLOBL	QMLR,QATM2N,QSBR,QGET,APVAL,QI4ERR,ZSW,QI2ATM
	.GLOBL	QR2ATM,QCONS
DIVIDE:	MOV	#1,DVFLAG
	BR	DIV02	;JOIN COMMON CODE
ZDIVIDE=.-DIVIDE
;
;
; SUBR:		RECIPROCAL
; ENTRY:	1 ARG		<N>
; EXIT:		1 ARG		(QUOTIENT 1 <N>)
; ERRORS:	I4, UNDEFINED ARITHMETIC OPERATION
; CALLS:	(QUOTIENT)
RECIP:	MOV	#1,-(SP);NUMERATOR IS INTEGER 1
	CLR	DVFLAG	;ACT LIKE CALL TO QUOTIENT
	BR	DIV03	;JOIN COMMON CODE
ZRECIP=.-RECIP
;
;
; SUBR:		QUOTIENT
; ENTRY:	2 ARGS		<N1>;<N2>
; EXIT:		1 ARG		<N1>/<N2>
; ERRORS:	I4, UNDEFINED ARITHMETIC OPERATION
; CALLS:	DVI
;		DVR
;		IR
;		ATM2N
;		GET
QUOTIENT:CLR	(PC)+
DVFLAG:	.WORD	0
DIV02:	QATM2N		;GET NUMERATOR <N1>
	BCS	DIV16	;JUMP IF ITS FLOATING POINT
DIV03:	QATM2N		;GET DENOMINATOR <N2>
	BCS	DIV10	;JUMP IF ITS FLOATING POINT
	MOV	2(SP),-(SP)	;COPY NUMERATOR
	BEQ	DIV07	;NUMERATOR = ZERO IS SPECIAL CASE
	MOV	2(SP),-(SP)	;COPY DENOMINATOR
	BEQ	DIV31	;DENOMINATOR = ZERO IS SPECIAL CASE
	QDVI		;TRY INTEGER DIVIDE FIRST
	BCC	1$
	JMP	DIV60	;JUMP IF Q=-NEGMAX,R=0
1$:	TST	R1	;IS REMAINDER = ZERO?
	BNE	2$
	JMP	DIV50	;IF SO THEN Q IS INTEGER
2$:	MOV	R1,@SP	;ELSE SAVE REMAINDER
	MOV	4(SP),-(SP)	;COPY N
	QIR		;MAKE IT REAL
	MOV	6(SP),-(SP)	;COPY D
	QIR		;MAKE IT REAL
	QDVR		;DO REAL DIVIDE
	MOV	(SP)+,4(SP)
	MOV	(SP)+,4(SP)
	JMP	DIV62
DIV07:	TST	2(SP)	;CHECK FOR 0/0
	BNE	DIV50
	QI4ERR		;WHICH IS ALWAYS AN ERROR
DIV10:	MOV	@SP,-(SP)	;MOVE D DOWN
	MOV	4(SP),2(SP)
	MOV	6(SP),-(SP)	;COPY N
	BEQ	DIV24	;N=0 IS SPECIAL CASE
	QIR		;CONVERT N TO REAL
	MOV	(SP)+,6(SP)
	MOV	(SP)+,6(SP)
	BR	DIV19
DIV16:	QATM2N		;GET DENOMINATOR
	BCS	.+4
	QIR		;AND MAKE IT REAL
	BIT	#77777,4(SP)
	BEQ	DIV22	;JUMP IF NUMERATOR IS 0 OR INF
DIV19:	BIT	#77777,@SP
	BEQ	DIV28	;JUMP IF DENOMINATOR IS 0 OR INF
	.REPT	4
	MOV	6(SP),-(SP)	;COPY N AND D
	.ENDR
	QDVR		;REAL DIVIDE
	BCC	DIV40
	MOV	(SP)+,6(SP)	;Q IS INF, MOVE IT DOWN
	MOV	(SP)+,6(SP)
	BR	DIV37
DIV22:	TST	6(SP)
	BEQ	DIV25	;JUMP IF N=0
	BIT	#77777,@SP	;N=INF, CHECK D
	BNE	DIV33	;JUMP IF D NOT 0 OR INF
	TST	2(SP)
	BEQ	DIV36	;N=INF & D=0--->Q=INF,R=0
	QI4ERR		;INF/INF IS ALWAYS AN ERROR
DIV24:	TST	(SP)+
DIV25:	TST	(SP)+	;N=0 CHECK D
	BNE	DIV54	;JUMP IF D NON-ZERO
	TST	@SP
	BNE	DIV54
	QI4ERR		;ELSE ERROR: 0/0
DIV28:	TST	2(SP)	;N NOT 0 OR INF, D=0 OR INF
	BNE	DIV72	;D=INF--->Q=0,R=N
	BR	DIV35	;ELSE D=0--->Q=INF,R=0
DIV31:	ROL	6(SP)	;TRANSFER SIGN OF N TO Q=INF
	ROR	4(SP)
	BR	DIV36
DIV33:	ROL	@SP	;SIGN OF Q=INF =SIGN N + SIGN D
	BCC	DIV36
	COM	4(SP)
DIV35:	BIC	#77777,4(SP)
DIV36:	MOV	#-1,6(SP)	;MAKE CLEAN INF; R=0
DIV37:	ROOM	3	;CHECK IF INF IS ALLOWED
	MOV	APVAL,-(R5)
	MOV	ZSW,-(R5)
	QGET
	TST	(R5)+
	BNE	DIV68	;ERROR IF NOT
	QI4ERR
ZQUOTIENT=.-QUOTIENT
;
;
; SUBR:		REMAINDER
; ENTRY:	2 ARGS		<N1>;<N2>
; EXIT:		1 ARG		(DIFFERENCE <N1> (TIMES (FIX
;				(QUOTIENT <N1><N2>)) <N2>))
; ERRORS:	I4, UNDEFINED ARITHMETIC OPERATION
; CALLS:	(QUOTIENT)
;		MLR
;		RI
;		IR
;		SBR
;		I2ATM
;		R2ATM
;		CONS
REMAINDER:MOV	#-1,DVFLAG
	BR	DIV02	;JOIN COMMON QUOTIENT CODE
DIV40:	TST	DVFLAG	;IS R TO BE CALCULATED?
	BNE	DIV43	;JUMP IF SO
	MOV	(SP)+,6(SP)	;ELSE MOVE UP QUOTIENT
	MOV	(SP)+,6(SP)
	BR	DIV75		;AND RETURN IT
DIV43:	MOV	@SP,(PC)+	;SAVE Q
QHI:	.WORD	0
	MOV	2(SP),(PC)+
QLO:	.WORD	0
	QRI		;FIX Q
	QIR		;INT(Q)
	QMLR
	QSBR		;N - INT[Q]*D
	MOV	2(SP),-(SP)
	MOV	2(SP),-(SP)
	MOV	QHI,4(SP)
	MOV	QLO,6(SP)
	TST	DVFLAG
	BPL	DIV83	;JUMP IF DIVIDE CALL
	QR2ATM		;ELSE JUST RETURN REMAINDER
	BR	DIV53
DIV50:	TST	DVFLAG
	BGT	DIV55	;JUMP IF DIVIDE CALL
	BEQ	DIV52	;JUMP IF RETURNING ONLY QUOTIENT
	CLR	@SP	;ELSE RETURN ZERO REMAINDER ONLY
DIV52:	QI2ATM
DIV53:	CMP	(SP)+,(SP)+
	JMP	@-(R4)
DIV54:	CLR	@SP
DIV55:	MOV	(SP)+,2(SP)	;Q=INTEGER, R=0
	CLR	@SP
	CLR	-(R5)
	QI2ATM
	BR	DIV90
DIV60:	CLR	4(SP)
	MOV	#^F32768.,2(SP)
	CLR	@SP
DIV62:	TST	DVFLAG
	BGT	DIV80	;JUMP IF DIVIDE CALL
	BMI	DIV52	;JUMP IF RETURNING REMAINDER ONLY
DIV64:	TST	(SP)+	;ELSE RETURN QUOTIENT ONLY
	BR	DIV76
DIV68:	TST	DVFLAG
	BEQ	DIV75	;JUMP IF RETURNING JUST QUOTIENT
	MOV	(SP)+,@SP	;CHECK R FOR DIVIDE/REMAINDER CALL
	BEQ	DIV62
	QI4ERR		;REMAINDER UNDEFINED FOR INF/D AND D NOT 0
DIV72:	TST	DVFLAG
	BMI	DIV75	;JUMP IF R CALL
	BGT	DIV88	;JUMP IF D CALL
	ADD	#6,SP	;ELSE RETURN ZERO Q
	CLR	@SP
	QI2ATM
	.WORD	0
DIV75:	CMP	(SP)+,(SP)+
DIV76:	QR2ATM
	.WORD	0
DIV80:	CLR	-(R5)
	QI2ATM
	BR	DIV84
DIV83:	CLR	-(R5)
	QR2ATM
DIV84:	QCONS
	QR2ATM
	BR	DIV92
DIV88:	CMP	(SP)+,(SP)+
	CLR	-(R5)
	QR2ATM
	CLR	-(SP)
DIV90:	QCONS
	QI2ATM
DIV92:	QCONS
	.WORD	0
ZREMAINDER=.-REMAINDER
	.END