X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffop.lisp;h=6a6b94919bae6a71992c057c575a0ea0f070cf66;hb=56a972e201d117a8d5d769527f2bafd23cba7de9;hp=22df57fde772a7ac8b6af28f4b3e6fa48062532a;hpb=a8161e77843ee18a99ec30dd57f796264dfac05a;p=sbcl.git

diff --git a/src/code/fop.lisp b/src/code/fop.lisp
index 22df57f..6a6b949 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
@@ -342,7 +340,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)
@@ -449,11 +447,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 +479,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 +488,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)))