X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fgeneric%2Fgenesis.lisp;h=0e203131ea5a6ce5e2a5a9053f069a3a5027696f;hb=bcbbce86c47a1c530d488c7876a453100fcd933e;hp=b803202fb01538c183ed6763977602cb8036c12a;hpb=b05ccdd91520249de6b465e226d3708089e541dc;p=sbcl.git

diff --git a/src/compiler/generic/genesis.lisp b/src/compiler/generic/genesis.lisp
index b803202..0e20313 100644
--- a/src/compiler/generic/genesis.lisp
+++ b/src/compiler/generic/genesis.lisp
@@ -1008,8 +1008,8 @@
 (defvar *cold-package-symbols*)
 (declaim (type list *cold-package-symbols*))
 
-;;; a map from descriptors to symbols, so that we can back up. The key is the
-;;; address in the target core.
+;;; a map from descriptors to symbols, so that we can back up. The key
+;;; is the address in the target core.
 (defvar *cold-symbols*)
 (declaim (type hash-table *cold-symbols*))
 
@@ -1035,7 +1035,12 @@
   ;; need is SB!KERNEL:%BYTE-BLT.
   (let ((package-name (package-name package)))
     (cond ((find package-name '("COMMON-LISP" "KEYWORD") :test #'string=)
-	   ;; That's OK then.
+	   ;; Cold interning things in these standard packages is OK.
+	   ;; (Cold interning things in the other standard package,
+	   ;; CL-USER, isn't OK. We just use CL-USER to expose symbols
+	   ;; whose homes are in other packages. Thus, trying to cold
+	   ;; intern a symbol whose home package is CL-USER probably
+	   ;; means that a coding error has been made somewhere.)
 	   (values))
 	  ((string= package-name "SB!" :end1 3 :end2 3)
 	   ;; That looks OK, too. (All the target-code packages
@@ -1044,9 +1049,10 @@
 	  (t
 	   ;; looks bad: maybe COMMON-LISP-USER? maybe an extension
 	   ;; package in the xc host? something we can't think of
-	   ;; a valid reason to dump, anyway...
-	   (bug "internal error: PACKAGE-NAME=~S looks too much like a typo."
-		package-name))))
+	   ;; a valid reason to cold intern, anyway...
+	   (error ; not #'BUG, because #'BUG isn't defined yet
+	    "internal error: PACKAGE-NAME=~S looks too much like a typo."
+	    package-name))))
 
   (let (;; Information about each cold-interned symbol is stored
 	;; in COLD-INTERN-INFO.
@@ -1612,11 +1618,7 @@
       (:alpha
 	 (ecase kind
          (:jmp-hint
-          (assert (zerop (ldb (byte 2 0) value)))
-          #+nil ;; was commented out in cmucl source too.  Don't know what
-          ;; it does   -dan 2001.05.03
-	    (setf (sap-ref-16 sap 0)
-                (logior (sap-ref-16 sap 0) (ldb (byte 14 0) (ash value -2)))))
+          (assert (zerop (ldb (byte 2 0) value))))
 	 (:bits-63-48
 	  (let* ((value (if (logbitp 15 value) (+ value (ash 1 16)) value))
 		 (value (if (logbitp 31 value) (+ value (ash 1 32)) value))
@@ -1643,6 +1645,20 @@
                 (ldb (byte 8 0) value)
                 (byte-vector-ref-8 gspace-bytes (1+ gspace-byte-offset))
                 (ldb (byte 8 8) value)))))
+      (:ppc
+       (ecase kind
+         (:ba
+          (setf (byte-vector-ref-32 gspace-bytes gspace-byte-offset)
+                (dpb (ash value -2) (byte 24 2) 
+                     (byte-vector-ref-32 gspace-bytes gspace-byte-offset))))
+         (:ha
+          (let* ((h (ldb (byte 16 16) value))
+                 (l (ldb (byte 16 0) value)))
+            (setf (byte-vector-ref-16 gspace-bytes (+ gspace-byte-offset 2))
+                  (if (logbitp 15 l) (ldb (byte 16 0) (1+ h)) h))))
+         (:l
+          (setf (byte-vector-ref-16 gspace-bytes (+ gspace-byte-offset 2))
+                (ldb (byte 16 0) value)))))     
       (:sparc
        (ecase kind
 	 (:call
@@ -2654,6 +2670,18 @@
                   i)))))
   (terpri)
 
+  ;; FIXME: The SPARC has a PSEUDO-ATOMIC-TRAP that differs between
+  ;; platforms. If we export this from the SB!VM package, it gets
+  ;; written out as #define trap_PseudoAtomic, which is confusing as
+  ;; the runtime treats trap_ as the prefix for illegal instruction
+  ;; type things. We therefore don't export it, but instead do
+  (when (boundp 'sb!vm::pseudo-atomic-trap)
+    (format t "#define PSEUDO_ATOMIC_TRAP ~D /* 0x~:*~X */~%" sb!vm::pseudo-atomic-trap)
+    (terpri))
+  ;; possibly this is another candidate for a rename (to
+  ;; pseudo-atomic-trap-number or pseudo-atomic-magic-constant
+  ;; [possibly applicable to other platforms])
+
   ;; writing primitive object layouts
   (let ((structs (sort (copy-list sb!vm:*primitive-objects*) #'string<
 		       :key (lambda (obj)