X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fbackend.lisp;h=9e532ea69199faaa67185adfdea919108c4e4f10;hb=19319c931fc1636835dbef71808cc10e252bcf45;hp=ef13dc707e9f09f3ef2989d3c7bc07bd8ec4ba03;hpb=77360ee4a1f94c41b807be7ad0e8687199fceef1;p=sbcl.git diff --git a/src/compiler/backend.lisp b/src/compiler/backend.lisp index ef13dc7..9e532ea 100644 --- a/src/compiler/backend.lisp +++ b/src/compiler/backend.lisp @@ -23,28 +23,14 @@ ;;;; miscellaneous backend properties -;;; the conventional file extension for fasl files on this architecture, -;;; e.g. "x86f" -(defvar *backend-fasl-file-type* nil) -(declaim (type (or simple-string null) *backend-fasl-file-type*)) - -;;; implementation and version of fasl files used -(defvar *backend-fasl-file-implementation* nil) -(defvar *backend-fasl-file-version* nil) -(declaim (type (or keyword null) *backend-fasl-file-implementation*)) -(declaim (type (or index null) *backend-fasl-file-version*)) - -;;; the number of references that a TN must have to offset the overhead of -;;; saving the TN across a call +;;; the number of references that a TN must have to offset the +;;; overhead of saving the TN across a call (defvar *backend-register-save-penalty* 0) (declaim (type index *backend-register-save-penalty*)) ;;; the byte order of the target machine. :BIG-ENDIAN has the MSB first (e.g. ;;; IBM RT), :LITTLE-ENDIAN has the MSB last (e.g. DEC VAX). -;;; -;;; KLUDGE: In a sort of pun, this is also used as the value of -;;; BACKEND-BYTE-FASL-FILE-IMPLEMENTATION. -- WHN 20000302 -(defvar *backend-byte-order* nil) +(defvar *backend-byte-order*) (declaim (type (member nil :little-endian :big-endian) *backend-byte-order*)) ;;; translation from SC numbers to SC info structures. SC numbers are always @@ -74,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 @@ -116,28 +102,24 @@ ;;; The T primitive-type is kept in this variable so that people who ;;; have to special-case it can get at it conveniently. This variable ;;; has to be set by the machine-specific VM definition, since the -;;; DEF-PRIMITIVE-TYPE for T must specify the SCs that boxed objects +;;; !DEF-PRIMITIVE-TYPE for T must specify the SCs that boxed objects ;;; can be allocated in. (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*)) -;;; the backend-specific aspects of the info environment -(defvar *backend-info-environment* nil) -(declaim (type list *backend-info-environment*)) - ;;; support for the assembler (defvar *backend-instruction-formats* (make-hash-table :test 'eq)) (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 @@ -151,104 +133,100 @@ ;;; they haven't been installed yet (defvar *backend-internal-errors* nil) (declaim (type (or simple-vector null) *backend-internal-errors*)) - -;;; 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 - ,@(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*)) -;;;; utilities +;;;; 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 -(defun backend-byte-fasl-file-implementation () - *backend-byte-order*) - -(defun backend-byte-fasl-file-type () - (ecase *backend-byte-order* - (:big-endian "bytef") - (:little-endian "lbytef"))) + +;;;; 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: +;;; +;;; :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.