X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffop.lisp;h=37e79cee8aedd0d9d0755f3ca03880b0d4db555a;hb=4281f3b99891120fea5cabbc3a9d091b19f45995;hp=26b72348b31b13c1c4e4544968c377cc007a7a48;hpb=fc999187f3f80dfcf170348df676386b8403e261;p=sbcl.git

diff --git a/src/code/fop.lisp b/src/code/fop.lisp
index 26b7234..37e79ce 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,22 +161,11 @@
     (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
 
-(defvar *load-symbol-buffer* (make-string 100))
-(declaim (simple-string *load-symbol-buffer*))
-(defvar *load-symbol-buffer-size* 100)
-(declaim (type index *load-symbol-buffer-size*))
-;;; FIXME:
-;;;   (1) *LOAD-SYMBOL-BUFFER-SIZE* is redundant, should just be
-;;;       (LENGTH *LOAD-SYMBOL-BUFFER*).
-;;;   (2) *LOAD-SYMBOL-BUFFER* should not have a global value, but should
-;;;       be bound on entry to FASL loading, and it should be renamed to
-;;;       *FASL-SYMBOL-BUFFER*.
-
 (macrolet (;; FIXME: Should all this code really be duplicated inside
 	   ;; each fop? Perhaps it would be better for this shared
 	   ;; code to live in FLET FROB1 and FLET FROB4 (for the
@@ -191,18 +178,18 @@
 		  (prepare-for-fast-read-byte *fasl-input-stream*
 		    (let ((,n-package ,package)
 			  (,n-size (fast-read-u-integer ,name-size)))
-		      (when (> ,n-size *load-symbol-buffer-size*)
-			(setq *load-symbol-buffer*
-			      (make-string (setq *load-symbol-buffer-size*
-						 (* ,n-size 2)))))
+		      (when (> ,n-size (length *fasl-symbol-buffer*))
+			(setq *fasl-symbol-buffer*
+			      (make-string (* ,n-size 2))))
 		      (done-with-fast-read-byte)
-		      (let ((,n-buffer *load-symbol-buffer*))
+		      (let ((,n-buffer *fasl-symbol-buffer*))
 			(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 +281,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 +322,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 +366,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 +386,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 +401,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