X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Fvm.lisp;h=dbc2fa39ccea58b048fd8039d44f954b09612938;hb=b63c4fb9b98fa8188e17ba926e150ba417a74635;hp=6e20e088533848f3ed64c21f4602e17e8b28d416;hpb=8731c1a7c1a585d190151fa881050fb5e14c0616;p=sbcl.git diff --git a/src/compiler/ppc/vm.lisp b/src/compiler/ppc/vm.lisp index 6e20e08..dbc2fa3 100644 --- a/src/compiler/ppc/vm.lisp +++ b/src/compiler/ppc/vm.lisp @@ -1,6 +1,26 @@ -;;; +;;;; miscellaneous VM definition noise for the PPC + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + (in-package "SB!VM") +;;; NUMBER-STACK-DISPLACEMENT +;;; +;;; The number of bytes reserved above the number stack pointer. These +;;; slots are required by architecture, mostly (?) to make C backtrace +;;; work. This must be a power of 2 - see BYTES-REQUIRED-FOR-NUMBER-STACK. +;;; +(def!constant number-stack-displacement + (* #!-darwin 2 + #!+darwin 8 + n-word-bytes)) ;;;; Define the registers @@ -31,8 +51,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) @@ -93,9 +118,7 @@ ((null classes) (nreverse forms)))) -;; XXX this is most likely wrong. Check with Eric Marsden next time you -;; see him -(def!constant sb!vm::kludge-nondeterministic-catch-block-size 7) +(def!constant kludge-nondeterministic-catch-block-size 7) (define-storage-classes @@ -118,7 +141,7 @@ ;; The non-descriptor stacks. (signed-stack non-descriptor-stack) ; (signed-byte 32) (unsigned-stack non-descriptor-stack) ; (unsigned-byte 32) - (base-char-stack non-descriptor-stack) ; non-descriptor characters. + (character-stack non-descriptor-stack) ; non-descriptor characters. (sap-stack non-descriptor-stack) ; System area pointers. (single-stack non-descriptor-stack) ; single-floats (double-stack non-descriptor-stack @@ -146,11 +169,11 @@ :alternate-scs (control-stack)) ;; Non-Descriptor characters - (base-char-reg registers + (character-reg registers :locations #.non-descriptor-regs :constant-scs (immediate) :save-p t - :alternate-scs (base-char-stack)) + :alternate-scs (character-stack)) ;; Non-Descriptor SAP's (arbitrary pointers into address space) (sap-reg registers @@ -216,9 +239,7 @@ ;; A catch or unwind block. (catch-block control-stack - :element-size sb!vm::kludge-nondeterministic-catch-block-size)) - - + :element-size kludge-nondeterministic-catch-block-size)) ;;;; Make some random tns for important registers. @@ -242,14 +263,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 +278,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. -;;; +;;; 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 +;;; 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. -;;; +;;; 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 +313,11 @@ (export 'single-value-return-byte-offset) -;;; SINGLE-VALUE-RETURN-BYTE-OFFSET -;;; ;;; This is used by the debugger. -;;; (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 +330,21 @@ (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. + +(defun extern-alien-name (name) + (declare (type string name)) + ;; Darwin is non-ELF, and needs a _ prefix. The other (ELF) ports + ;; currently don't need any prefix. + (flet ((maybe-prefix (name) + #!+darwin (concatenate 'simple-base-string "_" name) + #!-darwin name)) + (typecase name + (simple-base-string (maybe-prefix name)) + (base-string (coerce (maybe-prefix name) 'simple-base-string)) + (t + (handler-case (coerce (maybe-prefix name) 'simple-base-string) + (type-error () + (error "invalid external alien name: ~S" name)))))))