X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1tran.lisp;h=7ee6bddd1b98152671a63fa8143b348177e0d23f;hb=0a82f2db352cc348d2107a882e50af222ff97ed3;hp=271931dd7bc20ac516c3171fee553c3173e09970;hpb=5e3fb5149366dd84a5cb76bf1cf5f2324c24ca57;p=sbcl.git diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 271931d..7ee6bdd 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -18,12 +18,12 @@ ;;; taken through the source to reach the form. This provides a way to ;;; keep track of the location of original source forms, even when ;;; macroexpansions and other arbitary permutations of the code -;;; happen. This table is initialized by calling Find-Source-Paths on +;;; happen. This table is initialized by calling FIND-SOURCE-PATHS on ;;; the original source. (declaim (hash-table *source-paths*)) (defvar *source-paths*) -;;; *CURRENT-COMPONENT* is the Component structure which we link +;;; *CURRENT-COMPONENT* is the COMPONENT structure which we link ;;; blocks into as we generate them. This just serves to glue the ;;; emitted blocks together until local call analysis and flow graph ;;; canonicalization figure out what is really going on. We need to @@ -40,13 +40,7 @@ ;;; *CURRENT-PATH* is the source path of the form we are currently ;;; translating. See NODE-SOURCE-PATH in the NODE structure. (declaim (list *current-path*)) -(defvar *current-path* nil) - -;;; *CONVERTING-FOR-INTERPRETER* is true when we are creating IR1 to -;;; be interpreted rather than compiled. This inhibits source -;;; tranformations and stuff. -(defvar *converting-for-interpreter* nil) -;;; FIXME: Rename to *IR1-FOR-INTERPRETER-NOT-COMPILER-P*. +(defvar *current-path*) (defvar *derive-function-types* nil "Should the compiler assume that function types will never change, @@ -88,8 +82,9 @@ (let* ((info (layout-info (or (info :type :compiler-layout (sb!xc:class-name class)) (class-layout class)))) - (accessor (if (listp name) (cadr name) name)) - (slot (find accessor (dd-slots info) :key #'sb!kernel:dsd-accessor)) + (accessor-name (if (listp name) (cadr name) name)) + (slot (find accessor-name (dd-slots info) + :key #'sb!kernel:dsd-accessor-name)) (type (dd-name info)) (slot-type (dsd-type slot))) (unless slot @@ -122,9 +117,9 @@ name context)) ((:function nil) - (check-function-name name) + (check-fun-name name) (note-if-setf-function-and-macro name) - (let ((expansion (info :function :inline-expansion name)) + (let ((expansion (fun-name-inline-expansion name)) (inlinep (info :function :inlinep name))) (setf (gethash name *free-functions*) (if (or expansion inlinep) @@ -177,21 +172,21 @@ (where-from (info :variable :where-from name))) (when (and (eq where-from :assumed) (eq kind :global)) (note-undefined-reference name :variable)) - (setf (gethash name *free-variables*) - (if (eq kind :alien) - (info :variable :alien-info name) - (multiple-value-bind (val valp) - (info :variable :constant-value name) - (if (and (eq kind :constant) valp) - (make-constant :value val - :name name - :type (ctype-of val) - :where-from where-from) - (make-global-var :kind kind - :name name - :type type - :where-from where-from)))))))) + (case kind + (:alien + (info :variable :alien-info name)) + (:constant + (let ((value (info :variable :constant-value name))) + (make-constant :value value + :name name + :type (ctype-of value) + :where-from where-from))) + (t + (make-global-var :kind kind + :name name + :type type + :where-from where-from))))))) ;;; Grovel over CONSTANT checking for any sub-parts that need to be ;;; processed with MAKE-LOAD-FORM. We have to be careful, because @@ -330,11 +325,11 @@ ;;; This function takes a form and the top-level form number for that ;;; form, and returns a lambda representing the translation of that -;;; form in the current global environment. The lambda is top-level -;;; lambda that can be called to cause evaluation of the forms. This -;;; lambda is in the initial component. If FOR-VALUE is T, then the -;;; value of the form is returned from the function, otherwise NIL is -;;; returned. +;;; form in the current global environment. The returned lambda is a +;;; top-level lambda that can be called to cause evaluation of the +;;; forms. This lambda is in the initial component. If FOR-VALUE is T, +;;; then the value of the form is returned from the function, +;;; otherwise NIL is returned. ;;; ;;; This function may have arbitrary effects on the global environment ;;; due to processing of PROCLAIMs and EVAL-WHENs. All syntax error @@ -369,7 +364,8 @@ ;;; *CURRENT-FORM-NUMBER* is used in FIND-SOURCE-PATHS to compute the ;;; form number to associate with a source path. This should be bound -;;; to 0 around the processing of each truly top-level form. +;;; to an initial value of 0 before the processing of each truly +;;; top-level form. (declaim (type index *current-form-number*)) (defvar *current-form-number*) @@ -505,7 +501,7 @@ (pushnew fun (component-reanalyze-functions *current-component*))) fun) -;;; Generate a Ref node for LEAF, frobbing the LEAF structure as +;;; Generate a REF node for LEAF, frobbing the LEAF structure as ;;; needed. If LEAF represents a defined function which has already ;;; been converted, and is not :NOTINLINE, then reference the ;;; functional instead. @@ -555,8 +551,9 @@ (translator (info :function :ir1-convert fun)) (cmacro (info :function :compiler-macro-function fun))) (cond (translator (funcall translator start cont form)) - ((and cmacro (not *converting-for-interpreter*) - (not (eq (info :function :inlinep fun) :notinline))) + ((and cmacro + (not (eq (info :function :inlinep fun) + :notinline))) (let ((res (careful-expand-macro cmacro form))) (if (eq res form) (ir1-convert-global-functoid-no-cmacro start cont form fun) @@ -585,7 +582,8 @@ (muffle-warning) (error "internal error -- no MUFFLE-WARNING restart")) -;;; Trap errors during the macroexpansion. +;;; Expand FORM using the macro whose MACRO-FUNCTION is FUN, trapping +;;; errors which occur during the macroexpansion. (defun careful-expand-macro (fun form) (handler-bind (;; When cross-compiling, we can get style warnings ;; about e.g. undefined functions. An unhandled @@ -701,32 +699,26 @@ ;;; Convert a call to a global function. If not :NOTINLINE, then we do ;;; source transforms and try out any inline expansion. If there is no -;;; expansion, but is :INLINE, then give an efficiency note (unless a known -;;; function which will quite possibly be open-coded.) Next, we go to -;;; ok-combination conversion. +;;; expansion, but is :INLINE, then give an efficiency note (unless a +;;; known function which will quite possibly be open-coded.) Next, we +;;; go to ok-combination conversion. (defun ir1-convert-srctran (start cont var form) (declare (type continuation start cont) (type global-var var)) (let ((inlinep (when (defined-function-p var) (defined-function-inlinep var)))) - (cond - ((eq inlinep :notinline) - (ir1-convert-combination start cont form var)) - (*converting-for-interpreter* - (ir1-convert-combination-checking-type start cont form var)) - (t - (let ((transform (info :function :source-transform (leaf-name var)))) - (cond - (transform - (multiple-value-bind (result pass) (funcall transform form) - (if pass - (ir1-convert-maybe-predicate start cont form var) - (ir1-convert start cont result)))) - (t - (ir1-convert-maybe-predicate start cont form var)))))))) - -;;; If the function has the Predicate attribute, and the CONT's DEST isn't -;;; an IF, then we convert (IF