Imported Upstream version 16.7

1 files changed, 37 insertions, 39 deletions

diff --git a/binary-io.scm b/binary-io.scm
index 30341f2..be83523 100644
--- a/binary-io.scm
+++ b/binary-io.scm
@@ -127,17 +127,17 @@
   (int_to_float32 (read-lint32)))
 
 (define (float64_to_int32 flt)
-  (let* ((data (integer-decode-float flt))
-	 (signif (car data))
-	 (expon (cadr data))
-	 (sign (caddr data)))
-    (if (= expon signif 0)
-	0
-	;; we're assuming floats are (64-bit) doubles in s7, so this is coercing to a 32-bit float in a sense
-	;;   this causes some round-off error
-	(logior (if (negative? sign) #x80000000 0)
-		(ash (+ expon 179) 23)   ; 179 = (+ 52 127)
-		(logand (ash signif -29) #x7fffff)))))
+  (let ((data (integer-decode-float flt)))
+    (let ((signif (car data))
+	  (expon (cadr data))
+	  (sign (caddr data)))
+      (if (= expon signif 0)
+	  0
+	  ;; we're assuming floats are (64-bit) doubles in s7, so this is coercing to a 32-bit float in a sense
+	  ;;   this causes some round-off error
+	  (logior (if (negative? sign) #x80000000 0)
+		  (ash (+ expon 179) 23)   ; 179 = (+ 52 127)
+		  (logand (ash signif -29) #x7fffff))))))
 
 (define (write-bfloat32 flt)
   (write-bint32 (float64_to_int32 flt)))
@@ -164,15 +164,15 @@
   (int_to_float64 (read-lint64)))
 
 (define (float64_to_int64 flt)
-  (let* ((data (integer-decode-float flt))
-	 (signif (car data))
-	 (expon (cadr data))
-	 (sign (caddr data)))
-    (if (= expon signif 0)
-	0
-	(logior (if (negative? sign) #x8000000000000000 0)
-		(ash (+ expon 1075) 52) ; 1075 = (+ 52 1023)
-		(logand signif #xfffffffffffff)))))
+  (let ((data (integer-decode-float flt)))
+    (let ((signif (car data))
+	  (expon (cadr data))
+	  (sign (caddr data)))
+      (if (= expon signif 0)
+	  0
+	  (logior (if (negative? sign) #x8000000000000000 0)
+		  (ash (+ expon 1075) 52) ; 1075 = (+ 52 1023)
+		  (logand signif #xfffffffffffff))))))
 
 (define (write-bfloat64 flt)
   (write-bint64 (float64_to_int64 flt)))
@@ -186,8 +186,6 @@
 
 (define (read-bfloat80->int)
   (let ((exp 0)
-	(mant1 0)
-	(mant0 0)
 	(sign 0)
 	(buf (make-vector 10)))
     (do ((i 0 (+ i 1)))
@@ -196,14 +194,14 @@
     (set! exp (logior (ash (buf 0) 8) (buf 1)))
     (set! sign (if (not (= (logand exp #x8000) 0)) 1 0))
     (set! exp (logand exp #x7FFF))
-    (set! mant1 (+ (ash (buf 2) 24) (ash (buf 3) 16) (ash (buf 4) 8) (buf 5)))
-    (set! mant0 (+ (ash (buf 6) 24) (ash (buf 7) 16) (ash (buf 8) 8) (buf 9)))
-    (if (= mant1 mant0 exp sign 0) 
-	0
-      (round (* (if (= sign 1) -1 1)
-		(expt 2.0 (- exp 16383.0))
-		(+ (* (expt 2.0 -31.0) mant1)
-		   (* (expt 2.0 -63.0) mant0)))))))
+    (let ((mant1 (+ (ash (buf 2) 24) (ash (buf 3) 16) (ash (buf 4) 8) (buf 5)))
+	  (mant0 (+ (ash (buf 6) 24) (ash (buf 7) 16) (ash (buf 8) 8) (buf 9))))
+      (if (= mant1 mant0 exp sign 0) 
+	  0
+	  (round (* (if (= sign 1) -1 1)
+		    (expt 2.0 (- exp 16383.0))
+		    (+ (* (expt 2.0 -31.0) mant1)
+		       (* (expt 2.0 -63.0) mant0))))))))
 
 (define (write-int->bfloat80 val)
   (let ((exp 0)    
@@ -254,17 +252,17 @@
   (with-output-to-file file
     (lambda ()
       (let* ((comlen (length comment))
-	     (data-location (+ 24 (* 4 (floor (+ 1 (/ comlen 4))))))
-	     (curloc 24))
+	     (data-location (+ 24 (* 4 (floor (+ 1 (/ comlen 4)))))))
 	(write-chars ".snd")
 	(for-each write-bint32 (vector data-location data-size sample-type srate chns))
-	(if (> comlen 0)
-	    (begin
-	      (io-write-string comment)
-	      (set! curloc (+ curloc comlen 1)))) ; io-write-string adds a trailing 0
-	(do ((i curloc (+ i 1)))
-	    ((>= i data-location))
-	  (write-byte 0))))))
+	(let ((curloc 24))
+	  (if (> comlen 0)
+	      (begin
+		(io-write-string comment)
+		(set! curloc (+ curloc comlen 1)))) ; io-write-string adds a trailing 0
+	  (do ((i curloc (+ i 1)))
+	      ((>= i data-location))
+	    (write-byte 0)))))))
 
 
 (define (read-aif-header file)