Task: Decimal floating point number to binary







Python: hex2bin = dict('{:x} {:04b}'.format(x,x).split() for x in range(16))
bin2hex = dict('{:b} {:x}'.format(x,x).split() for x in range(16))

def float_dec2bin(d):
    neg = False
    if d < 0:
        d = -d
        neg = True
    hx = float(d).hex()
    p = hx.index('p')
    bn = ''.join(hex2bin.get(char, char) for char in hx[2:p])
    return (('-' if neg else '') + bn.strip('0') + hx[p:p+2]
            + bin(int(hx[p+2:]))[2:])

def float_bin2dec(bn):
    neg = False
    if bn[0] == '-':
        bn = bn[1:]
        neg = True
    dp = bn.index('.')
    extra0 = '0' * (4 - (dp % 4))
    bn2 = extra0 + bn
    dp = bn2.index('.')
    p = bn2.index('p')
    hx = ''.join(bin2hex.get(bn2[i:min(i+4, p)].lstrip('0'), bn2[i])
                 for i in range(0, dp+1, 4))
    bn3 = bn2[dp+1:p]
    extra0 = '0' * (4 - (len(bn3) % 4))
    bn4 = bn3 + extra0
    hx += ''.join(bin2hex.get(bn4[i:i+4].lstrip('0'))
                  for i in range(0, len(bn4), 4))
    hx = (('-' if neg else '') + '0x' + hx + bn2[p:p+2]
          + str(int('0b' + bn2[p+2:], 2)))
    return float.fromhex(hx)




