X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffop.lisp;h=6a443622bd19a7d18f46045ecea3a19c69004455;hb=f3f677703e37f5a335b3be7fa64f7748ad969517;hp=f2ec21c55bb3e6f92e31e5618a7b930bc6834430;hpb=f6a2be77637d025bfded9430f02863c28f74f77a;p=sbcl.git

diff --git a/src/code/fop.lisp b/src/code/fop.lisp
index f2ec21c..6a44362 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
@@ -49,8 +49,8 @@
 ;;;	       (dump-integer-as-n-bytes total-length 2 file))
 ;;;	      (t
 ;;;	       (dump-fop 'sb!impl::fop-code file)
-;;;	       (dump-unsigned-32 num-consts file)
-;;;	       (dump-unsigned-32 total-length file))))
+;;;	       (dump-word num-consts file)
+;;;	       (dump-word total-length file))))
 ;;; in several places. It would be cleaner if this could be replaced with
 ;;; something like
 ;;;     (dump-fop file fop-code num-consts total-length)
@@ -62,26 +62,38 @@
   (aver (member pushp '(nil t)))
   (aver (member stackp '(nil t)))
   `(progn
-     (macrolet ((clone-arg () '(read-arg 4)))
+     (macrolet ((clone-arg () '(read-word-arg)))
        (define-fop (,name ,code :pushp ,pushp :stackp ,stackp) ,@forms))
-     (macrolet ((clone-arg () '(read-arg 1)))
+     (macrolet ((clone-arg () '(read-byte-arg)))
        (define-fop (,small-name ,small-code :pushp ,pushp :stackp stackp) ,@forms))))
 
 ;;; a helper function for reading string values from FASL files: sort
 ;;; of like READ-SEQUENCE specialized for files of (UNSIGNED-BYTE 8),
 ;;; with an automatic conversion from (UNSIGNED-BYTE 8) into CHARACTER
 ;;; for each element read
-(declaim (ftype (function (stream simple-string &optional index) (values)) read-string-as-bytes))
+(declaim (ftype (function (stream simple-string &optional index) (values))
+                read-string-as-bytes #!+sb-unicode read-string-as-words))
 (defun read-string-as-bytes (stream string &optional (length (length string)))
   (dotimes (i length)
     (setf (aref string i)
-	  (code-char (read-byte stream))))
+	  (sb!xc:code-char (read-byte stream))))
   ;; FIXME: The classic CMU CL code to do this was
   ;;   (READ-N-BYTES FILE STRING START END).
   ;; It was changed for SBCL because we needed a portable version for
   ;; bootstrapping. Benchmark the non-portable version and see whether it's
   ;; significantly better than the portable version here. If it is, then use
-  ;; add as an alternate definition, protected with #-SB-XC-HOST.
+  ;; it as an alternate definition, protected with #-SB-XC-HOST.
+  (values))
+#!+sb-unicode
+(defun read-string-as-words (stream string &optional (length (length string)))
+  #+sb-xc-host (bug "READ-STRING-AS-WORDS called")
+  (dotimes (i length)
+    (setf (aref string i)
+	  (let ((code 0))
+	    ;; FIXME: is this the same as READ-WORD-ARG?
+	    (dotimes (k sb!vm:n-word-bytes (sb!xc:code-char code))
+	      (setf code (logior code (ash (read-byte stream) 
+					   (* k sb!vm:n-byte-bits))))))))
   (values))
 
 ;;;; miscellaneous fops
@@ -110,8 +122,8 @@
 
 (define-fop (fop-nop 0 :stackp nil))
 (define-fop (fop-pop 1 :pushp nil) (push-fop-table (pop-stack)))
-(define-fop (fop-push 2) (svref *current-fop-table* (read-arg 4)))
-(define-fop (fop-byte-push 3) (svref *current-fop-table* (read-arg 1)))
+(define-fop (fop-push 2) (svref *current-fop-table* (read-word-arg)))
+(define-fop (fop-byte-push 3) (svref *current-fop-table* (read-byte-arg)))
 
 (define-fop (fop-empty-list 4) ())
 (define-fop (fop-truth 5) t)
@@ -123,30 +135,32 @@
   #-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.)
-(define-fop (fop-short-character 69)
-  (code-char (read-arg 1)))
+(define-cloned-fops (fop-character 68) (fop-short-character 69)
+  (code-char (clone-arg)))
 
 (define-cloned-fops (fop-struct 48) (fop-small-struct 49)
   (let* ((size (clone-arg))
 	 (res (%make-instance size)))
     (declare (type index size))
-    (do ((n (1- size) (1- n)))
-	((minusp n))
-      (declare (type (integer -1 #.most-positive-fixnum) n))
-      (setf (%instance-ref res n) (pop-stack)))
+    (let* ((layout (pop-stack))
+	   (nuntagged (layout-n-untagged-slots layout))
+	   (ntagged (- size nuntagged)))
+      (setf (%instance-ref res 0) layout)
+      (dotimes (n (1- ntagged))
+	(declare (type index n))
+	(setf (%instance-ref res (1+ n)) (pop-stack)))
+      (dotimes (n nuntagged)
+	(declare (type index n))
+	(setf (%raw-instance-ref/word res (- nuntagged n 1)) (pop-stack))))
     res))
 
 (define-fop (fop-layout 45)
-  (let ((length (pop-stack))
+  (let ((nuntagged (pop-stack))
+	(length (pop-stack))
 	(depthoid (pop-stack))
 	(inherits (pop-stack))
 	(name (pop-stack)))
-    (find-and-init-or-check-layout name length inherits depthoid)))
+    (find-and-init-or-check-layout name length inherits depthoid nuntagged)))
 
 (define-fop (fop-end-group 64 :stackp nil)
   (/show0 "THROWing FASL-GROUP-END")
@@ -159,26 +173,15 @@
 (define-fop (fop-maybe-cold-load 82 :stackp nil))
 
 (define-fop (fop-verify-table-size 62 :stackp nil)
-  (let ((expected-index (read-arg 4)))
+  (let ((expected-index (read-word-arg)))
     (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")))
+  (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 +194,25 @@
 		  (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*))
+                        #+sb-xc-host
 			(read-string-as-bytes *fasl-input-stream*
 					      ,n-buffer
 					      ,n-size)
-			(push-fop-table (intern* ,n-buffer
-						 ,n-size
-						 ,n-package)))))))))
+                        #-sb-xc-host
+			(#!+sb-unicode read-string-as-words
+                         #!-sb-unicode read-string-as-bytes
+                         *fasl-input-stream*
+                         ,n-buffer
+                         ,n-size)
+			(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
@@ -222,9 +232,9 @@
   ;;(frob fop-symbol-save		6 4 *package*)
   ;;(frob fop-small-symbol-save	  7 1 *package*)
 
-  (frob fop-lisp-symbol-save	      75 4 *cl-package*)
+  (frob fop-lisp-symbol-save	      75 #.sb!vm:n-word-bytes *cl-package*)
   (frob fop-lisp-small-symbol-save    76 1 *cl-package*)
-  (frob fop-keyword-symbol-save       77 4 *keyword-package*)
+  (frob fop-keyword-symbol-save       77 #.sb!vm:n-word-bytes *keyword-package*)
   (frob fop-keyword-small-symbol-save 78 1 *keyword-package*)
 
   ;; FIXME: Because we don't have FOP-SYMBOL-SAVE any more, an enormous number
@@ -232,11 +242,11 @@
   ;; fasl files. A new
   ;; FOP-SYMBOL-IN-LAST-PACKAGE-SAVE/FOP-SMALL-SYMBOL-IN-LAST-PACKAGE-SAVE
   ;; cloned fop pair could undo some of this bloat.
-  (frob fop-symbol-in-package-save 8 4
-    (svref *current-fop-table* (fast-read-u-integer 4)))
+  (frob fop-symbol-in-package-save 8 #.sb!vm:n-word-bytes
+    (svref *current-fop-table* (fast-read-u-integer #.sb!vm:n-word-bytes)))
   (frob fop-small-symbol-in-package-save 9 1
-    (svref *current-fop-table* (fast-read-u-integer 4)))
-  (frob fop-symbol-in-byte-package-save 10 4
+    (svref *current-fop-table* (fast-read-u-integer #.sb!vm:n-word-bytes)))
+  (frob fop-symbol-in-byte-package-save 10 #.sb!vm:n-word-bytes
     (svref *current-fop-table* (fast-read-u-integer 1)))
   (frob fop-small-symbol-in-byte-package-save 11 1
     (svref *current-fop-table* (fast-read-u-integer 1))))
@@ -245,7 +255,10 @@
 		    (fop-uninterned-small-symbol-save 13)
   (let* ((arg (clone-arg))
 	 (res (make-string arg)))
+    #!-sb-unicode
     (read-string-as-bytes *fasl-input-stream* res)
+    #!+sb-unicode
+    (read-string-as-words *fasl-input-stream* res)
     (push-fop-table (make-symbol res))))
 
 (define-fop (fop-package 14)
@@ -273,7 +286,7 @@
 (define-fop (fop-word-integer 35)
   (prepare-for-fast-read-byte *fasl-input-stream*
     (prog1
-     (fast-read-s-integer 4)
+     (fast-read-s-integer #.sb!vm:n-word-bytes)
      (done-with-fast-read-byte))))
 
 (define-fop (fop-byte-integer 36)
@@ -290,82 +303,52 @@
   (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))))
+  (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
 
 (define-fop (fop-list 15)
   (do ((res () (cons (pop-stack) res))
-       (n (read-arg 1) (1- n)))
+       (n (read-byte-arg) (1- n)))
       ((zerop n) res)
     (declare (type index n))))
 
 (define-fop (fop-list* 16)
   (do ((res (pop-stack) (cons (pop-stack) res))
-       (n (read-arg 1) (1- n)))
+       (n (read-byte-arg) (1- n)))
       ((zerop n) res)
     (declare (type index n))))
 
 (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)
@@ -387,12 +370,25 @@
 
 ;;;; fops for loading arrays
 
-(define-cloned-fops (fop-string 37) (fop-small-string 38)
+(define-cloned-fops (fop-base-string 37) (fop-small-base-string 38)
   (let* ((arg (clone-arg))
-	 (res (make-string arg)))
+	 (res (make-string arg :element-type 'base-char)))
     (read-string-as-bytes *fasl-input-stream* res)
     res))
 
+#!+sb-unicode
+(progn
+  #+sb-xc-host
+  (define-cloned-fops (fop-character-string 161) (fop-small-character-string 162)
+    (bug "CHARACTER-STRING FOP encountered"))
+
+  #-sb-xc-host
+  (define-cloned-fops (fop-character-string 161) (fop-small-character-string 162)
+    (let* ((arg (clone-arg))
+           (res (make-string arg)))
+      (read-string-as-words *fasl-input-stream* res)
+      res)))
+
 (define-cloned-fops (fop-vector 39) (fop-small-vector 40)
   (let* ((size (clone-arg))
 	 (res (make-array size)))
@@ -403,13 +399,13 @@
     res))
 
 (define-fop (fop-array 83)
-  (let* ((rank (read-arg 4))
+  (let* ((rank (read-word-arg))
 	 (vec (pop-stack))
 	 (length (length vec))
 	 (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
+	     (type (unsigned-byte #.(- sb!vm:n-word-bits sb!vm:n-widetag-bits)) rank))
+    (set-array-header res vec length nil 0
 		      (do ((i rank (1- i))
 			   (dimensions () (cons (pop-stack) dimensions)))
 			  ((zerop i) dimensions)
@@ -418,48 +414,27 @@
     res))
 
 (define-fop (fop-single-float-vector 84)
-  (let* ((length (read-arg 4))
+  (let* ((length (read-word-arg))
 	 (result (make-array length :element-type 'single-float)))
-    (read-n-bytes *fasl-input-stream* result 0 (* length sb!vm:n-word-bytes))
+    (read-n-bytes *fasl-input-stream* result 0 (* length 4))
     result))
 
 (define-fop (fop-double-float-vector 85)
-  (let* ((length (read-arg 4))
+  (let* ((length (read-word-arg))
 	 (result (make-array length :element-type 'double-float)))
-    (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))
+    (read-n-bytes *fasl-input-stream* result 0 (* length 8))
     result))
 
 (define-fop (fop-complex-single-float-vector 86)
-  (let* ((length (read-arg 4))
+  (let* ((length (read-word-arg))
 	 (result (make-array length :element-type '(complex single-float))))
-    (read-n-bytes *fasl-input-stream* result 0 (* length sb!vm:n-word-bytes 2))
+    (read-n-bytes *fasl-input-stream* result 0 (* length 8))
     result))
 
 (define-fop (fop-complex-double-float-vector 87)
-  (let* ((length (read-arg 4))
+  (let* ((length (read-word-arg))
 	 (result (make-array length :element-type '(complex double-float))))
-    (read-n-bytes *fasl-input-stream*
-		  result
-		  0
-		  (* 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))
+    (read-n-bytes *fasl-input-stream* result 0 (* length 16))
     result))
 
 ;;; CMU CL comment:
@@ -469,47 +444,66 @@
 ;;;   byte-ordering, allowing us to directly read the bits.
 (define-fop (fop-int-vector 43)
   (prepare-for-fast-read-byte *fasl-input-stream*
-    (let* ((len (fast-read-u-integer 4))
+    (let* ((len (fast-read-u-integer #.sb!vm:n-word-bytes))
 	   (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 (error "internal error: losing i-vector element size: ~S"
-			    size)))))
+                  #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+                  (63 (prog1 (make-array len :element-type '(unsigned-byte 63))
+                        (setf size 64)))
+                  (64 (make-array len :element-type '(unsigned-byte 64)))
+		  (t (bug "losing i-vector element size: ~S" size)))))
       (declare (type index len))
       (done-with-fast-read-byte)
       (read-n-bytes *fasl-input-stream*
 		    res
 		    0
-		    (ceiling (the index (* size len))
-			     sb!vm:n-byte-bits))
+		    (ceiling (the index (* size len)) sb!vm:n-byte-bits))
       res)))
 
 ;;; This is the same as FOP-INT-VECTOR, except this is for signed
 ;;; SIMPLE-ARRAYs.
 (define-fop (fop-signed-int-vector 50)
   (prepare-for-fast-read-byte *fasl-input-stream*
-    (let* ((len (fast-read-u-integer 4))
+    (let* ((len (fast-read-u-integer #.sb!vm:n-word-bytes))
 	   (size (fast-read-byte))
 	   (res (case size
  		  (8 (make-array len :element-type '(signed-byte 8)))
  		  (16 (make-array len :element-type '(signed-byte 16)))
- 		  (30 (make-array len :element-type '(signed-byte 30)))
+                  #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
+		  (29 (prog1 (make-array len :element-type '(unsigned-byte 29))
+                        (setf size 32)))
+                  #!+#.(cl:if (cl:= 32 sb!vm:n-word-bits) '(and) '(or))
+ 		  (30 (prog1 (make-array len :element-type '(signed-byte 30))
+                        (setf size 32)))
  		  (32 (make-array len :element-type '(signed-byte 32)))
- 		  (t (error "internal error: losing si-vector element size: ~S"
-			    size)))))
+                  #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+                  (60 (prog1 (make-array len :element-type '(unsigned-byte 60))
+                        (setf size 64)))
+                  #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+                  (61 (prog1 (make-array len :element-type '(signed-byte 61))
+                        (setf size 64)))
+                  #!+#.(cl:if (cl:= 64 sb!vm:n-word-bits) '(and) '(or))
+                  (64 (make-array len :element-type '(signed-byte 64)))
+ 		  (t (bug "losing si-vector element size: ~S" size)))))
       (declare (type index len))
       (done-with-fast-read-byte)
       (read-n-bytes *fasl-input-stream*
 		    res
 		    0
- 		    (ceiling (the index (* (if (= size 30)
-					       32 ; Adjust for (signed-byte 30)
-					       size) len)) sb!vm:n-byte-bits))
+ 		    (ceiling (the index (* size len)) sb!vm:n-byte-bits))
       res)))
 
 (define-fop (fop-eval 53)
@@ -534,7 +528,7 @@
 	    (terpri))))
 
 (define-fop (fop-funcall 55)
-  (let ((arg (read-arg 1)))
+  (let ((arg (read-byte-arg)))
     (if (zerop arg)
 	(funcall (pop-stack))
 	(do ((args () (cons (pop-stack) args))
@@ -543,7 +537,7 @@
 	  (declare (type index n))))))
 
 (define-fop (fop-funcall-for-effect 56 :pushp nil)
-  (let ((arg (read-arg 1)))
+  (let ((arg (read-byte-arg)))
     (if (zerop arg)
 	(funcall (pop-stack))
 	(do ((args () (cons (pop-stack) args))
@@ -554,35 +548,35 @@
 ;;;; fops for fixing up circularities
 
 (define-fop (fop-rplaca 200 :pushp nil)
-  (let ((obj (svref *current-fop-table* (read-arg 4)))
-	(idx (read-arg 4))
+  (let ((obj (svref *current-fop-table* (read-word-arg)))
+	(idx (read-word-arg))
 	(val (pop-stack)))
     (setf (car (nthcdr idx obj)) val)))
 
 (define-fop (fop-rplacd 201 :pushp nil)
-  (let ((obj (svref *current-fop-table* (read-arg 4)))
-	(idx (read-arg 4))
+  (let ((obj (svref *current-fop-table* (read-word-arg)))
+	(idx (read-word-arg))
 	(val (pop-stack)))
     (setf (cdr (nthcdr idx obj)) val)))
 
 (define-fop (fop-svset 202 :pushp nil)
-  (let* ((obi (read-arg 4))
+  (let* ((obi (read-word-arg))
 	 (obj (svref *current-fop-table* obi))
-	 (idx (read-arg 4))
+	 (idx (read-word-arg))
 	 (val (pop-stack)))
     (if (typep obj 'instance)
 	(setf (%instance-ref obj idx) val)
 	(setf (svref obj idx) val))))
 
 (define-fop (fop-structset 204 :pushp nil)
-  (setf (%instance-ref (svref *current-fop-table* (read-arg 4))
-		       (read-arg 4))
+  (setf (%instance-ref (svref *current-fop-table* (read-word-arg))
+		       (read-word-arg))
 	(pop-stack)))
 
 ;;; In the original CMUCL code, this actually explicitly declared PUSHP
 ;;; to be T, even though that's what it defaults to in DEFINE-FOP.
 (define-fop (fop-nthcdr 203)
-  (nthcdr (read-arg 4) (pop-stack)))
+  (nthcdr (read-word-arg) (pop-stack)))
 
 ;;;; fops for loading functions
 
@@ -594,10 +588,10 @@
 ;;; fasl file header.)
 
 (define-fop (fop-code 58 :stackp nil)
-  (load-code (read-arg 4) (read-arg 4)))
+  (load-code (read-word-arg) (read-word-arg)))
 
 (define-fop (fop-small-code 59 :stackp nil)
-  (load-code (read-arg 1) (read-arg 2)))
+  (load-code (read-byte-arg) (read-halfword-arg)))
 
 (define-fop (fop-fdefinition 60)
   (fdefinition-object (pop-stack) t))
@@ -643,11 +637,10 @@ bug.~:@>")
 	(arglist (pop-stack))
 	(name (pop-stack))
 	(code-object (pop-stack))
-	(offset (read-arg 4)))
+	(offset (read-word-arg)))
     (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))
@@ -675,24 +668,24 @@ bug.~:@>")
 
 ;;;; assemblerish fops
 
+(define-fop (fop-assembler-code 144)
+  (error "cannot load assembler code except at cold load"))
+
+(define-fop (fop-assembler-routine 145)
+  (error "cannot load assembler code except at cold load"))
+
 (define-fop (fop-foreign-fixup 147)
   (let* ((kind (pop-stack))
 	 (code-object (pop-stack))
-	 (len (read-arg 1))
-	 (sym (make-string len)))
+	 (len (read-byte-arg))
+	 (sym (make-string len :element-type 'base-char)))
     (read-n-bytes *fasl-input-stream* sym 0 len)
     (sb!vm:fixup-code-object code-object
-			     (read-arg 4)
+			     (read-word-arg)
 			     (foreign-symbol-address-as-integer sym)
 			     kind)
     code-object))
 
-(define-fop (fop-assembler-code 144)
-  (error "cannot load assembler code except at cold load"))
-
-(define-fop (fop-assembler-routine 145)
-  (error "cannot load assembler code except at cold load"))
-
 (define-fop (fop-assembler-fixup 148)
   (let ((routine (pop-stack))
 	(kind (pop-stack))
@@ -700,7 +693,7 @@ bug.~:@>")
     (multiple-value-bind (value found) (gethash routine *assembler-routines*)
       (unless found
 	(error "undefined assembler routine: ~S" routine))
-      (sb!vm:fixup-code-object code-object (read-arg 4) value kind))
+      (sb!vm:fixup-code-object code-object (read-word-arg) value kind))
     code-object))
 
 (define-fop (fop-code-object-fixup 149)
@@ -709,6 +702,19 @@ bug.~:@>")
     ;; Note: We don't have to worry about GC moving the code-object after
     ;; the GET-LISP-OBJ-ADDRESS and before that value is deposited, because
     ;; we can only use code-object fixups when code-objects don't move.
-    (sb!vm:fixup-code-object code-object (read-arg 4)
+    (sb!vm:fixup-code-object code-object (read-word-arg)
 			     (get-lisp-obj-address code-object) kind)
     code-object))
+
+#!+linkage-table
+(define-fop (fop-foreign-dataref-fixup 150)
+  (let* ((kind (pop-stack))
+	 (code-object (pop-stack))
+	 (len (read-byte-arg))
+	 (sym (make-string len :element-type 'base-char)))
+    (read-n-bytes *fasl-input-stream* sym 0 len)
+    (sb!vm:fixup-code-object code-object
+			     (read-word-arg)
+			     (foreign-symbol-address-as-integer sym t)
+			     kind)
+    code-object))