X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fvm.lisp;h=84570297785d3f5623db3618c664317cec8b960e;hb=b767eae48831153473226b985511c8f7a3ef98c5;hp=8f0965102ad3f5a0718778fbc1e9de035b5c61a7;hpb=2716573f357f204c5f546d1d34d285dd24ff43a1;p=sbcl.git diff --git a/src/compiler/x86/vm.lisp b/src/compiler/x86/vm.lisp index 8f09651..8457029 100644 --- a/src/compiler/x86/vm.lisp +++ b/src/compiler/x86/vm.lisp @@ -30,7 +30,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 @@ -137,8 +141,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,7 +163,8 @@ ;;; ;;; (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 @@ -320,8 +323,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 +376,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 +418,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 +441,7 @@ (< -1 offset (length name-vec)) (svref name-vec offset)) ;; FIXME: Shouldn't this be an ERROR? - (format nil "" offset sc-name)))) + (format nil "" offset sc-name)))) (float-registers (format nil "FR~D" offset)) (stack (format nil "S~D" offset)) (constant (format nil "Const~D" offset)) @@ -455,4 +453,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)