Repatch (from linux) of OSX IRAF

1 files changed, 153 insertions, 0 deletions

diff --git a/unix/as.vax/ieeer.s b/unix/as.vax/ieeer.s
new file mode 100644
index 00000000..789712aa
--- /dev/null
+++ b/unix/as.vax/ieeer.s
@@ -0,0 +1,153 @@
+# Copyright(c) 1986 Association of Universities for Research in Astronomy Inc.
+#
+# IEEER.S -- IEEE real to VAX single precision floating conversions.
+#
+#	 ieepakr (x)				# scalar, vax->ieee
+#	 ieeupkr (x)				# scalar, ieee->vax
+#	ieevpakr (native, ieee, nelem)		# vector, vax->ieee
+#	ieevupkr (ieee, native, nelem)		# vector, ieee->vax
+#	ieesnanr (NaN)				# set VAX NaN value
+#	ieegnanr (NaN)				# get VAX NaN value
+#	 ieemapr (mapin, mapout)		# enable NaN mapping
+#	ieestatr (nin, nout)			# get num NaN values mapped
+#      ieezstatr ()				# zero NaN counters
+#
+# These routines convert between the VAX and IEEE real 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 IEESNANR (default 0).
+# These routines are functionally equivalent to the semi-portable versions of
+# the IRAF ieee/native floating conversion routines in osb$ieeer.x.
+# TODO - Add a function callback option for processing NaN values.
+
+	.data
+vaxnan:	.long	0
+nanin:	.long	0
+nanout:	.long	0
+mapin:	.long	1	# enable input NaN mapping by default for VAX
+mapout:	.long	0
+
+	.text
+	.align	1
+	.globl	_ieepar_
+	.globl	_ieevpr_
+	.globl	_ieeupr_
+	.globl	_ieevur_
+	.globl	_ieesnr_
+	.globl	_ieegnr_
+	.globl	_ieemar_
+	.globl	_ieestr_
+	.globl	_ieezsr_
+
+_ieepar_:	# IEEPAKR (X)
+	.word	0x0c
+	movl	4(ap), r2			# data addr -> r2
+	movl	r2, r3				# output clobbers input
+	jsb	cvt_vax_ieee			# convert value
+	ret
+_ieevpr_:	# IEEVPAKR (VAX, IEEE, NELEM)
+	.word	0x1c
+	movl	4(ap), r2			# input vector -> r2
+	movl	8(ap), r3			# output vector -> r3
+	movl	*12(ap), r4			# loop counter
+L1:	jsb	cvt_vax_ieee			# convert one value
+	sobgtr	r4, L1				# loop
+	ret
+_ieeupr_:	# IEEUPKR (X)
+	.word	0x0c
+	movl	4(ap), r2			# data addr -> r2
+	movl	r2, r3				# output clobbers input
+	jsb	cvt_ieee_vax			# convert value
+	ret
+_ieevur_:	# IEEVUPKR (IEEE, VAX, NELEM)
+	.word	0x1c
+	movl	4(ap), r2			# input vector -> r2
+	movl	8(ap), r3			# output vector -> r3
+	movl	*12(ap), r4			# loop counter
+L2:	jsb	cvt_ieee_vax			# convert one value
+	sobgtr	r4, L2				# loop
+	ret
+_ieesnr_:	# IEESNANR (VAXNAN)
+	.word	0x0
+	movl	*4(ap), vaxnan
+	clrl	nanin
+	clrl	nanout
+	ret
+_ieegnr_:	# IEEGNANR (VAXNAN)
+	.word	0x0
+	movl	vaxnan, *4(ap)
+	ret
+_ieemar_:	# IEEMAPR (MAPIN, MAPOUT)
+	.word	0x0
+	movl	*4(ap), mapin
+	movl	*8(ap), mapout
+	ret
+_ieestr_:	# IEESTATR (NIN, NOUT)
+	.word	0x0
+	movl	nanin, *4(ap)
+	movl	nanout, *8(ap)
+	ret
+_ieezsr_:	# IEEZSTATR ()
+	.word	0x0
+	clrl	nanin
+	clrl	nanout
+	ret
+
+cvt_vax_ieee:					# R2=in, R3=out
+	movl	(r2)+, r0			# vax value -> r0
+
+	tstl	mapout				# map NaNs on output?
+	beql	L4				# no, just output value
+	cmpl	r0, vaxnan			# yes, check if reserved value
+	bneq	L4				# no, just output value
+	clrl	r0				# generate IEEE NaN value
+	insv	$255, $23, $8, r0		# insert NaN exponent (255)
+	incl	nanout				# increment counter
+	jbr	L5
+L4:
+	rotl	$16, r0, r0			# swap words -> r0
+	extzv	$23, $8, r0, r1			# 8 bit exponent -> r1
+	beql	L6				# branch if zero exponent 
+	subw2	$2, r1				# adjust exponent bias
+	bleq	L6				# return zero if underflow
+	insv	r1, $23, $8, r0			# insert new exponent
+L5:
+	movl	sp, r1				# r3 points to input byte
+	pushl	r0				# push r0 on stack
+	movb	-(r1), (r3)+			# output longword, swapped
+	movb	-(r1), (r3)+
+	movb	-(r1), (r3)+
+	movb	-(r1), (r3)+
+	tstl	(sp)+				# pop stack
+	rsb					# all done
+L6:
+	clrl	r0				# return all 32 bits zero
+	jbr	L5
+
+cvt_ieee_vax:					# R2=in, R3=out
+	movb	(r2)+, -(sp)			# byte swap longword onto stack
+	movb	(r2)+, -(sp)
+	movb	(r2)+, -(sp)
+	movb	(r2)+, -(sp)
+	movl	(sp)+, r0			# pop swapped value -> r0
+	extzv	$23, $8, r0, r1			# exponent -> r1
+	beql	L10				# zero exponent
+	tstl	mapin				# map NaNs on input?
+	beql	L9				# no, don't check value
+	cmpl	r1, $255			# NaN has exponent 255
+	beql	L11				# yes, output vaxnan
+L9:
+	addw2	$2, r1				# adjust exponent bias
+	cmpw	r1, $256			# compare with max VAX exponent
+	bgeq	L11				# return VAX-NaN if overflow
+	insv	r1, $23, $8, r0			# insert VAX-D exponent
+	rotl	$16, r0, (r3)+			# output VAX value
+	rsb
+L10:
+	clrl	(r3)+				# return all 32 bits zero
+	rsb
+L11:
+	moval	vaxnan, r1			# return VAX equiv. of NaN
+	movl	(r1)+, (r3)+
+	incl	nanin
+	rsb