X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=inline;f=src%2Fcompiler%2Fir1tran.lisp;h=690fc9ecc52eae95fe6f652589f332febca38770;hb=012fbee7176df4472ef4add1a7df558d762bc4f6;hp=6c6cbe771671c429448c144e0c2dbfe811abfbee;hpb=31361af9eb64344f521abbb245ea784c76c746e5;p=sbcl.git diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 6c6cbe7..690fc9e 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,31 +117,19 @@ 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) - (make-defined-function + (make-defined-fun :name name :inline-expansion expansion :inlinep inlinep :where-from (info :function :where-from name) :type (info :function :type name)) - (let ((info (info :function :accessor-for name))) - (etypecase info - (null - (find-free-really-function name)) - (sb!xc:structure-class - (find-structure-slot-accessor info name)) - (sb!xc:class - (if (typep (layout-info (info :type :compiler-layout - (sb!xc:class-name - info))) - 'defstruct-description) - (find-structure-slot-accessor info name) - (find-free-really-function name)))))))))))) + (find-free-really-function name)))))))) ;;; Return the LEAF structure for the lexically apparent function ;;; definition of NAME. @@ -177,21 +160,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 +313,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 +352,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*) @@ -423,8 +407,8 @@ `(block ,skip (catch 'ir1-error-abort (let ((*compiler-error-bailout* - #'(lambda () - (throw 'ir1-error-abort nil)))) + (lambda () + (throw 'ir1-error-abort nil)))) ,@body (return-from ,skip nil))) (ir1-convert ,start ,cont ,proxy))))) @@ -505,16 +489,16 @@ (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. (defun reference-leaf (start cont leaf) (declare (type continuation start cont) (type leaf leaf)) - (let* ((leaf (or (and (defined-function-p leaf) - (not (eq (defined-function-inlinep leaf) + (let* ((leaf (or (and (defined-fun-p leaf) + (not (eq (defined-fun-inlinep leaf) :notinline)) - (let ((fun (defined-function-functional leaf))) + (let ((fun (defined-fun-functional leaf))) (when (and fun (not (functional-kind fun))) (maybe-reanalyze-function fun)))) leaf)) @@ -555,8 +539,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) @@ -579,13 +564,18 @@ (careful-expand-macro (info :function :macro-function fun) form))) ((nil :function) - (ir1-convert-srctran start cont (find-free-function fun "Eh?") form)))) + (ir1-convert-srctran start + cont + (find-free-function fun + "shouldn't happen! (no-cmacro)") + form)))) (defun muffle-warning-or-die () (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 +691,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