X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffop.lisp;h=758e8b40223faa5f8ee939968e16bc361c75c22e;hb=6ab9c60f1c53cc7cc912d644658bc23453a82ac4;hp=22df57fde772a7ac8b6af28f4b3e6fa48062532a;hpb=a8161e77843ee18a99ec30dd57f796264dfac05a;p=sbcl.git diff --git a/src/code/fop.lisp b/src/code/fop.lisp index 22df57f..758e8b4 100644 --- a/src/code/fop.lisp +++ b/src/code/fop.lisp @@ -37,7 +37,7 @@ ;;; Define a pair of fops which are identical except that one reads ;;; a four-byte argument while the other reads a one-byte argument. The -;;; argument can be accessed by using the Clone-Arg macro. +;;; argument can be accessed by using the CLONE-ARG macro. ;;; ;;; KLUDGE: It would be nice if the definition here encapsulated which ;;; value ranges went with which fop variant, and chose the correct @@ -123,8 +123,6 @@ #-sb-xc-host (%primitive sb!c:make-other-immediate-type 0 sb!vm:unbound-marker-widetag)) -(define-fop (fop-character 68) - (code-char (read-arg 3))) ;;; CMU CL had FOP-CHARACTER as fop 68, but it's not needed in current ;;; SBCL as we have no extended characters, only 1-byte characters. ;;; (Ditto for CMU CL, actually: FOP-CHARACTER was speculative generality.) @@ -163,7 +161,7 @@ (unless (= *current-fop-table-index* expected-index) (bug "fasl table of improper size")))) (define-fop (fop-verify-empty-stack 63 :stackp nil) - (unless (= *fop-stack-pointer* *fop-stack-pointer-on-entry*) + (unless (zerop (length *fop-stack*)) (bug "fasl stack not empty when it should be"))) ;;;; fops for loading symbols @@ -200,9 +198,10 @@ (read-string-as-bytes *fasl-input-stream* ,n-buffer ,n-size) - (push-fop-table (intern* ,n-buffer - ,n-size - ,n-package))))))))) + (push-fop-table (without-package-locks + (intern* ,n-buffer + ,n-size + ,n-package)))))))))) ;; Note: CMU CL had FOP-SYMBOL-SAVE and FOP-SMALL-SYMBOL-SAVE, but ;; since they made the behavior of the fasloader depend on the @@ -294,14 +293,7 @@ '(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)))) + (make-double-float (fast-read-s-integer 4) lo)))) (macrolet ((define-complex-fop (name fop-code type) (let ((reader (symbolicate "FAST-READ-" type))) `(define-fop (,name ,fop-code) @@ -342,7 +334,7 @@ (macrolet ((frob (name op fun n) `(define-fop (,name ,op) - (call-with-popped-things ,fun ,n)))) + (call-with-popped-args ,fun ,n)))) (frob fop-list-1 17 list 1) (frob fop-list-2 18 list 2) @@ -386,7 +378,7 @@ (res (make-array-header sb!vm:simple-array-widetag rank))) (declare (simple-array vec) (type (unsigned-byte 24) rank)) - (set-array-header res vec length length 0 + (set-array-header res vec length nil 0 (do ((i rank (1- i)) (dimensions () (cons (pop-stack) dimensions))) ((zerop i) dimensions) @@ -406,16 +398,6 @@ (read-n-bytes *fasl-input-stream* result 0 (* length sb!vm:n-word-bytes 2)) result)) -#!+long-float -(define-fop (fop-long-float-vector 88) - (let* ((length (read-arg 4)) - (result (make-array length :element-type 'long-float))) - (read-n-bytes *fasl-input-stream* - result - 0 - (* length sb!vm:n-word-bytes #!+x86 3 #!+sparc 4)) - result)) - (define-fop (fop-complex-single-float-vector 86) (let* ((length (read-arg 4)) (result (make-array length :element-type '(complex single-float)))) @@ -431,14 +413,6 @@ (* length sb!vm:n-word-bytes 2 2)) result)) -#!+long-float -(define-fop (fop-complex-long-float-vector 89) - (let* ((length (read-arg 4)) - (result (make-array length :element-type '(complex long-float)))) - (read-n-bytes *fasl-input-stream* result 0 - (* length sb!vm:n-word-bytes #!+x86 3 #!+sparc 4 2)) - result)) - ;;; CMU CL comment: ;;; *** NOT *** the FOP-INT-VECTOR as currently documented in rtguts. ;;; Size must be a directly supported I-vector element size, with no @@ -449,11 +423,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)) @@ -474,6 +455,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))))) @@ -482,7 +464,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)))