X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fx86-vm.lisp;h=73cb5ebbb76fe2f5f95e50616f4c93e9ff30519a;hb=bee53328c93be3433477821131ab805557476c8b;hp=9fb7a8096ad91ec8dfea529bda21b1408f2e8c65;hpb=ce02ab2ecd9c6ae2e570abd8c93ebf3be55bbdad;p=sbcl.git

diff --git a/src/code/x86-vm.lisp b/src/code/x86-vm.lisp
index 9fb7a80..73cb5eb 100644
--- 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*)