Fortran:       MODULE REBASE	
       CHARACTER*36 DIGIT	
       PARAMETER (DIGIT = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ")	
       CONTAINS		
        LOGICAL FUNCTION EATNUM(ACARD,BASE,V)	
Chews into the likes of 666, -666.666, .666 with their variations.
Completes with the value in V, success as the result.
Could check that no digit exceeds the specified BASE usage, but that would mean an error message...
Concocted by R.N.McLean (whom God preserve) May XXMM.
Clunky usage of ICHAR encourages the compaq compiler to employ single-character-at-a-time usage.
         CHARACTER*(*) ACARD	
         INTEGER BASE		
         DOUBLE PRECISION V	
         DOUBLE PRECISION X	
         INTEGER D,DD		
         INTEGER L2,LC		
         INTEGER*1 C		
         LOGICAL ADIGIT,XNEG	
          ADIGIT = .FALSE.	
          XNEG = .FALSE.	
          DD = 0		
          X = 0			
          L2 = 1		
          LC = LEN(ACARD)	
          IF (L2.GT.LC) GO TO 20	
Chew into the number. Admit a possible leading sign, then digits.
          C = ICHAR(ACARD(L2:L2))	
          IF (C.EQ.ICHAR("+")) GO TO 1	
          IF (C.NE.ICHAR("-")) GO TO 2	
          XNEG = .TRUE.		
    1     L2 = L2 + 1		
          IF (L2.GT.LC) GO TO 20	
    2     D = INDEX(DIGIT,ACARD(L2:L2)) - 1	
          IF (D .LT. 0) GO TO 10	
          X = D				
          ADIGIT = .TRUE.		
    3     L2 = L2 + 1			
          IF (L2.GT.LC) GO TO 20	
          D = ICHAR(ACARD(L2:L2)) - ICHAR("0")	
          IF (D .LT. 0) GO TO 10	
          X = X*BASE + D		
          GO TO 3			
Consider any decimal digits, introduced by a decimal point.
   10     IF (ICHAR(ACARD(L2:L2)).EQ.ICHAR(".")) GO TO 11	
          IF (ICHAR(ACARD(L2:L2)).NE.ICHAR("·")) GO TO 20	
   11     L2 = L2 + 1			
          IF (L2.GT.LC) GO TO 20	
          D = INDEX(DIGIT,ACARD(L2:L2)) - 1	
          IF (D .LT. 0) GO TO 20	
          X = X*BASE + D		
          DD = 1			
          ADIGIT = .TRUE.		
   12     L2 = L2 + 1			
          IF (L2.GT.LC) GO TO 20	
          D = ICHAR(ACARD(L2:L2)) - ICHAR("0")	
          IF (D < 0 .OR. 9 < D) GO TO 20	
          X = X*BASE + D			
          DD = DD + 1			
          GO TO 12			
Can't consider any exponent part, started by an "E" or "D", as these may be possible digit symbols.
   20     IF (DD .GT. 0) X = X/BASE**DD	
          IF (XNEG) X = -X		
          V = X				
          EATNUM = ADIGIT		
        END FUNCTION EATNUM	

        SUBROUTINE FP8DIGITS(X,BASE,TEXT,L)	
Converts a number X to a specified BASE. For integers, successive division by BASE, for fractions, successive multiplication.
         REAL*8 X,T		
         INTEGER BASE		
         CHARACTER*(*) TEXT	
         INTEGER L		
         INTEGER N,ND		
         INTEGER D		
         LOGICAL NEG		
          IF (BASE.LE.1 .OR. BASE.GT.LEN(DIGIT)) BASE = 10	
          WRITE (TEXT,1) BASE	
    1     FORMAT ("Base",I3)	
          T = X			
          N = T			
          T = ABS(T - N)	
          NEG = N .LT. 0	
          IF (NEG) N = -N	
          L = LEN(TEXT)		
          ND = 0		
Crunch the integer part. Use the tail end of TEXT as a scratchpad, as the size of N is unassessed.
   10     D = MOD(N,BASE)		
          TEXT(L:L) = DIGIT(D+1:D+1)	
          ND = ND + 1			
          N = N/BASE			
          L = L - 1			
          IF (L.LE.0) THEN		
            TEXT = "Overflow
            L = MIN(9,LEN(TEXT))	
           RETURN			
          END IF			
          IF (N.GT.0) GO TO 10		
          IF (NEG) THEN			
            TEXT(L:L) = "-"		
            L = L - 1			
          END IF			
          N = LEN(TEXT) - L		
          TEXT(9:9 + N - 1) = TEXT(L + 1:)	
          L = 9 + N			
          TEXT(L:L) = "."		
Crunch through the fractional part until nothing remains.
          DO WHILE(T.GT.0)	
            IF (L.GE.LEN(TEXT)) THEN	
              L = LEN(TEXT)		
              TEXT(L:L) = "~"		
             RETURN		
            END IF		
            T = T*BASE		
            N = T		
            T = T - N		
            L = L + 1		
            TEXT(L:L) = DIGIT(N+1:N+1)	
            ND = ND + 1		
          END DO		
Cast forth an addendum, to save the reader from mumbling while counting long strings of digits.
          IF (LEN(TEXT) - L .GT. 11) THEN	
            WRITE (TEXT(L + 2:),11) ND		
   11       FORMAT ("Digits:",I3)		
            L = L + 1 + 10			
          END IF				
        END SUBROUTINE FP8DIGITS	
      END MODULE REBASE	

      PROGRAM TESTSOME
Check some conversions from one base to another.
      USE REBASE
      INTEGER N		
      PARAMETER (N = 5)		
      CHARACTER*12 TEXT(N)	
      DATA TEXT/"23.34375","10111.01011","1011.1101","11.90625","-666"/	
      DOUBLE PRECISION V	
      INTEGER I,L,BASE		
      CHARACTER*88 BACK		

      WRITE (6,1)	
    1 FORMAT ("Test text in base",3X,"Value in base 10")
Chug through the tests.
      DO BASE = 10,2,-8	
        DO I = 1,N		
          WRITE (6,11) TEXT(I),BASE	
   11     FORMAT (A,I5,$)		
          IF (.NOT.EATNUM(TEXT(I),BASE,V)) THEN	
            WRITE (6,*) "Not a good number
           ELSE				
            WRITE (BACK,*) V			
            WRITE (6,12) BACK(1:20)		
   12       FORMAT (A,$)			
            CALL FP8DIGITS(V,2,BACK,L)		
            WRITE (6,13) BACK(1:L)		
   13       FORMAT (A)				
            CALL FP8DIGITS(V,10,BACK,L)		
            WRITE (6,14) BACK(1:L)		
   14       FORMAT (37X,A)			
          END IF			
        END DO			
      END DO		
      END