0.8.0.24:
[sbcl.git] / src / code / fop.lisp
index f2ec21c..22df57f 100644 (file)
     (declare (type index size))
     (do ((n (1- size) (1- n)))
        ((minusp n))
-      (declare (type (integer -1 #.most-positive-fixnum) n))
+      (declare (type index-or-minus-1 n))
       (setf (%instance-ref res n) (pop-stack)))
     res))
 
 (define-fop (fop-verify-table-size 62 :stackp nil)
   (let ((expected-index (read-arg 4)))
     (unless (= *current-fop-table-index* expected-index)
-      (error "internal error: fasl table of improper size"))))
+      (bug "fasl table of improper size"))))
 (define-fop (fop-verify-empty-stack 63 :stackp nil)
   (unless (= *fop-stack-pointer* *fop-stack-pointer-on-entry*)
-    (error "internal error: fasl stack not empty when it should be")))
+    (bug "fasl stack not empty when it should be")))
 \f
 ;;;; fops for loading symbols
 
   (let ((im (pop-stack)))
     (%make-complex (pop-stack) im)))
 
-(define-fop (fop-complex-single-float 72)
-  (prepare-for-fast-read-byte *fasl-input-stream*
-    (prog1
-       (complex (make-single-float (fast-read-s-integer 4))
-                (make-single-float (fast-read-s-integer 4)))
-      (done-with-fast-read-byte))))
-
-(define-fop (fop-complex-double-float 73)
-  (prepare-for-fast-read-byte *fasl-input-stream*
-    (prog1
-       (let* ((re-lo (fast-read-u-integer 4))
-              (re-hi (fast-read-u-integer 4))
-              (re (make-double-float re-hi re-lo))
-              (im-lo (fast-read-u-integer 4))
-              (im-hi (fast-read-u-integer 4))
-              (im (make-double-float im-hi im-lo)))
-         (complex re im))
-      (done-with-fast-read-byte))))
-
-#!+long-float
-(define-fop (fop-complex-long-float 67)
-  (prepare-for-fast-read-byte *fasl-input-stream*
-    (prog1
-       (let* ((re-lo (fast-read-u-integer 4))
-              #!+sparc (re-mid (fast-read-u-integer 4))
-              (re-hi (fast-read-u-integer 4))
-              (re-exp (fast-read-s-integer #!+x86 2 #!+sparc 4))
-              (re (make-long-float re-exp re-hi #!+sparc re-mid re-lo))
-              (im-lo (fast-read-u-integer 4))
-              #!+sparc (im-mid (fast-read-u-integer 4))
-              (im-hi (fast-read-u-integer 4))
-              (im-exp (fast-read-s-integer #!+x86 2 #!+sparc 4))
-              (im (make-long-float im-exp im-hi #!+sparc im-mid im-lo)))
-         (complex re im))
-      (done-with-fast-read-byte))))
-
-(define-fop (fop-single-float 46)
-  (prepare-for-fast-read-byte *fasl-input-stream*
-    (prog1 (make-single-float (fast-read-s-integer 4))
-      (done-with-fast-read-byte))))
-
-(define-fop (fop-double-float 47)
-  (prepare-for-fast-read-byte *fasl-input-stream*
-    (prog1
-       (let ((lo (fast-read-u-integer 4)))
-         (make-double-float (fast-read-s-integer 4) lo))
-      (done-with-fast-read-byte))))
+(macrolet ((fast-read-single-float ()
+             '(make-single-float (fast-read-s-integer 4)))
+           (fast-read-double-float ()
+             '(let ((lo (fast-read-u-integer 4)))
+               (make-double-float (fast-read-s-integer 4) lo)))
+           #!+long-float
+           (fast-read-long-float ()
+             '(let ((lo (fast-read-u-integer 4))
+                    #!+sparc (mid (fast-read-u-integer 4))
+                    (hi (fast-read-u-integer 4)) ; XXX
+                    (exp (fast-read-s-integer #!+x86 2 #!+sparc 4)))
+               (make-long-float exp hi #!+sparc mid lo))))
+  (macrolet ((define-complex-fop (name fop-code type)
+               (let ((reader (symbolicate "FAST-READ-" type)))
+                 `(define-fop (,name ,fop-code)
+                      (prepare-for-fast-read-byte *fasl-input-stream*
+                        (prog1
+                            (complex (,reader) (,reader))
+                          (done-with-fast-read-byte))))))
+             (define-float-fop (name fop-code type)
+               (let ((reader (symbolicate "FAST-READ-" type)))
+                 `(define-fop (,name ,fop-code)
+                      (prepare-for-fast-read-byte *fasl-input-stream*
+                        (prog1
+                            (,reader)
+                          (done-with-fast-read-byte)))))))
+    (define-complex-fop fop-complex-single-float 72 single-float)
+    (define-complex-fop fop-complex-double-float 73 double-float)
+    #!+long-float
+    (define-complex-fop fop-complex-long-float 67 long-float)
+    (define-float-fop fop-single-float 46 single-float)
+    (define-float-fop fop-double-float 47 double-float)
+    #!+long-float
+    (define-float-fop fop-long-float 52 long-float)))
 
-#!+long-float
-(define-fop (fop-long-float 52)
-  (prepare-for-fast-read-byte *fasl-input-stream*
-    (prog1
-       (let ((lo (fast-read-u-integer 4))
-             #!+sparc (mid (fast-read-u-integer 4))
-             (hi (fast-read-u-integer 4))
-             (exp (fast-read-s-integer #!+x86 2 #!+sparc 4)))
-         (make-long-float exp hi #!+sparc mid lo))
-      (done-with-fast-read-byte))))
 \f
 ;;;; loading lists
 
                  (8 (make-array len :element-type '(unsigned-byte 8)))
                  (16 (make-array len :element-type '(unsigned-byte 16)))
                  (32 (make-array len :element-type '(unsigned-byte 32)))
-                 (t (error "internal error: losing i-vector element size: ~S"
-                           size)))))
+                 (t (bug "losing i-vector element size: ~S" size)))))
       (declare (type index len))
       (done-with-fast-read-byte)
       (read-n-bytes *fasl-input-stream*
                  (16 (make-array len :element-type '(signed-byte 16)))
                  (30 (make-array len :element-type '(signed-byte 30)))
                  (32 (make-array len :element-type '(signed-byte 32)))
-                 (t (error "internal error: losing si-vector element size: ~S"
-                           size)))))
+                 (t (bug "losing si-vector element size: ~S" size)))))
       (declare (type index len))
       (done-with-fast-read-byte)
       (read-n-bytes *fasl-input-stream*
@@ -646,8 +621,7 @@ bug.~:@>")
        (offset (read-arg 4)))
     (declare (type index offset))
     (unless (zerop (logand offset sb!vm:lowtag-mask))
-      (error "internal error: unaligned function object, offset = #X~X"
-            offset))
+      (bug "unaligned function object, offset = #X~X" offset))
     (let ((fun (%primitive sb!c:compute-fun code-object offset)))
       (setf (%simple-fun-self fun) fun)
       (setf (%simple-fun-next fun) (%code-entry-points code-object))