X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fbackend.lisp;h=9e532ea69199faaa67185adfdea919108c4e4f10;hb=d306e2d23b38487488eb93881dad836e439e0c77;hp=01846185e54477b2f782eca1b03b376c1707348a;hpb=28d9bb7a509695caaf78d647b6aa1b0f02c0e83a;p=sbcl.git diff --git a/src/compiler/backend.lisp b/src/compiler/backend.lisp index 0184618..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,97 +133,52 @@ ;;; 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 (: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-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 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*)) +;;;; 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 + ;;;; This is a prototype interface to support Christophe Rhodes' new ;;;; (sbcl-0.pre7.57) VOP :GUARD clauses for implementations which @@ -246,9 +201,9 @@ SPARC code in CMUCL, (NOT (BACKEND-FEATUREP :SPARC-64))))) ...) -and at the IR2 translation stage, the function #'`(LAMBDA () ,GUARD) would be called. +and at the IR2 translation stage, the function #'`(LAMBDA () ,GUARD) would be called. -Until SBCL-0.7pre57, this is translated as +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 @@ -266,7 +221,8 @@ conditionalization. ;;; The default value of NIL means use only unguarded VOPs. The ;;; initial value is customizeable via ;;; customize-backend-subfeatures.lisp -(defvar *backend-subfeatures* '#.sb-cold:*shebang-backend-subfeatures*) +(defvar *backend-subfeatures* + '#.(sort (copy-list sb-cold:*shebang-backend-subfeatures*) #'string<)) ;;; possible *BACKEND-SUBFEATURES* values: ;;;