X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fx86%2Fvm.lisp;h=92f537da989593148e375ef0c28c0bb7654af41b;hb=bc46c8bcdd6ac8918df8ea9e9db49808e4924fcf;hp=8f0965102ad3f5a0718778fbc1e9de035b5c61a7;hpb=2716573f357f204c5f546d1d34d285dd24ff43a1;p=sbcl.git

diff --git a/src/compiler/x86/vm.lisp b/src/compiler/x86/vm.lisp
index 8f09651..92f537d 100644
--- a/src/compiler/x86/vm.lisp
+++ b/src/compiler/x86/vm.lisp
@@ -13,10 +13,7 @@
 
 ;;; the size of an INTEGER representation of a SYSTEM-AREA-POINTER, i.e.
 ;;; size of a native memory address
-(deftype sap-int-type () '(unsigned-byte 32))
-;;; FIXME: This should just named be SAP-INT, not SAP-INT-TYPE. And
-;;; grep for SAPINT in the code and replace it with SAP-INT as
-;;; appropriate.
+(deftype sap-int () '(unsigned-byte 32))
 
 ;;;; register specs
 
@@ -30,7 +27,11 @@
 	     (let ((offset-sym (symbolicate name "-OFFSET"))
 		   (names-vector (symbolicate "*" size "-REGISTER-NAMES*")))
 	       `(progn
-		  (defconstant ,offset-sym ,offset)
+		  (eval-when (:compile-toplevel :load-toplevel :execute)
+                    ;; EVAL-WHEN is necessary because stuff like #.EAX-OFFSET
+                    ;; (in the same file) depends on compile-time evaluation
+                    ;; of the DEFCONSTANT. -- AL 20010224
+		    (defconstant ,offset-sym ,offset))
 		  (setf (svref ,names-vector ,offset-sym)
 			,(symbol-name name)))))
 	   ;; FIXME: It looks to me as though DEFREGSET should also
@@ -127,8 +128,7 @@
 ;;; a handy macro so we don't have to keep changing all the numbers whenever
 ;;; we insert a new storage class
 ;;;
-;;; FIXME: This macro is not needed in the runtime target.
-(defmacro define-storage-classes (&rest classes)
+(defmacro !define-storage-classes (&rest classes)
   (collect ((forms))
     (let ((index 0))
       (dolist (class classes)
@@ -137,8 +137,6 @@
 	  (forms `(define-storage-class ,sc-name ,index
 		    ,@(cdr class)))
 	  (forms `(defconstant ,constant-name ,index))
-	  (forms `(let ((sb!int::*rogue-export* "DEFINE-STORAGE-CLASSES"))
-		    (export ',constant-name)))
 	  (incf index))))
     `(progn
        ,@(forms))))
@@ -161,11 +159,12 @@
 ;;;
 ;;; (What a KLUDGE! Anyone who wants to come in and clean up this mess
 ;;; has my gratitude.) (FIXME: Maybe this should be me..)
-(defconstant sb!vm::kludge-nondeterministic-catch-block-size 6)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defconstant kludge-nondeterministic-catch-block-size 6))
 
-(define-storage-classes
+(!define-storage-classes
 
-  ;; non-immediate contstants in the constant pool
+  ;; non-immediate constants in the constant pool
   (constant constant)
 
   ;; some FP constants can be generated in the i387 silicon
@@ -320,8 +319,7 @@
 		    :alternate-scs (complex-long-stack))
 
   ;; a catch or unwind block
-  (catch-block stack
-	       :element-size sb!vm::kludge-nondeterministic-catch-block-size))
+  (catch-block stack :element-size kludge-nondeterministic-catch-block-size))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
 (defparameter *byte-sc-names* '(base-char-reg byte-reg base-char-stack))
@@ -374,11 +372,9 @@
 		  :offset 31))		; Offset doesn't get used.
 |#
 
-;;; IMMEDIATE-CONSTANT-SC
-;;;
 ;;; If value can be represented as an immediate constant, then return
 ;;; the appropriate SC number, otherwise return NIL.
-(def-vm-support-routine immediate-constant-sc (value)
+(!def-vm-support-routine immediate-constant-sc (value)
   (typecase value
     ((or fixnum #-sb-xc-host system-area-pointer character)
      (sc-number-or-lose 'immediate))
@@ -418,14 +414,12 @@
 (defconstant cfp-offset ebp-offset)	; pfw - needed by stuff in /code
 					; related to signal context stuff
 
-;;; SINGLE-VALUE-RETURN-BYTE-OFFSET
-;;;
 ;;; This is used by the debugger.
 (defconstant single-value-return-byte-offset 2)
 
 ;;; This function is called by debug output routines that want a pretty name
 ;;; for a TN's location. It returns a thing that can be printed with PRINC.
-(def-vm-support-routine location-print-name (tn)
+(!def-vm-support-routine location-print-name (tn)
   (declare (type tn tn))
   (let* ((sc (tn-sc tn))
 	 (sb (sb-name (sc-sb sc)))
@@ -443,7 +437,7 @@
 		  (< -1 offset (length name-vec))
 		  (svref name-vec offset))
 	     ;; FIXME: Shouldn't this be an ERROR?
-	     (format nil "<unknown reg: off=~D, sc=~A>" offset sc-name))))
+	     (format nil "<unknown reg: off=~W, sc=~A>" offset sc-name))))
       (float-registers (format nil "FR~D" offset))
       (stack (format nil "S~D" offset))
       (constant (format nil "Const~D" offset))
@@ -455,4 +449,5 @@
 ;;; the symbol table (for example, prepending an underscore).
 (defun extern-alien-name (name)
   (declare (type simple-string name))
+  ;; On the X86 we don't do anything.
   name)