"1.0.41.2": threads: Add memory-barrier framework.

[sbcl.git] / src / code / fop.lisp

diff --git a/src/code/fop.lisp b/src/code/fop.lisp
index 655b6e9..9891b46 100644 (file)
--- a/src/code/fop.lisp
+++ b/src/code/fop.lisp
@@ -173,11 +173,9 @@
   (/show0 "THROWing FASL-GROUP-END")
   (throw 'fasl-group-end t))
 
-;;; In the normal loader, we just ignore these. GENESIS overwrites
-;;; FOP-MAYBE-COLD-LOAD with something that knows whether to revert to
-;;; cold-loading or not.
-(define-fop (fop-normal-load 81 :stackp nil))
-(define-fop (fop-maybe-cold-load 82 :stackp nil))
+;;; We used to have FOP-NORMAL-LOAD as 81 and FOP-MAYBE-COLD-LOAD as
+;;; 82 until GENESIS learned how to work with host symbols and
+;;; packages directly instead of piggybacking on the host code.
 
 (define-fop (fop-verify-table-size 62 :stackp nil)
   (let ((expected-index (read-word-arg)))
@@ -270,6 +268,18 @@
 
 (define-fop (fop-package 14)
   (find-undeleted-package-or-lose (pop-stack)))
+
+(define-cloned-fops (fop-named-package-save 156 :stackp nil)
+                    (fop-small-named-package-save 157)
+  (let* ((arg (clone-arg))
+         (package-name (make-string arg)))
+    #+sb-xc-host
+    (read-string-as-bytes *fasl-input-stream* package-name)
+    #-sb-xc-host
+    (#!-sb-unicode read-string-as-bytes
+     #!+sb-unicode read-string-as-unsigned-byte-32
+     *fasl-input-stream* package-name)
+    (push-fop-table (find-undeleted-package-or-lose package-name))))
 \f
 ;;;; fops for loading numbers
 
@@ -417,7 +427,8 @@
                            (dimensions () (cons (pop-stack) dimensions)))
                           ((zerop i) dimensions)
                         (declare (type index i)))
-                      nil)
+                      nil
+                      t)
     res))
 
 (define-fop (fop-single-float-vector 84)
@@ -639,6 +650,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))
@@ -650,7 +672,7 @@ bug.~:@>")
   #+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))
@@ -666,7 +688,7 @@ bug.~:@>")
       (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)