;;; 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)
;; 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))
,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
#!-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)
(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)
(dimensions () (cons (pop-stack) dimensions)))
((zerop i) dimensions)
(declare (type index i)))
- nil)
+ nil
+ t)
res))
(define-fop (fop-single-float-vector 84)
(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))
#+sb-xc-host ; since xc host doesn't know how to compile %PRIMITIVE
(error "FOP-FUN-ENTRY can't be defined without %PRIMITIVE.")
#-sb-xc-host
- (let ((xrefs (pop-stack))
+ (let ((info (pop-stack))
(type (pop-stack))
(arglist (pop-stack))
(name (pop-stack))
(setf (%simple-fun-name fun) name)
(setf (%simple-fun-arglist fun) arglist)
(setf (%simple-fun-type fun) type)
- (setf (%simple-fun-xrefs fun) xrefs)
+ (setf (%simple-fun-info fun) info)
;; FIXME: See the comment about *LOAD-PRINT* in FOP-EVAL.
#+nil (when *load-print*
(load-fresh-line)