X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Fvm.lisp;h=1a0333bce7c910a447b8ac906a50412f3f943fc2;hb=619ee68faffc3990c5108611762ef54bf8cbbd1e;hp=7b482c48f17d840fafce1bd91149392dcef4802f;hpb=cab2c71bb1bb8a575d9eebdae335e731daa64183;p=sbcl.git diff --git a/src/compiler/ppc/vm.lisp b/src/compiler/ppc/vm.lisp index 7b482c4..1a0333b 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) @@ -86,7 +86,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 +95,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 +242,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 +257,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 +292,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 +309,10 @@ (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)) + name)