X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ffop.lisp;h=d9acdd5f6349798894791c04a18e32d18c901751;hb=a160917364f85b38dc0826a5e3dcef87e3c4c62c;hp=146bec97f22c2f428024ca58d57e064eb9782beb;hpb=cb83aa22932bf4b9bc74ac6f0fcd91db1702ad33;p=sbcl.git

diff --git a/src/code/fop.lisp b/src/code/fop.lisp
index 146bec9..d9acdd5 100644
--- a/src/code/fop.lisp
+++ b/src/code/fop.lisp
@@ -71,14 +71,15 @@
      (macrolet ((clone-arg () '(read-word-arg)))
        (define-fop (,name ,code :pushp ,pushp :stackp ,stackp) ,@forms))
      (macrolet ((clone-arg () '(read-byte-arg)))
-       (define-fop (,small-name ,small-code :pushp ,pushp :stackp stackp) ,@forms))))
+       (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 #!+sb-unicode read-string-as-words))
+                read-string-as-bytes
+                #!+sb-unicode read-string-as-unsigned-byte-32))
 (defun read-string-as-bytes (stream string &optional (length (length string)))
   (dotimes (i length)
     (setf (aref string i)
@@ -91,13 +92,13 @@
   ;; 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")
+(defun read-string-as-unsigned-byte-32
+    (stream string &optional (length (length string)))
+  #+sb-xc-host (bug "READ-STRING-AS-UNSIGNED-BYTE-32 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))
+            (dotimes (k 4 (sb!xc:code-char code))
               (setf code (logior code (ash (read-byte stream)
                                            (* k sb!vm:n-byte-bits))))))))
   (values))
@@ -210,7 +211,7 @@
                                               ,n-buffer
                                               ,n-size)
                         #-sb-xc-host
-                        (#!+sb-unicode read-string-as-words
+                        (#!+sb-unicode read-string-as-unsigned-byte-32
                          #!-sb-unicode read-string-as-bytes
                          *fasl-input-stream*
                          ,n-buffer
@@ -264,7 +265,7 @@
     #!-sb-unicode
     (read-string-as-bytes *fasl-input-stream* res)
     #!+sb-unicode
-    (read-string-as-words *fasl-input-stream* res)
+    (read-string-as-unsigned-byte-32 *fasl-input-stream* res)
     (push-fop-table (make-symbol res))))
 
 (define-fop (fop-package 14)
@@ -392,7 +393,7 @@
   (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)
+      (read-string-as-unsigned-byte-32 *fasl-input-stream* res)
       res)))
 
 (define-cloned-fops (fop-vector 39) (fop-small-vector 40)
@@ -638,6 +639,17 @@ bug.~:@>")
         (name (pop-stack)))
     (setf (fdefinition name) fn)))
 
+(define-fop (fop-note-debug-source 174 :pushp nil)
+  (warn "~@<FOP-NOTE-DEBUG-SOURCE seen in ordinary load (not cold load) -- ~
+very strange!  If you didn't do something to cause this, please report it as ~
+a bug.~@:>")
+  ;; as with COLD-FSET above, we are going to be lenient with coming
+  ;; across this fop in a warm SBCL.
+  (let ((debug-source (pop-stack)))
+    (setf (sb!c::debug-source-compiled debug-source) (get-universal-time)
+          (sb!c::debug-source-created debug-source)
+          (file-write-date (sb!c::debug-source-namestring debug-source)))))
+
 ;;; Modify a slot in a CONSTANTS object.
 (define-cloned-fops (fop-alter-code 140 :pushp nil) (fop-byte-alter-code 141)
   (let ((value (pop-stack))