	.TITLE	BUTMUL
	.GLOBL	BUT0,BUT225,BUT270,BUT315,BUTT,BUTTOV
;
; REGISTER DEFINITIONS
;
	.IRPC	X,012345
	R'X=%'X
	.ENDM
	SP=%6
	PC=%7
	.PAGE
	.SBTTL	BUT0
;
; COSINE = 1
;
BUT0:
	MOV	(R5)+,R1	;SET UP 'I' POINTER
	MOV	(R5)+,R2	;SET UP 'IP' POINTER
	MOV	(R1),R3		;GET THE IM(I)
	MOV	-(R1),R4	;GET RE(I)
	ADD	(R2),R3		;R3 = IM(I)+IM(IP)
	ADD	-(R2),R4	;R4 = RE(I)+RE(IP)
	ASR	R3		;DIVIDE BY 2 TO GET IM(I) & RE(I)
	ASR	R4
	MOV	R4,(R1)+	;RE(I) = (RE(I)+RE(IP))/2
	MOV	R3,(R1)		;IM(I) = (IM(I)+IM(IP))/2
	SUB	(R2),R4		;R4 = (RE(I)-RE(IP))/2
	MOV	R4,(R2)+	;RE(IP) = (RE(I)-RE(IP))/2
	SUB	(R2),R3		;R3 = (IM(I)-IM(IP))/2
	MOV	R3,(R2)		;IM(IP) = (IM(I)-IM(IP))/2
	JMP	@(R5)+		;ON TO NEXT SUBROUTINE
	.PAGE
	.SBTTL	BUT270
;
; COSINE = 0
;
BUT270:
	MOV	(R5)+,R1	;SET UP 'I' POINTER
	MOV	(R5)+,R2	;SET UP 'IP'POINTER
	MOV	(R1),R3		;GET IM(I)
	MOV	-(R1),R4	;GET RE(I)
	ADD	(R2),R4		;R4 = RE(I)+IM(IP)
	SUB	-(R2),R3	;R3 = IM(I)-RE(IP)
	ASR	R3		;DIVIDE BY 2 TO GET RE(I) & IM(I)
	ASR	R4
	MOV	R4,(R1)+	;RE(I) = (RE(I)+IM(IP))/2
	MOV	R3,(R1)		;IM(I) = (IM(I)-RE(IP))/2
	ADD	(R2)+,R3	;R3 = (IM(I)+RE(IP))/2
	MOV	(R2),-(R2)	;SAVE IM(IP)
	SUB	(R2),R4		;R4  = (RE(I)-IM(IP))/2
	MOV	R4,(R2)+	;RE(IP) = (RE(I)-IM(IP))/2
	MOV	R3,(R2)		;IM(IP) = (IM(I)+RE(IP))/2
	JMP	@(R5)+		;ON TO NEXT SUBROUTINE
	.PAGE
	.SBTTL	BUT315
;
; COSINE OF 315 DEGREES
;
	COS=55201
	SIN=122577
BUT315:
	MOV	(R5)+,R4	;SET UP 'IP' POINTER
	MOV	(R4),R0		;R0 = IM(IP)
	ADD	-(R4),R0	;R0 = RE(IP)+IM(IP)
	MUL	#COS,R0		;R0 = (RE(IP)+IM(IP))*COS
	MOV	(R4)+,R2	;R2 = RE(IP)
	SUB	(R4),R2		;R2 = (RE(IP)-IM(IP))
	MUL	#SIN,R2		;R2 = (RE(IP)-IM(IP))*SIN
	MOV	(R5)+,R1	;SET UP 'I' POINTER
	ASR	(R1)		;SCALE IM(I)
	MOV	(R1),(R4)	;IM(IP) = IM(I)-(R2)
	SUB	R2,(R4)
	ADD	R2,(R1)		;IM(I) = IM(I)+(R2)
	ASR	-(R1)		;SCALE RE(I)
	MOV	(R1),-(R4)	;RE(IP) = RE(I)-(R0)
	SUB	R0,(R4)
	ADD	R0,(R1)		;RE(I) = RE(I)+(R0)
	JMP	@(R5)+		;ON TO NEXT SUBROUTINE
	.PAGE
	.SBTTL	BUT225
;
; COSINE OF 225 DEGREES
;
	COS=122577		;-1/SQR(2)
	MCOS=-COS		;1/SQR(2)
