X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fbackend.lisp;h=9e532ea69199faaa67185adfdea919108c4e4f10;hb=54da325f13fb41669869aea688ae195426c0e231;hp=e843d695fbbc51a49ca18a44c27484f250039cfd;hpb=3c65762b927af861c9c8bc416e4cbac9a14ec0c3;p=sbcl.git diff --git a/src/compiler/backend.lisp b/src/compiler/backend.lisp index e843d69..9e532ea 100644 --- a/src/compiler/backend.lisp +++ b/src/compiler/backend.lisp @@ -60,10 +60,10 @@ (defvar *backend-meta-sc-names* (make-hash-table :test 'eq)) (defvar *backend-meta-sb-names* (make-hash-table :test 'eq)) (declaim (type hash-table - *backend-sc-names* - *backend-sb-names* - *backend-meta-sc-names* - *backend-meta-sb-names*)) + *backend-sc-names* + *backend-sb-names* + *backend-meta-sc-names* + *backend-meta-sb-names*)) ;;; like *SC-NUMBERS*, but updated at meta-compile time @@ -107,7 +107,7 @@ (defvar *backend-t-primitive-type*) (declaim (type primitive-type *backend-t-primitive-type*)) -;;; a hashtable translating from VOP names to the corresponding VOP-Parse +;;; a hashtable translating from VOP names to the corresponding VOP-PARSE ;;; structures. This information is only used at meta-compile time. (defvar *backend-parsed-vops* (make-hash-table :test 'eq)) (declaim (type hash-table *backend-parsed-vops*)) @@ -117,9 +117,9 @@ (defvar *backend-instruction-flavors* (make-hash-table :test 'equal)) (defvar *backend-special-arg-types* (make-hash-table :test 'eq)) (declaim (type hash-table - *backend-instruction-formats* - *backend-instruction-flavors* - *backend-special-arg-types*)) + *backend-instruction-formats* + *backend-instruction-flavors* + *backend-special-arg-types*)) ;;; mappings between CTYPE structures and the corresponding predicate. ;;; The type->predicate mapping is implemented as an alist because @@ -133,103 +133,100 @@ ;;; they haven't been installed yet (defvar *backend-internal-errors* nil) (declaim (type (or simple-vector null) *backend-internal-errors*)) + +;;;; VM support routines which backends need to implement + +;;; from vm.lisp +;;; immediate-constant-sc +;;; location-print-name +;;; combination-implementation-style +;;; convert-conditional-move-p +;;; boxed-immediate-sc-p + +;;; from primtype.lisp +;;; primitive-type-of +;;; primitive-type + +;;; from c-call.lisp +;;; make-call-out-tns + +;;; from call.lisp +;;; standard-arg-location +;;; make-return-pc-passing-location +;;; make-old-fp-passing-location +;;; make-old-fp-save-location +;;; make-return-pc-save-location +;;; make-arg-count-location +;;; make-nfp-tn +;;; make-stack-pointer-tn +;;; make-number-stack-pointer-tn +;;; make-unknown-values-locations +;;; select-component-format + +;;; from nlx.lisp +;;; make-nlx-sp-tn +;;; make-dynamic-state-tns +;;; make-nlx-entry-arg-start-location + +;;; from pred.lisp +;;; convert-conditional-move-p + +;;; from support.lisp +;;; generate-call-sequence +;;; generate-return-sequence + +;;; for use with scheduler +;;; emit-nop +;;; location-number -;;; the maximum number of bytes per page on this system (used by GENESIS) -(defvar *backend-page-size* 0) -(declaim (type index *backend-page-size*)) -;;;; VM support routines - -;;; FIXME: Do we need this kind of indirection for the VM support -;;; routines any more? - -;;; forward declaration -(defvar *backend-support-routines*) - -(macrolet ((def-vm-support-routines (&rest routines) - `(progn - (eval-when (:compile-toplevel :load-toplevel :execute) - (defparameter *vm-support-routines* ',routines)) - (defstruct (vm-support-routines (:copier nil)) - ,@(mapcar #'(lambda (routine) - `(,routine nil :type (or function null))) - routines)) - ,@(mapcar - #'(lambda (name) - `(defun ,name (&rest args) - (apply (or (,(symbolicate "VM-SUPPORT-ROUTINES-" - name) - *backend-support-routines*) - (error "machine-specific support ~S ~ - routine undefined" - ',name)) - args))) - routines)))) - - (def-vm-support-routines - - ;; from vm.lisp - immediate-constant-sc - location-print-name - - ;; from primtype.lisp - primitive-type-of - primitive-type - - ;; from c-call.lisp - make-call-out-tns - - ;; from call.lisp - standard-argument-location - make-return-pc-passing-location - make-old-fp-passing-location - make-old-fp-save-location - make-return-pc-save-location - make-argument-count-location - make-nfp-tn - make-stack-pointer-tn - make-number-stack-pointer-tn - make-unknown-values-locations - select-component-format - - ;; from nlx.lisp - make-nlx-sp-tn - make-dynamic-state-tns - make-nlx-entry-argument-start-location - - ;; from support.lisp - generate-call-sequence - generate-return-sequence - - ;; for use with scheduler - emit-nop - location-number)) - -(defprinter (vm-support-routines)) - -(defmacro !def-vm-support-routine (name ll &body body) - (unless (member (intern (string name) (find-package "SB!C")) - *vm-support-routines*) - (warn "unknown VM support routine: ~A" name)) - (let ((local-name (symbolicate "IMPL-OF-VM-SUPPORT-ROUTINE-" name))) - `(progn - (defun ,local-name ,ll ,@body) - (setf (,(intern (concatenate 'simple-string - "VM-SUPPORT-ROUTINES-" - (string name)) - (find-package "SB!C")) - *backend-support-routines*) - #',local-name)))) - -;;; the VM support routines -(defvar *backend-support-routines* (make-vm-support-routines)) -(declaim (type vm-support-routines *backend-support-routines*)) - -;;; This is a prototype interface to support Christophe Rhodes' new -;;; (sbcl-0.pre7.57) VOP :GUARD clauses for implementations which -;;; depend on CPU variants, e.g. the differences between I486, -;;; Pentium, and Pentium Pro, or the differences between different -;;; SPARC versions. +;;;; This is a prototype interface to support Christophe Rhodes' new +;;;; (sbcl-0.pre7.57) VOP :GUARD clauses for implementations which +;;;; depend on CPU variants, e.g. the differences between I486, +;;;; Pentium, and Pentium Pro, or the differences between different +;;;; SPARC versions. + +;;;; Christophe Rhodes' longer explanation (cut and pasted +;;;; from CLiki SBCL internals site 2001-10-12): +#| +In CMUCL, the :guard argument to VOPs provided a way of disallowing +the use of a particular VOP in compiled code. As an example, from the +SPARC code in CMUCL, + +(DEFINE-VOP? (FAST-V8-TRUNCATE/SIGNED=>SIGNED? FAST-SAFE-ARITH-OP?) + (:TRANSLATE TRUNCATE?) + ... + (:GUARD (OR (BACKEND-FEATUREP :SPARC-V8) + (AND (BACKEND-FEATUREP :SPARC-V9) + (NOT (BACKEND-FEATUREP :SPARC-64))))) + ...) + +and at the IR2 translation stage, the function #'`(LAMBDA () ,GUARD) would be called. + +Until SBCL-0.7pre57, this is translated as + (:GUARD #!+(OR :SPARC-V8 (AND :SPARC-V9 (NOT :SPARC-64))) T + #!-(OR :SPARC-V8 (AND :SPARC-V9 (NOT :SPARC-64))) NIL) +which means that whether this VOP will ever be used is determined at +compiler compile-time depending on the contents of +*SHEBANG-FEATURES*?. + +As of SBCL-0.7pre57, a new special variable, +SB-C:*BACKEND-SUBFEATURES*?, is introduced. As of that version, only +VOPs translating %log1p? query it, and :PENTIUM-STYLE-FYL2XP1 is the +only useful value to be pushed onto that list, for x86. This is not +yet an ideal interface, but it does allow for compile-time +conditionalization. +|# + +;;; The default value of NIL means use only unguarded VOPs. The +;;; initial value is customizeable via +;;; customize-backend-subfeatures.lisp +(defvar *backend-subfeatures* + '#.(sort (copy-list sb-cold:*shebang-backend-subfeatures*) #'string<)) + +;;; possible *BACKEND-SUBFEATURES* values: ;;; -;;; The default value of NIL means use only unguarded VOPs. -(defvar *backend-subfeatures* nil) +;;; :PENTIUM-STYLE-FYL2XP1 is a useful value for x86 SBCLs to have on +;;; SB-C:*BACKEND-SUBFEATURES*?; it enables the use of the +;;; %flog1p-pentium? VOP rather than the %flog1p? VOP, which is a few +;;; instructions longer.