aboutsummaryrefslogtreecommitdiff
path: root/vendor/cfitsio/vmsieeer.mar
blob: f3105880118bfb42fa4189bb1a1360b5dba5bf28 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
.TITLE	ieeer - ieee real to vax floating conversions
	.ident	/v1.0/

;# 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
;#
;# 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.

; See IEEED for details about NaNs.

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

	.ENTRY	IEEPAR ^M<R2,R3>
;_ieepar_:	;# IEEPAKR (X)
	movl	4(ap), r2			;# data addr -> r2
	movl	r2, r3				;# output clobbers input
	jsb	cvt_vax_ieee			;# convert value
	ret
	.ENTRY	IEEVPR ^M<R2,R3,R4>
;_ieevpr_:	;# IEEVPAKR (VAX, IEEE, NELEM)
	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
	.ENTRY	IEEUPR ^M<R2,R3>
;_ieeupr_:	;# IEEUPKR (X)
	movl	4(ap), r2			;# data addr -> r2
	movl	r2, r3				;# output clobbers input
	jsb	cvt_ieee_vax			;# convert value
	ret
	.ENTRY	IEEVUR ^M<R2,R3,R4>
;_ieevur_:	;# IEEVUPKR (IEEE, VAX, NELEM)
	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
	.ENTRY	IEESNR ^M<>
;_ieesnr_:	;# IEESNANR (VAXNAN)
buger::	nop				; plug bpt here for crap catching.
;	movl	@4(ap), vaxnan
	ret
	.ENTRY	IEEGNR ^M<>
;_ieegnr_:	;# IEEGNANR (VAXNAN)
	movl	#-1, @4(ap)
	ret

cvt_vax_ieee:					;# R2=in, R3=out
	rotl	#16, (r2)+, 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
	brb	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
	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:
	movl	#-1, (r3)+			; return fixed NaN value...
	rsb

	.END