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