.TITLE	ieeed - ieee double to vax floating conversions
	.ident	/v1.0/

;# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
;#
;# IEEED.S -- IEEE double to VAX double floating conversions.
;#
;#	ieepakd (x)				# scalar, vax->ieee
;#	ieeupkd (x)				# scalar, ieee->vax
;#	ieevpakd (native, ieee, nelem)		# vector, vax->ieee
;#	ieevupkd (ieee, native, nelem)		# vector, ieee->vax
;#	ieesnand (NaN)				# set VAX NaN value
;#	ieegnand (NaN)				# get VAX NaN value
;#
;# These routines convert between the VAX and IEEE double floating formats,
;# operating upon a single value or an array of values.  +/- zero is converted
;# to zero.  When converting IEEE to VAX, underflow maps to zero, and exponent
;# overflow and NaN input values map to the value set by IEESNAND (default 0).
;# These routines are functionally equivalent to the semi-portable versions of
;# the IRAF ieee/native floating conversion routines in osb$ieeed.x.
;# TODO - Add a function callback option for processing NaN values.

; Vax NaN *MUST* be 11111... or the fitsio code will break horribly.
; It is explicitly tested for in a couple of places, so be warned.

	.PSECT	IEEED$CODE, PIC,USR,CON,REL,LCL,SHR,EXE,RD,NOWRT,NOVEC

	.ENTRY	IEEPAD ^M<R2,R3,R4,R5>
;_ieepad_:	;# IEEPAKD (X)
	movl	4(ap), r4			;# data addr -> r4
	movl	r4, r5				;# output clobbers input
	jsb	cvt_vax_ieee			;# convert value
	ret
	.ENTRY	IEEVPD ^M<R2,R3,R4,R5,R6>
;_ieevpd_:	;# IEEVPAKD (VAX, IEEE, NELEM)
	movl	4(ap), r4			;# input vector -> r4
	movl	8(ap), r5			;# output vector -> r5
	movl	@12(ap), r6			;# loop counter
L1:	jsb	cvt_vax_ieee			;# convert one value
	sobgtr	r6, L1				;# loop
	ret
	.ENTRY	IEEUPD ^M<R2,R3,R4,R5>
;_ieeupd_:	;# IEEUPKD (X)
	movl	4(ap), r4			;# data addr -> r4
	movl	r4, r5				;# output clobbers input
	jsb	cvt_ieee_vax			;# convert value
	ret
	.ENTRY	IEEVUD ^M<R2,R3,R4,R5,R6>
;_ieevud_:	;# IEEVUPKD (IEEE, VAX, NELEM)
	movl	4(ap), r4			;# input vector -> r4
	movl	8(ap), r5			;# output vector -> r5
	movl	@12(ap), r6			;# loop counter
L2:	jsb	cvt_ieee_vax			;# convert one value
	sobgtr	r6, L2				;# loop
	ret
	.ENTRY	IEESND ^M<>
;_ieesnd_:	;# IEESNAND (VAXNAN)
bugger::nop					; real no-op added to enable
						; enbuging.	
;	movq	@4(ap), vaxnan			; no-oped. See above.
	ret					; This could be no-oped in
						; the vector, but isn't.
	.ENTRY	IEEGND ^M<>
;_ieegnd_:	;# IEEGNAND (VAXNAN)
	movq	#-1, @4(ap)			; See above
	ret

cvt_vax_ieee:					;# R4=in, R5=out
	rotl	#16, (r4)+, r1			;# swap words -> r1
	rotl	#16, (r4)+, r0			;# swap words -> r0

	extzv	#23, #8, r1, r2			;# 8 bit exponent -> r2
	beql	L6				;# branch if zero exponent 
	extzv	#2, #1, r0, r3			;# get round bit -> r3
	ashq	#-3, r0, r0			;# shift 64 data bits by 3
	addw2	#<1024-130>, r2			;# adjust exponent bias
	insv	r2, #20, #11, r1		;# insert new exponent
	blbc	r3, L5				;# branch if round bit clear
	incl	r0				;# round low longword
	adwc	#0, r1				;# carry to high longword
L5:
	movl	sp, r3				;# r3 points to input byte
	pushl	r1				;# push r1 on stack
	pushl	r0				;# push r0 on stack
	movb	-(r3), (r5)+			;# output quadword, swapped
	movb	-(r3), (r5)+
	movb	-(r3), (r5)+
	movb	-(r3), (r5)+
	movb	-(r3), (r5)+
	movb	-(r3), (r5)+
	movb	-(r3), (r5)+
	movb	-(r3), (r5)+
	addl2	#8, sp				;# pop stack
	rsb					;# all done
L6:
	clrl	r0				;# return all 64 bits zero
	clrl	r1
	brb	L5

cvt_ieee_vax:					;# R4=in, R5=out
	movb	(r4)+, -(sp)			;# byte swap quadword onto stack
	movb	(r4)+, -(sp)
	movb	(r4)+, -(sp)
	movb	(r4)+, -(sp)
	movb	(r4)+, -(sp)
	movb	(r4)+, -(sp)
	movb	(r4)+, -(sp)
	movb	(r4)+, -(sp)

	movl	(sp)+, r0			;# pop low bits
	movl	(sp)+, r1			;# pop high bits
	extzv	#20, #11, r1, r2		;# exponent -> r2
	beql	L10				;# zero exponent
	extzv	#31, #1, r1, r3			;# save sign bit
	ashq	#3, r0, r0			;# shift 64 bits left 3 bits
	subw2	#<1024-130>, r2			;# adjust exponent bias
	bleq	L10				;# return zero if underflow
	cmpw	r2, #256			;# compare with max VAX exponent
	bgeq	L11				;# return VAX-NaN if overflow
	insv	r2, #23, #8, r1			;# insert VAX-D exponent
	insv	r3, #31, #1, r1			;# restore sign bit

	rotl	#16, r1, (r5)+			;# output VAX double
	rotl	#16, r0, (r5)+			;# output VAX double
	rsb
L10:
	clrl	(r5)+				;# return all 64 bits zero
	clrl	(r5)+
	rsb
L11:
	movl	#-1, r3			;# return VAX equiv. of NaN
	movl	r3, (r5)+
	movl	r3, (r5)+		; changed to only return -1
	rsb

	.END