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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
# 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
# ieemapd (mapin, mapout) # enable NaN mapping
# ieestatd (nin, nout) # get num NaN values mapped
# ieezstatd () # zero NaN counters
#
# 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.
.data
vaxnan: .quad 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 _ieepad_
.globl _ieevpd_
.globl _ieeupd_
.globl _ieevud_
.globl _ieesnd_
.globl _ieegnd_
.globl _ieemad_
.globl _ieestd_
.globl _ieezsd_
_ieepad_: # IEEPAKD (X)
.word 0x3c
movl 4(ap), r4 # data addr -> r4
movl r4, r5 # output clobbers input
jsb cvt_vax_ieee # convert value
ret
_ieevpd_: # IEEVPAKD (VAX, IEEE, NELEM)
.word 0x7c
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
_ieeupd_: # IEEUPKD (X)
.word 0x3c
movl 4(ap), r4 # data addr -> r4
movl r4, r5 # output clobbers input
jsb cvt_ieee_vax # convert value
ret
_ieevud_: # IEEVUPKD (IEEE, VAX, NELEM)
.word 0x7c
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
_ieesnd_: # IEESNAND (VAXNAN)
.word 0x0
movq *4(ap), vaxnan
clrl nanin
clrl nanout
ret
_ieegnd_: # IEEGNAND (VAXNAN)
.word 0x0
movq vaxnan, *4(ap)
ret
_ieemad_: # IEEMAPD (MAPIN, MAPOUT)
.word 0x0
movl *4(ap), mapin
movl *8(ap), mapout
ret
_ieestd_: # IEESTATD (NIN, NOUT)
.word 0x0
movl nanin, *4(ap)
movl nanout, *8(ap)
ret
_ieezsd_: # IEEZSTATD ()
.word 0x0
clrl nanin
clrl nanout
ret
cvt_vax_ieee: # R4=in, R5=out
movl (r4)+, r1 # get vax double
movl (r4)+, r0 # get vax double
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
cmpl r1, vaxnan+4 # yes, check if reserved value
bneq L4 # no, just output value
clrl r0 # generate IEEE NaN value
clrl r1 # generate IEEE NaN value
insv $2047, $20, $11, r1 # insert NaN exponent (2047)
incl nanout # increment counter
jbr L5
L4:
rotl $16, r0, r0 # swap words -> r0
rotl $16, r1, r1 # swap words -> r1
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
jbr 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
tstl mapin # map NaNs on input?
beql L9 # no, don't check value
cmpl r2, $2047 # NaN double has exponent 2047
beql L11 # yes, output vaxnan
L9:
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:
moval vaxnan, r3 # return VAX equiv. of NaN
movl (r3)+, (r5)+
movl (r3)+, (r5)+
incl nanin
rsb
|
