X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fbackend.lisp;h=8b9abe1dc586bcd95a2414da88e008e3ab52edaf;hb=80304981972c91c1b3f3fca75f36dacf1fecf307;hp=ef13dc707e9f09f3ef2989d3c7bc07bd8ec4ba03;hpb=77360ee4a1f94c41b807be7ad0e8687199fceef1;p=sbcl.git diff --git a/src/compiler/backend.lisp b/src/compiler/backend.lisp index ef13dc7..8b9abe1 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 @@ -116,7 +102,7 @@ ;;; 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*)) @@ -126,10 +112,6 @@ (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)) @@ -168,20 +150,20 @@ `(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))) + (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 ~ + (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))) + ',name)) + args))) routines)))) (def-vm-support-routines @@ -203,7 +185,7 @@ make-old-fp-passing-location make-old-fp-save-location make-return-pc-save-location - make-argument-count-location + make-arg-count-location make-nfp-tn make-stack-pointer-tn make-number-stack-pointer-tn @@ -243,12 +225,50 @@ (defvar *backend-support-routines* (make-vm-support-routines)) (declaim (type vm-support-routines *backend-support-routines*)) -;;;; utilities - -(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. +(defvar *backend-subfeatures* nil) + +;;; 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.