X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fbackend.lisp;h=906e8373b8d6c722b2915dc0d33bf38591ebab87;hb=ee2d3451514e7b4fa7af68511a22a153b879c8cd;hp=cf140b1e644a7f241560dda3e86bf5fbfff258ac;hpb=581e3d62de8cb37e13ad9db63e5537c0f962be28;p=sbcl.git diff --git a/src/compiler/backend.lisp b/src/compiler/backend.lisp index cf140b1..906e837 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 @@ -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,10 +133,6 @@ ;;; 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 @@ -147,30 +143,31 @@ (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)))) + `(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 + combination-implementation-style ;; from primtype.lisp primitive-type-of @@ -197,6 +194,9 @@ 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 @@ -209,17 +209,17 @@ (defmacro !def-vm-support-routine (name ll &body body) (unless (member (intern (string name) (find-package "SB!C")) - *vm-support-routines*) + *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)))) + "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)) @@ -246,9 +246,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