X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Fvm.lisp;h=3f41b89d03fdfba49bc05d2ad816ef1f45ccd12e;hb=b61003dec6f5af2b03549439155676666186283e;hp=7b482c48f17d840fafce1bd91149392dcef4802f;hpb=cab2c71bb1bb8a575d9eebdae335e731daa64183;p=sbcl.git diff --git a/src/compiler/ppc/vm.lisp b/src/compiler/ppc/vm.lisp index 7b482c4..3f41b89 100644 --- a/src/compiler/ppc/vm.lisp +++ b/src/compiler/ppc/vm.lisp @@ -10,7 +10,7 @@ (macrolet ((defreg (name offset) (let ((offset-sym (symbolicate name "-OFFSET"))) `(eval-when (:compile-toplevel :load-toplevel :execute) - (defconstant ,offset-sym ,offset) + (def!constant ,offset-sym ,offset) (setf (svref *register-names* ,offset-sym) ,(symbol-name name))))) (defregset (name &rest regs) @@ -31,8 +31,13 @@ (defreg nl6 9) (defreg fdefn 10) ; was nl7 (defreg nargs 11) - (defreg nfp 12) - (defreg cfunc 13) + ;; FIXME: some kind of comment here would be nice. + ;; + ;; FIXME II: this also reveals the need to autogenerate lispregs.h + #!+darwin (defreg cfunc 12) + #!-darwin (defreg nfp 12) + #!+darwin (defreg nfp 13) + #!-darwin (defreg cfunc 13) (defreg bsp 14) (defreg cfp 15) (defreg csp 16) @@ -86,7 +91,7 @@ "-SC-NUMBER")))) (list* `(define-storage-class ,sc-name ,index ,@(cdr class)) - `(defconstant ,constant-name ,index) + `(def!constant ,constant-name ,index) forms))) (index 0 (1+ index)) (classes classes (cdr classes))) @@ -95,7 +100,7 @@ ;; XXX this is most likely wrong. Check with Eric Marsden next time you ;; see him -(defconstant sb!vm::kludge-nondeterministic-catch-block-size 7) +(def!constant sb!vm::kludge-nondeterministic-catch-block-size 7) (define-storage-classes @@ -242,14 +247,9 @@ (defregtn cfp any-reg) (defregtn ocfp any-reg) (defregtn nsp any-reg)) - - -;;; Immediate-Constant-SC -- Interface -;;; -;;; If value can be represented as an immediate constant, then return the +;;; 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) (typecase value ((integer 0 0) @@ -262,32 +262,28 @@ (if (static-symbol-p value) (sc-number-or-lose 'immediate) nil)))) - -;;;; Function Call Parameters +;;;; function call parameters -;;; The SC numbers for register and stack arguments/return values. -;;; -(defconstant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg)) -(defconstant immediate-arg-scn (meta-sc-number-or-lose 'any-reg)) -(defconstant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack)) +;;; the SC numbers for register and stack arguments/return values +(def!constant register-arg-scn (meta-sc-number-or-lose 'descriptor-reg)) +(def!constant immediate-arg-scn (meta-sc-number-or-lose 'any-reg)) +(def!constant control-stack-arg-scn (meta-sc-number-or-lose 'control-stack)) (eval-when (:compile-toplevel :load-toplevel :execute) -;;; Offsets of special stack frame locations -(defconstant ocfp-save-offset 0) -(defconstant lra-save-offset 1) -(defconstant nfp-save-offset 2) +;;; offsets of special stack frame locations +(def!constant ocfp-save-offset 0) +(def!constant lra-save-offset 1) +(def!constant nfp-save-offset 2) -;;; The number of arguments/return values passed in registers. -;;; -(defconstant register-arg-count 4) +;;; the number of arguments/return values passed in registers +(def!constant register-arg-count 4) -;;; Names to use for the argument registers. -;;; +;;; names to use for the argument registers -); Eval-When (:compile-toplevel :load-toplevel :execute) +) ; EVAL-WHEN ;;; A list of TN's describing the register arguments. @@ -301,18 +297,11 @@ (export 'single-value-return-byte-offset) -;;; SINGLE-VALUE-RETURN-BYTE-OFFSET -;;; ;;; This is used by the debugger. -;;; -(defconstant single-value-return-byte-offset 8) - +(def!constant single-value-return-byte-offset 8) -;;; LOCATION-PRINT-NAME -- Interface -;;; -;;; This function is called by debug output routines that want a pretty name +;;; 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) (declare (type tn tn)) (let ((sb (sb-name (sc-sb (tn-sc tn)))) @@ -325,3 +314,13 @@ (non-descriptor-stack (format nil "NS~D" offset)) (constant (format nil "Const~D" offset)) (immediate-constant "Immed")))) + +;;; The loader uses this to convert alien names to the form they +;;; occur in the symbol table. This is ELF, so do nothing. + +(defun extern-alien-name (name) + (declare (type simple-base-string name)) + ;; Darwin is non-ELF, and needs a _ prefix + #!+darwin (concatenate 'string "_" name) + ;; The other (ELF) ports currently don't need any prefix + #!-darwin name)