pro CONV_UNIX_VAX, variable, SOURCE_ARCH=source ;+ ; NAME: ; CONV_UNIX_VAX ; PURPOSE: ; To convert Unix IDL data types to Vax IDL data types. ; EXPLANATION: ; CONV_UNIX_VAX assumes the Unix IDL data type is IEEE standard in either ; big-endian or little-endian format. ; ; CALLING SEQUENCE: ; CONV_UNIX_VAX, variable, [ SOURCE_ARCH = ] ; ; PARAMETERS: ; variable - The data variable to be converted. This may be a scalar ; or an array. Valid datatypes are integer, longword, ; floating point, and double precision. The result of the ; conversion is passed back in the original variable. ; OPTIONAL INPUT KEYWORD: ; SOURCE_ARCH = name (string) of source architecture ; if using this function on a VAX, otherwise ; !VERSION.ARCH is used to determine the conversion. ; **If run on a VAX, the default is to assume the source to be ; a little-endian machine with IEEE floating point ; (e.g. MIPSEL or Alpha***). ; RESTRICTIONS: ; Requires that data be from IEEE standard Unix machines ; (e.g. SUN, MIPSEL, or Alpha). ; EXAMPLE: ; Read a 100 by 100 matrix of floating point numbers from a data ; file created on a Sun. Then convert the matrix values into ; VAX format. ; ; IDL> openr,1,'vax_float.dat ; IDL> data = fltarr(100,100) ; IDL> forrd,1,data ; IDL> CONV_UNIX_VAX,data,SOURCE_ARCH='sparc' ; ; MODIFICATION HISTORY: ; Version 1 By John Hoegy 13-Jun-88 ; 04-May-90 - WTT: Created CONV_UNIX_VAX from VAX2SUN, ; reversing floating point procedure. ; Modified P. Keegstra September 1994 ; Implemented MIPSEL and ALPHA architecture, ; distinguishing VMS and OSF ; Modified P. Keegstra February 1995 ; Added 386 PC based architectures ; If since V5.1 then VMS is always little endian June 1998 ; Convert to IDL V5.0 W. Landsman June 1998 ;- ;**************************************************************************** ; ; Check to see if VARIABLE is defined. ; if N_params() LT 1 then begin print,'Syntax - CONV_UNIX_VAX, variable, [ SOURCE_ARCH = ] return endif if n_elements(variable) eq 0 then begin print,'*** VARIABLE not defined, routine CONV_UNIX_VAX.' retall endif if N_elements( source ) EQ 1 then arch = source else arch = !VERSION.ARCH little_endian = 0 CASE arch OF "sparc": ;Assume default big-endian ; Demo version of PV-WAVE for Linux reports itself as arch="i386". ; IDL for MS-WINDOWS reports itself as arch="3.1". 'i386': little_endian = 1 '3.1': little_endian = 1 'mipsel': little_endian = 1 '386': little_endian = 1 '386i': little_endian = 1 'x86': little_endian = 1 "vax": BEGIN message,"machine is VAX, " + $ "will assume source has little-endian " + $ "architecture and IEEE floating point",/CONTIN little_endian = 1 END "alpha": BEGIN IF !VERSION.OS EQ 'vms' THEN BEGIN if !VERSION.RELEASE LT '5.1' then $ message,"machine is alpha running VMS, " + $ "will assume source has little-endian " + $ "architecture and IEEE floating point",/CONTIN little_endian = 1 ENDIF ELSE little_endian = 1 END else: ;default is to assume big endian architecture ENDCASE ; if little_endian then begin swap_ints = 0 swap_float = 2 endif else begin swap_ints = 1 swap_float = 1 endelse var_chars = size(variable) var_type = var_chars[var_chars[0]+1] ; case var_type of 1: return ; byte 2: if (swap_ints GT 0) then byteorder,variable,/SSWAP ;integer 3: if (swap_ints GT 0) then byteorder,variable,/LSWAP ;longword 4: BEGIN ; floating point scalar = (var_chars[0] eq 0) var_elems = long(var_chars[var_chars[0]+2]) byte_elems = var_elems*4L byte_eq = byte(variable, 0, byte_elems) ; if (swap_float GT 1) then byteorder, byte_eq, /LSWAP ; i1 = lindgen(byte_elems/4L)*4L i2 = i1 + 1L biased = byte((byte_eq[i1] AND '7F'X) * 2) OR byte(byte_eq[i2]/128L) i = where(biased ne 0) if (i[0] ne -1) then biased[i] = byte(biased[i] + 2) byte_eq[i1] = byte(byte_eq[i1] AND '80'X) OR byte(biased/2) byte_eq[i2] = byte(byte_eq[i2] AND '7F'X) OR byte(biased*128) ; ; swap bytes ; byte_elems = byte_elems + 3L byteorder, byte_eq, /SSWAP ; if scalar then begin tmp = fltarr(1) tmp[0] = float(byte_eq, 0, var_elems) variable = tmp[0] endif else variable[0] = float(byte_eq, 0, var_elems) return END 5: BEGIN ; double precision var_elems = long(var_chars[var_chars[0]+2]) byte_elems = var_elems*8L scalar = (var_chars[0] eq 0) if scalar then begin tmp = dblarr(1) tmp[0] = variable byte_eq = byte(tmp, 0, byte_elems) endif else byte_eq = byte(variable, 0, byte_elems) ; ; Bring it up to at least a double-precision level. ; byte_elems = byte_elems + 7L i1 = lindgen(byte_elems/8L)*8L i2 = i1 + 1L i3 = i2 + 1L i4 = i3 + 1L i5 = i4 + 1L i6 = i5 + 1L i7 = i6 + 1L i8 = i7 + 1L ; if (swap_float GT 1) then begin byte_eq2 = bytarr(byte_elems) byte_eq2[i1] = byte_eq[i8] byte_eq2[i2] = byte_eq[i7] byte_eq2[i3] = byte_eq[i6] byte_eq2[i4] = byte_eq[i5] byte_eq2[i5] = byte_eq[i4] byte_eq2[i6] = byte_eq[i3] byte_eq2[i7] = byte_eq[i2] byte_eq2[i8] = byte_eq[i1] byte_eq = byte_eq2 endif ; ; Bring it up to at least a double-precision level. ; exponent = fix( ((byte_eq[i1] AND '7F'X)*16) OR $ ((byte_eq[i2] AND 'F0'X)/16) ) i = where(exponent ne 0) if (i[0] ne -1) then exponent[i] = exponent[i] + 128 - 1022 tmp1 = byte_eq[i8] byte_eq[i8] = ((byte_eq[i7] and '1f'x)*8) or ((tmp1 and 'e0'x)/32) tmp2 = byte_eq[i7] byte_eq[i7] = (tmp1 and '1f'x)*8 tmp3 = byte_eq[i6] byte_eq[i6] = ((byte_eq[i5] and '1f'x)*8) or ((tmp3 and 'e0'x)/32) tmp1 = byte_eq[i5] byte_eq[i5] = ((tmp3 and '1f'x)*8) or ((tmp2 and 'e0'x)/32) tmp2 = byte_eq[i4] byte_eq[i4] = ((byte_eq[i3] and '1f'x)*8) or ((tmp2 and 'e0'x)/32) tmp3 = byte_eq[i3] byte_eq[i3] = ((tmp2 and '1f'x)*8) or ((tmp1 and 'e0'x)/32) tmp1 = byte_eq[i2] byte_eq[i2] = (byte_eq[i1] and '80'x) or byte((exponent and 'fe'x)/2) byte_eq[i1] = byte((exponent and '1'x)*128) or ((tmp1 and 'f'x)*8) or $ ((tmp3 and 'e0'x)/32) ; if scalar then begin tmp = dblarr(1) tmp[0] = double(byte_eq, 0, var_elems) variable = tmp[0] endif else variable[0] = double(byte_eq, 0, var_elems) return END 6: begin ; complex rvalue = float(variable) ivalue = imaginary(variable) conv_unix_vax,rvalue, SOURCE_ARCH = source conv_unix_vax,ivalue, SOURCE_ARCH = source variable = complex(rvalue,ivalue) end 7: return ; string else: begin ; unknown print,'*** Data type ' + strtrim(var_type,2) + $ ' unknown, routine CONV_UNIX_VAX.' retall end endcase return end