BUT225:
	MOV	(R5)+,R4	;SET UP 'IP' POINTER
	MOV	(R4),R0		;R0 = IM(IP)
	SUB	-(R4),R0	;R0 = IM(IP)-RE(IP)
	MUL	#MCOS,R0	;R0 = (IM(IP)-RE(IP))*MCOS
	MOV	(R4)+,R2	;R2 = RE(IP)
	ADD	(R4),R2		;R2 = RE(IP)+IM(IP)
	MUL	#COS,R2		;R2 = (RE(IP)+IM(IP))*COS
	MOV	(R5)+,R1	;SET UP 'I' POINTER
	ASR	(R1)		;SCALE IM(I)
	MOV	(R1),(R4)	;IM(IP) = IM(I)-(R2)
	SUB	R2,(R4)
	ASR	-(R1)		;SCALE RE(I)
	MOV	(R1),-(R4)	;RE(IP) = RE(I)-(R0)
	SUB	R0,(R4)
	ADD	R0,(R1)+	;RE(I) = RE(I)+(R0)
	ADD	R2,(R1)		;IM(I) = IM(I)+(R2)
	JMP	@(R5)+		;ON TO NEXT SUBROUTINE
	.PAGE
	.SBTTL	BUTT
;
; COSINE OF AN ANGLE BETWEEN 270 AND 180 DEGREES OTHER THAN 270,225
;
BUTT:
	MOV	(R5)+,R2	;SET UP 'IP' POINTER
	MOV	(R5)+,R3	;SET UP 'COS' POINTER
	MOV	R5,-(SP)	;SAVE R5 ON STACK
	MOV	(R2),R4		
	MUL	(R3),R4		;R4=IM(IP)*COS/2
	MOV	-(R2),R0
	MUL	-(R3),R0	;R0 = RE(IP)*SIN/2
	MOV	R0,R1		;R1 = RE(IP)*SIN/2
	SUB	R4,R0		;R0 = RE(IP)*SIN/2-IM(IP)*COS/2
	ADD	R4,R1		;R1 = RE(IP)*SIN/2+IM(IP)*COS/2
	MOV	(R2)+,R4
	ADD	(R2),R4
	MUL	-(R3),R4	;R4 = (RE(IP)+IM(IP))*(COS-SIN)/2
	ADD	R4,R0		;R0 = RE(IP)*COS/2-IM(IP)*SIN/2
	MOV	(SP)+,R5	;RESTORE R5
	MOV	(R5)+,R3	;SET UP 'I' POINTER
	ASR	(R3)		;SCALE IM(I)
	MOV	(R3),(R2)
	ADD	R1,(R3)		;IM(I) = IM(I)+(R1)
	SUB	R1,(R2)		;IM(IP) = IM(I)-(R1)
	ASR	-(R3)		;SCALE RE(I)
	MOV	(R3),-(R2)
	ADD	R0,(R3)		;RE(I) = RE(I)+(R0)
	SUB	R0,(R2)		;RE(IP) = RE(I)-(R0)
	JMP	@(R5)+		;ON TO NEXT SUBROUTINE
	.PAGE
	.SBTTL	BUTTOV
;
; COSINE OF AN ANGLE BETWEEN 0 AND -90 OTHER THAN 0,315,270
;
BUTTOV:
	MOV	(R5)+,R2	;SET UP 'IP' POINTER
	MOV	(R5)+,R3	;SET UP 'COS' POINTER
	MOV	R5,-(SP)	;SAVE R5 FOR LATER
	MOV	(R2),R4	
	MUL	(R3),R4		;R4=IM(IP)*COS/2
	MOV	-(R2),R0
	MUL	-(R3),R0	;R0 = RE(IP)*SIN/2
	MOV	R0,R1		;R1 = RE(IP)*SIN/2
	SUB	R4,R0		;R0 = RE(IP)*SIN/2-IM(IP)*COS/2
	ADD	R4,R1		;R1 = RE(IP)*SIN/2+IM(IP)*COS/2
	MOV	(R2)+,R4
	ADD	(R2),R4		;R4 = RE(IP)+IM(IP)
	MUL	-(R3),R4	;R4 = (RE(IP)+IM(IP))*(COS-SIN)/4
	ASL	R5
	ROL	R4		;SCALE UP RESULT-R4,R5=R4,R5*2
	ADD	R4,R0		;R0 = RE(IP)*COS/2-IM(IP)*SIN/2
	MOV	(SP)+,R5	;RESTORE R5
	MOV	(R5)+,R3	;SET UP 'I' POINTER
	ASR	(R3)		;SCALE IM(I)
	MOV	(R3),(R2)
	ADD	R1,(R3)		;IM(I) = IM(I)+(R1)
	SUB	R1,(R2)		;IM(IP) = IM(I)-(R1)
	ASR	-(R3)		;SCALE RE(I)
	MOV	(R3),-(R2)
	ADD	R0,(R3)		;RE(I) = RE(I)+(R0)
	SUB	R0,(R2)		;RE(IP) = RE(I)-(R0)
	JMP	@(R5)+		;ON TO NEXT SUBROUTINE
	.END
                                                                                                                                                                        