X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffop.lisp;h=26b72348b31b13c1c4e4544968c377cc007a7a48;hb=c41cb4c87eae7b04f844dca5f7edb5086c5d2d68;hp=514d63109242185410b4c66af24bc505e72c762a;hpb=c713eb2b521b048ff2c927ec52b861787d289f85;p=sbcl.git diff --git a/src/code/fop.lisp b/src/code/fop.lisp index 514d631..26b7234 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)) @@ -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 @@ -472,11 +449,18 @@ (let* ((len (fast-read-u-integer 4)) (size (fast-read-byte)) (res (case size + (0 (make-array len :element-type 'nil)) (1 (make-array len :element-type 'bit)) (2 (make-array len :element-type '(unsigned-byte 2))) (4 (make-array len :element-type '(unsigned-byte 4))) + (7 (prog1 (make-array len :element-type '(unsigned-byte 7)) + (setf size 8))) (8 (make-array len :element-type '(unsigned-byte 8))) + (15 (prog1 (make-array len :element-type '(unsigned-byte 15)) + (setf size 16))) (16 (make-array len :element-type '(unsigned-byte 16))) + (31 (prog1 (make-array len :element-type '(unsigned-byte 31)) + (setf size 32))) (32 (make-array len :element-type '(unsigned-byte 32))) (t (bug "losing i-vector element size: ~S" size))))) (declare (type index len)) @@ -497,6 +481,7 @@ (res (case size (8 (make-array len :element-type '(signed-byte 8))) (16 (make-array len :element-type '(signed-byte 16))) + (29 (make-array len :element-type '(unsigned-byte 29))) (30 (make-array len :element-type '(signed-byte 30))) (32 (make-array len :element-type '(signed-byte 32))) (t (bug "losing si-vector element size: ~S" size))))) @@ -505,7 +490,7 @@ (read-n-bytes *fasl-input-stream* res 0 - (ceiling (the index (* (if (= size 30) + (ceiling (the index (* (if (or (= size 30) (= size 29)) 32 ; Adjust for (signed-byte 30) size) len)) sb!vm:n-byte-bits)) res)))