単精度浮動小数点数

導入

単精度浮動小数点数を扱うプログラムで書くことで、単精度浮動小数点数の内部表現についての理解を深めます。

プログラム

(use srfi-13)

(define nil '())

(define (digit->integer c)
  (- (char->integer c) (char->integer #\0)))

;;

(define (number->bns num)
  (format #f "~32,'0b" num))

(define (bns->float bns)
  (let ((s (get-s bns))
        (e (get-e bns))
        (m (get-m bns)))
    (* s m (expt 2 (- e 127)))))

(define (get-s bns)
  (let ((val (string->number (substring bns 0 1) 2)))
    (if (= val 0)
        1
        -1)))

(define (get-e bns)
  (string->number (substring bns 1 9) 2))

(define (get-m bns)
  (bns->binary (substring bns 9 32)))

(define (bns->binary bns)
  (define (iter lst k val)
    (if (null? lst)
        val
        (iter (cdr lst)
              (/ k 2)
              (if (= (car lst) 1) (+ val k) val))))
  (iter (map digit->integer (string->list bns)) 0.5 1))

(define (dec->num dec)
  (define (iter lis val)
    (if (null? lis)
        val
        (iter (cdr lis) (+ (* 2 val) (car lis)))))
  (iter (map digit->integer (string->list dec)) 0))

(define (round-dec dec-pt)
  (let ((lsd (string->number (substring dec-pt 23 24)))
        (dec (substring dec-pt 0 23)))
    (if (= lsd 0)
        dec
        (let ((rd (+ (dec->num dec) lsd)))
          (if (>= rd #xFFFFFF)
              dec
              (format #f "~23,'0b" rd))))))

(define (decimal->bin d k bin)
  (if (or (> k 24) (= d 0))
      bin
      (let* ((s (string-split (number->string (* d 2)) "."))
             (i (car s))
             (nd (cadr s)))
        (decimal->bin (string->number (string-append "0." nd)) (+ k 1) (string-append bin i)))))

(define (integer-part str)
  (format #f "~b" (string->number str)))

(define (decimal-part str)
  (decimal->bin str 0 ""))

(define (optimize-hex f)
  (define (opt-int int-pt dec-pt)
    (cons
     (+ 127 (- (string-length int-pt) 1))
     (round-dec (string-pad-right (string-append (substring int-pt 1 (string-length int-pt)) dec-pt) 24 #\0))))
  (define (opt-dec dec-pt)
    (define (iter d k)
      (if (or (null? d) (= (car d) 1))
          (cons (- 127 k)
                (round-dec (string-pad-right (substring dec-pt k (string-length dec-pt)) 24 #\0)))
          (iter (cdr d) (+ k 1))))
    (iter (map digit->integer (string->list dec-pt)) 1))
  (let* ((v (if (< f 0) (* -1 f) f))
         (s (string-split (number->string v) "."))
         (i (car s))
         (d (string->number (string-append "0." (cadr s)))))
    (let* ((int-pt (integer-part i))
           (dec-pt (decimal-part d)))
      (if (> (string->number int-pt) 0)
          (opt-int int-pt dec-pt)
          (opt-dec dec-pt)))))

(define (bns->hex bns)
  (define (iter lst hex)
    (if (null? lst)
        hex
        (iter (cddddr lst)
              (string-append
               hex
               (format #f "~x"
                       (+ (* 8 (car lst))
                          (* 4 (cadr lst))
                          (* 2 (caddr lst))
                          (cadddr lst)))))))
  (iter (map digit->integer (string->list bns)) ""))

;; IEEE 標準形式(単精度) 16->2 進数変換
(define (hex->float hex)
  (inexact (bns->float (number->bns hex))))

;; IEEE 標準形式(単精度) 2->16 進数変換
(define (float->hex f)
  (let* ((s (if (< f 0) "1" "0"))
         (h (optimize-hex f))
         (e (car h))
         (m (cdr h)))
    (bns->hex
     (string-append s
                    (format #f "~8,'0b" e)
                    m))))

実行例

1.

gosh> (float->hex (* (hex->float #x40a80000) (hex->float #xc0300000)))
"c1670000"

2.

gosh> (+ (hex->float #xC12C0000) (hex->float #x40A40000))
-5.625

参考文献

実行例1 ... 技術士一次試験 平成27年度 専門科目 III-32
実行例2 ... 技術士一次試験 平成23年度 専門科目 IV-8