X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fvm.lisp;h=377b196abcd70362540aa344f555327bc6c3f7a9;hb=77d94d36bcfd3d5eea73ad51e6ee621a8938f995;hp=83d0d3c84428a050853ee385ceaceb168dd967da;hpb=9cbb7f9b3a418314ffcd8f2cb0448278d2b6f812;p=sbcl.git diff --git a/src/compiler/x86/vm.lisp b/src/compiler/x86/vm.lisp index 83d0d3c..377b196 100644 --- a/src/compiler/x86/vm.lisp +++ b/src/compiler/x86/vm.lisp @@ -31,7 +31,7 @@ ;; 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)) + (def!constant ,offset-sym ,offset)) (setf (svref ,names-vector ,offset-sym) ,(symbol-name name))))) ;; FIXME: It looks to me as though DEFREGSET should also @@ -94,7 +94,7 @@ ;; registers used to pass arguments ;; ;; the number of arguments/return values passed in registers - (defconstant register-arg-count 3) + (def!constant register-arg-count 3) ;; names and offsets for registers used to pass arguments (eval-when (:compile-toplevel :load-toplevel :execute) (defparameter *register-arg-names* '(edx edi esi))) @@ -136,7 +136,7 @@ (constant-name (symbolicate sc-name "-SC-NUMBER"))) (forms `(define-storage-class ,sc-name ,index ,@(cdr class))) - (forms `(defconstant ,constant-name ,index)) + (forms `(def!constant ,constant-name ,index)) (incf index)))) `(progn ,@(forms)))) @@ -160,7 +160,7 @@ ;;; (What a KLUDGE! Anyone who wants to come in and clean up this mess ;;; has my gratitude.) (FIXME: Maybe this should be me..) (eval-when (:compile-toplevel :load-toplevel :execute) - (defconstant kludge-nondeterministic-catch-block-size 6)) + (def!constant kludge-nondeterministic-catch-block-size 6)) (!define-storage-classes @@ -182,7 +182,7 @@ ;; the non-descriptor stacks (signed-stack stack) ; (signed-byte 32) (unsigned-stack stack) ; (unsigned-byte 32) - (base-char-stack stack) ; non-descriptor characters. + (character-stack stack) ; non-descriptor characters. (sap-stack stack) ; System area pointers. (single-stack stack) ; single-floats (double-stack stack :element-size 2) ; double-floats. @@ -228,12 +228,14 @@ :alternate-scs (control-stack)) ;; non-descriptor characters - (base-char-reg registers - :locations #.*byte-regs* + (character-reg registers + :locations #!-sb-unicode #.*byte-regs* + #!+sb-unicode #.*dword-regs* + #!-sb-unicode #!-sb-unicode :reserve-locations (#.ah-offset #.al-offset) :constant-scs (immediate) :save-p t - :alternate-scs (base-char-stack)) + :alternate-scs (character-stack)) ;; non-descriptor SAPs (arbitrary pointers into address space) (sap-reg registers @@ -322,11 +324,13 @@ (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)) +(defparameter *byte-sc-names* + '(#!-sb-unicode character-reg byte-reg #!-sb-unicode character-stack)) (defparameter *word-sc-names* '(word-reg)) (defparameter *dword-sc-names* '(any-reg descriptor-reg sap-reg signed-reg unsigned-reg control-stack - signed-stack unsigned-stack sap-stack single-stack constant)) + signed-stack unsigned-stack sap-stack single-stack + #!+sb-unicode character-reg #!+sb-unicode character-stack constant)) ;;; added by jrd. I guess the right thing to do is to treat floats ;;; as a separate size... ;;; @@ -376,7 +380,8 @@ ;;; the appropriate SC number, otherwise return NIL. (!def-vm-support-routine immediate-constant-sc (value) (typecase value - ((or fixnum #-sb-xc-host system-area-pointer character) + ((or (integer #.sb!xc:most-negative-fixnum #.sb!xc:most-positive-fixnum) + #-sb-xc-host system-area-pointer character) (sc-number-or-lose 'immediate)) (symbol (when (static-symbol-p value) @@ -400,22 +405,22 @@ ;;;; miscellaneous function call parameters ;;; offsets of special stack frame locations -(defconstant ocfp-save-offset 0) -(defconstant return-pc-save-offset 1) -(defconstant code-save-offset 2) +(def!constant ocfp-save-offset 0) +(def!constant return-pc-save-offset 1) +(def!constant code-save-offset 2) ;;; FIXME: This is a bad comment (changed since when?) and there are others ;;; like it in this file. It'd be nice to clarify them. Failing that deleting ;;; them or flagging them with KLUDGE might be better than nothing. ;;; ;;; names of these things seem to have changed. these aliases by jrd -(defconstant lra-save-offset return-pc-save-offset) +(def!constant lra-save-offset return-pc-save-offset) -(defconstant cfp-offset ebp-offset) ; pfw - needed by stuff in /code +(def!constant cfp-offset ebp-offset) ; pfw - needed by stuff in /code ; related to signal context stuff ;;; This is used by the debugger. -(defconstant single-value-return-byte-offset 2) +(def!constant 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. @@ -449,8 +454,10 @@ ;;; The loader uses this to convert alien names to the form they need in ;;; the symbol table (for example, prepending an underscore). (defun extern-alien-name (name) - (declare (type simple-string name)) - ;; OpenBSD is non-ELF, and needs a _ prefix - #!+openbsd (concatenate 'string "_" name) - ;; The other (ELF) ports currently don't need any prefix - #!-openbsd name) + (declare (type string name)) + ;; ELF ports currently don't need any prefix + (typecase name + (simple-base-string name) + (base-string (coerce name 'simple-base-string)) + (t (handler-case (coerce name 'simple-base-string) + (type-error () (error "invalid external alien name: ~S" name))))))