1000 ! CVREAL - Convert HP260 format BCD values
1010 ! Revision: 97-11-03, mike@msede.com
1020 !           97-11-12, mike@msede.com, added SHORT conversion
1030 ! 
1040 ! The HP260 uses a different format to encode REAL and SHORT variables.
1050 ! The conversion is handled mostly automatically by HP Eloquence
1060 ! *unless* you stored PACKED strings in a DATA file or a data set.
1070 ! The Function FNCv_real() can be used to unpack a REAL value
1080 ! 
1090 ! from a string. The main program is just a test environment.
1100 ! 
1110 ! This program is provided unsupported and without any warranty in
1120 ! the hope it is helpful. Please send any bug reports (or
1130 ! enhancements :-) to mike@msede.com.
1140 ! 
1150     DISP "-- REAL --"
1160     FOR I=1 TO 4                ! No of test cases
1170        A$=""
1180        FOR J=1 TO 8             ! No of bytes / REAL
1190           READ N
1200           A$=A$&CHR$(N)
1210        NEXT J
1220        N=FNCv_real(A$)
1230        DISP N
1240     NEXT I
1250 ! 
1260     DISP "-- SHORT --"
1270     FOR I=1 TO 4                ! No of test cases
1280        A$=""
1290        FOR J=1 TO 4             ! No of bytes / SHORT
1300           READ N
1310           A$=A$&CHR$(N)
1320        NEXT J
1330        N=FNCv_short(A$)
1340        DISP N
1350     NEXT I
1360     STOP
1370 ! 
1380     DATA 0,192,18,52,0,0,0,0         ! 00c0 1234 0000 0000 = 1234
1390     DATA 2,192,18,52,86,120,144,18   ! 02c0 1234 5678 9012 = 123456789012
1400     DATA 0,64,18,52,80,0,0,0         ! 0040 1234 5000 0000 = 12.345
1410     DATA 253,0,16,0,0,0,0,0          ! fd00 1000 0000 0000 = 1E-12
1420 ! 
1430     DATA 6,18,52,0                   ! 0612 3400 = 1234
1440     DATA 22,18,52,87                 ! 1612 3457 = 123457000000
1450     DATA 2,18,52,80                  ! 0212 3450 = 12.345
1460     DATA 232,16,0,0                  ! e810 0000 = 1E-12
1470 ! 
1480 ! Convert HP260 packed REAL values
1490 ! 
1500     DEF FNCv_real(Hp260$)
1510        INTEGER Iv(1:4),Exp
1520        UNPACK USING Fiv;Hp260$
1530 Fiv:   PACKFMT Iv(*)
1540        Exp=BINAND(SHIFT(Iv(1),6),511)
1550        IF Iv(1)<0 THEN Exp=Exp-512
1560        IF BINAND(Iv(1),1) THEN T$="-"
1570        T$=T$&"0."&FNHex4$(Iv(2))&FNHex4$(Iv(3))&FNHex4$(Iv(4))&"E"&VAL$(Exp+1)
1580        RETURN VAL(T$)
1590     FNEND
1600 ! 
1610 ! Convert HP260 packed SHORT values
1620 ! 
1630     DEF FNCv_short(Hp260$)
1640        INTEGER Iv(1:4),Exp
1650        Iv(1)=NUM(Hp260$[1])
1660        Iv(2)=NUM(Hp260$[2])
1670        Iv(3)=NUM(Hp260$[3])
1680        Iv(4)=NUM(Hp260$[4])
1690 ! 
1700        Exp=SHIFT(Iv(1),1)
1710        IF BINAND(Iv(1),128) THEN Exp=Exp-128
1720        IF BINAND(Iv(1),1) THEN T$="-"
1730        T$=T$&"0."&FNHex2$(Iv(2))&FNHex2$(Iv(3))&FNHex2$(Iv(4))&"E"&VAL$(Exp+1)
1740        RETURN VAL(T$)
1750     FNEND
1760 ! 
1770 ! Convert argument to a 4 digit hex value
1780 ! 
1790     DEF FNHex4$(INTEGER I)
1800        H$=DTH$(BINAND(I,65535))
1810        RETURN RPT$("0",4-LEN(H$))&H$
1820     FNEND
1830 ! 
1840 ! Convert argument to a 2 digit hex value
1850 ! 
1860     DEF FNHex2$(INTEGER I)
1870        H$=DTH$(BINAND(I,255))
1880        RETURN RPT$("0",2-LEN(H$))&H$
1890     FNEND