mirror of
https://bitbucket.org/cosmicvoids/vide_public.git
synced 2025-07-04 15:21:11 +00:00
137 lines
4.3 KiB
Text
137 lines
4.3 KiB
Text
.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
|
|
|