X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffop.lisp;h=22df57fde772a7ac8b6af28f4b3e6fa48062532a;hb=2db3b6b4cb740d5b6512459c223859f747807b09;hp=f2ec21c55bb3e6f92e31e5618a7b930bc6834430;hpb=f6a2be77637d025bfded9430f02863c28f74f77a;p=sbcl.git diff --git a/src/code/fop.lisp b/src/code/fop.lisp index f2ec21c..22df57f 100644 --- a/src/code/fop.lisp +++ b/src/code/fop.lisp @@ -137,7 +137,7 @@ (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)) @@ -161,10 +161,10 @@ (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"))) ;;;; fops for loading symbols @@ -290,64 +290,41 @@ (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)))) ;;;; loading lists @@ -478,8 +455,7 @@ (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* @@ -500,8 +476,7 @@ (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))