.TITLE NUMCON .sbttl ibm/vax internal date type conversions .PSECT NUMCON ;this set of routines converts data from the IBM internal format ;to that of the VAX. ;Each routine is FORTRAN callable as a subroutine and will convert ;consecutive cells as determined from the call list. If the number ;of conversions is omitted the call defaults to one. ;format CALL RTN(BUFFER,N) ;where: ; RTN is the conversion type ; ; IBM to VAX conversions ; ; I2V integer*2 ; I4V integer*4 ; R4V real*4 ; R8V real*8 ; L1V logical*1 ; L2V logical*2 ; L4V logical*4 ; chi character ; ; VAX to IBM conversions ; ; i2i integer*2 ; i4i integer*4 ; r4i real*4 ; r8i real*8 ; l1i logical*1 ; l2i logical*2 ; l4i logical*4 ; chi character ; BUFFER is the address of the first cell to convert ; N is the number of conversions to perform .sbttl I2V integer*2 conversion i2i:: .entry i2v,^m bsbb get_parms ;get the input parameters 10$: movb (r4)+,-(sp) ;build VAX integer movb (r4)+,-(sp) movw (sp)+,-2(r4) ;and return it sobgtr r3,10$ ;gtr..keep going ret .sbttl I4V integer*4 i4i:: .entry I4V,^M bsbb get_parms ;get the input parameters 10$: .REPT 4 ;BUILD THE INTEGER*4 MOVB (R4)+,-(SP) .ENDR MOVL (SP)+,-4(R4) ;AND RETURN IT SOBGTR R3,10$ ;GTR..MORE TO CONVERT ret .sbttl get_parms loads registers with call parameters get_parms: movl #1,r3 ;assume one cell conversion movl 4(ap),r4 ;get the cell address cmpl (ap),#2 ;N default to 1? bLSS 20$ ;LSSl..default movl @8(ap),r3 ;get number of conversions N bgtr 20$ ;gtr..all is ok 10$: tstl (sp)+ ;drop return address ret ;and exit to original caller 20$: rsb ;finish the conversion .sbttl R4V real*4 conversion .entrY r4v,^m bsbb get_parms movl #3,r2 ;load loop counter brb vaxreal .sbttl R8V real*8 convsersion .ENTRY R8V,^M bsbb get_parms ;get the input parameters movl #7,r2 ;load loop count for 64 bit number vaxreal: CLRQ -(SP) ;MAKE ROOM ON THE STACK SUBL3 R2,#7,R1 ;POSITION THE BYTES movl r2,r0 ;remember number of bytes 10$: movb (r4)[r0],(sp)[R1];get a byte INCL R1 ;POINT TO NEXT BYTE sobgtr r0,10$ ;gtr..more to get extzv #0,#7,(r4),r0 ;get hexadecimal exponent ashl #2,r0,R0 ;convert to binary subl #128,r0 ;and excess 128 20$: bbs #55,(sp),30$ ;bs..normalized for VAX ashq #1,(sp),(sp) ;shift to normalize SOBGTR R0,20$ ;GTR..KEEP GOING 30$: bgtr 40$ ;gtr..no underflow CLRL R0 ;ZERO THE EXPONENT clrq (sp) ;return true zero clrb (r4) ;zero the sign brb 60$ 40$: cmpl r0,#255 ;overflow? bleq 50$ ;leq..no movzbl #255,r0 ;set to maximum movq #^x00FFFFFFFFFFFFFF,(sp);floating number 50$: bbc #7,(r4),60$ ;bs..sign bit set => negative bisb #^x80,7(sp) ;so set it here 60$: insv r0,#55,#8,(sp) ;and insert the exponent movq (sp)+,r0 ;copy the number and clean stack rotl #16,r1,(r4)+ ;and return the number bbc #2,r2,70$ ;bc..single precision rotl #16,r0,(r4)+ 70$: sobgtr r3,vaxreal ;gtr..more to do ret .sbttl r4i real*4 conversion VAX to IBM .entry r4i,^m bsbw get_parms ;get input parameters movl #1,-(sp) ;set for single precision brb ibmreal .sbttl r8i real*8 conversion VAX to IBM .entry r8i,^m bsbw get_parms clrl -(sp) ;clear for double precision ibmreal: extzv #7,#8,(r4),r2 ;get the vax exponent insv #1,#7,#8,(r4) ;and insert the hidden bit rotl #16,(r4)+,r1 ;get bits 0-31 blbs (sp),10$ ;lbs..single precision rotl #16,(r4)+,r0 ;get bits 32-63 10$: extzv #0,#2,r2,-(sp) ;get fraction of 16 beql 20$ ;eql..exact addl #4,r2 ;adjust hex exponent subl #4,(sp) ;get shift count ashq (sp),r0,r0 ;position mantissa 20$: tstl (sp)+ ;drop shift count ashl #-2,r2,r2 ;position exponent addl #32,r2 ;make excess 64 insv r2,#24,#7,r1 ;insert into ibm format movl #8,r2 ;set loop count 60$: movb r0,-(sp) ;set up the bytes ashq #-8,r0,r0 sobgtr r2,60$ blbs 8(sp),70$ ;lbs..single precision movq (sp)+,-8(r4) ;return ibm value brb 80$ 70$: movl (sp)+,-4(r4) tstl (sp)+ 80$: sobgtr r3,ibmreal tstl (sp)+ ret .SBTTL CHARACTER CONVERSION .ENTRY CHV,^M pushab ascii ;use vax translation table brb characters .entry chi,^m pushab ebcdic ;use ibm translation table characters: movq 4(ap),r6 ;get arguments movtc (r7),(r6),#0,@(sp)+,(r7),(r6) ;convert the characters ret ascii: .ASCII / / .ASCII / / .ASCII / \.<(+|& !$*);^/ .ASCII \-/ |,%_>? `:#@'="\ .ASCII / abcdefghi jklmnopqr / .ASCII / ~stuvwxyz / .ASCII /{ABCDEFGHI }JKLMNOPQR / .ASCII /\ STUVWXYZ 0123456789| / ebcdic: .rept 4 .byte ^x40,^x40,^x40,^x40,^x40,^x40,^x40,^x40 .endr .byte ^x40,^x5a,^x7f,^x7b,^x5b,^x6c,^x50,^x7d .byte ^x4d,^x5d,^x5c,^x4e,^x6b,^x60,^x4b,^x61 .byte ^xf0,^xf1,^xf2,^xf3,^xf4,^xf5,^xf6,^xf7 .byte ^xf8,^xf9,^x7a,^x5e,^x4c,^x7e,^x6e,^x6f .byte ^x7c,^xc1,^xc2,^xc3,^xc4,^xc5,^xc6,^xc7 .byte ^xc8,^xc9,^xd1,^xd2,^xd3,^xd4,^xd5,^xd6 .byte ^xd7,^xd8,^xd9,^xe2,^xe3,^xe4,^xe5,^xe6 .byte ^xe7,^xe8,^xe9,^x4d,^xe0,^x5d,^x57,^x6d .byte ^x79,^x81,^x82,^x83,^x84,^x85,^x86,^x87 .byte ^x88,^x89,^x91,^x92,^x93,^x94,^x95,^x96 .byte ^x97,^x98,^x99,^xa2,^xa3,^xa4,^xa5,^xa6 .byte ^xa7,^xa8,^xa9,^xc0,^xfa,^xd0,^x20,^x20 .SBTTL LOGICAL CONVERSION l1i:: .ENTRY L1V,^M BSBW GET_PARMS 10$: CVTBL (R4),R0 ;GET THE LOGICAL VALUE BEQL 20$ ;EQL..FALSE LEAVE AS IS MNEGL #1,R0 ;MAKE IT TRUE FOR THE VAX 20$: MOVB R0,(R4)+ ;RETURN WITH THE CONVERTED NUMBER SOBGTR R3,10$ ;GTR..MORE TO DO RET l2i:: .entry l2v,^m bsbw get_parms 10$: movl (r4),r0 ;get the 370 logical value beql 20$ ;eql..false, leave as is mnegl #1,r0 ;make a true vax logical value 20$: movw r0,(r4) ;and return it sobgtr r3,10$ ;gtr..moe to do ret l4i:: .ENTRY L4V,^M BSBW GET_PARMS 10$: MOVL (R4),R0 ;GET THE 370 LOGICAL VALUE BEQL 20$ ;EQL..FALSE, LEAVE AS IS MNEGL #1,R0 ;MAKE A TRUE VAX LOGICAL VALUE 20$: MOVL R0,(R4)+ ;AND RETURN IT SOBGTR R3,10$ ;GTR..MORE TO DO RET .END