0.pre7.28:

[sbcl.git] / src / code / x86-vm.lisp

diff --git a/src/code/x86-vm.lisp b/src/code/x86-vm.lisp
index 9fb7a80..73cb5eb 100644 (file)
--- a/src/code/x86-vm.lisp
+++ b/src/code/x86-vm.lisp
@@ -60,30 +60,30 @@
 (defun fixup-code-object (code offset fixup kind)
   (declare (type index offset))
   (flet ((add-fixup (code offset)
-          ;; Although this could check for and ignore fixups for code
-          ;; objects in the read-only and static spaces, this should
-          ;; only be the case when *enable-dynamic-space-code* is
-          ;; True.
-          (when sb!impl::*enable-dynamic-space-code*
-            (incf *num-fixups*)
-            (let ((fixups (code-header-ref code code-constants-offset)))
-              (cond ((typep fixups '(simple-array (unsigned-byte 32) (*)))
-                     (let ((new-fixups
-                            (adjust-array fixups (1+ (length fixups))
-                                          :element-type '(unsigned-byte 32))))
-                       (setf (aref new-fixups (length fixups)) offset)
-                       (setf (code-header-ref code code-constants-offset)
-                             new-fixups)))
-                    (t
-                     (unless (or (eq (get-type fixups)
-                                     sb!vm:unbound-marker-type)
-                                 (zerop fixups))
-                       (format t "** Init. code FU = ~S~%" fixups)) ; FIXME
+          ;; (We check for and ignore fixups for code objects in the
+          ;; read-only and static spaces. (In the old CMU CL code
+          ;; this check was conditional on *ENABLE-DYNAMIC-SPACE-CODE*,
+          ;; but in SBCL relocatable dynamic space code is always in
+          ;; use, so we always do the check.)
+          (incf *num-fixups*)
+          (let ((fixups (code-header-ref code code-constants-offset)))
+            (cond ((typep fixups '(simple-array (unsigned-byte 32) (*)))
+                   (let ((new-fixups
+                          (adjust-array fixups (1+ (length fixups))
+                                        :element-type '(unsigned-byte 32))))
+                     (setf (aref new-fixups (length fixups)) offset)
                      (setf (code-header-ref code code-constants-offset)
-                           (make-specializable-array
-                            1
-                            :element-type '(unsigned-byte 32)
-                            :initial-element offset))))))))
+                           new-fixups)))
+                  (t
+                   (unless (or (eq (get-type fixups)
+                                   sb!vm:unbound-marker-type)
+                               (zerop fixups))
+                     (format t "** Init. code FU = ~S~%" fixups)) ; FIXME
+                   (setf (code-header-ref code code-constants-offset)
+                         (make-specializable-array
+                          1
+                          :element-type '(unsigned-byte 32)
+                          :initial-element offset)))))))
     (sb!sys:without-gcing
      (let* ((sap (truly-the system-area-pointer
                            (sb!kernel:code-instructions code)))
@@ -215,8 +215,8 @@
 (setf (deref (context-register-addr context index))
       new))
 
-;;; Like CONTEXT-REGISTER, but returns the value of a float register.
-;;; FORMAT is the type of float to return.
+;;; This is like CONTEXT-REGISTER, but returns the value of a float
+;;; register. FORMAT is the type of float to return.
 ;;;
 ;;; As of sbcl-0.6.7, there is no working code which calls this code,
 ;;; so it's stubbed out. Someday, in order to make the debugger work
@@ -237,6 +237,7 @@
   ;; POSIXness and (at the Lisp level) opaque signal contexts,
   ;; this is stubified. It needs to be rewritten as an
   ;; alien function.
+  (declare (ignore context)) ; stub!
   (warn "stub CONTEXT-FLOATING-POINT-MODES")
 
   ;; old code for Linux:
@@ -295,18 +296,17 @@
   (declare (ignore component))
   nil)
 
-;;; FLOAT-WAIT
-;;;
 ;;; This is used in error.lisp to insure that floating-point exceptions
 ;;; are properly trapped. The compiler translates this to a VOP.
 (defun float-wait ()
   (float-wait))
 
-;;; FLOAT CONSTANTS
+;;; float constants
 ;;;
-;;; These are used by the FP MOVE-FROM-{SINGLE|DOUBLE} VOPs rather than the
-;;; i387 load constant instructions to avoid consing in some cases. Note these
-;;; are initialized by GENESIS as they are needed early.
+;;; These are used by the FP MOVE-FROM-{SINGLE|DOUBLE} VOPs rather
+;;; than the i387 load constant instructions to avoid consing in some
+;;; cases. Note these are initialized by GENESIS as they are needed
+;;; early.
 (defvar *fp-constant-0s0*)
 (defvar *fp-constant-1s0*)
 (defvar *fp-constant-0d0*)
@@ -320,10 +320,6 @@
 (defvar *fp-constant-lg2*)
 (defvar *fp-constant-ln2*)
 
-;;; Enable/disable scavenging of the read-only space.
-(defvar *scavenge-read-only-space* nil)
-;;; FIXME: should be *SCAVENGE-READ-ONLY-SPACE-P*
-
 ;;; The current alien stack pointer; saved/restored for non-local exits.
 (defvar *alien-stack*)