vide_public/external/cfitsio/vmsieeer.mar

106 lines
3.3 KiB
Text

.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