/[cmucl]/src/compiler/locall.lisp
ViewVC logotype

Diff of /src/compiler/locall.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.34 by ram, Tue Jul 21 18:45:34 1992 UTC revision 1.35 by ram, Mon Sep 7 16:01:25 1992 UTC
# Line 19  Line 19 
19  ;;; places the body of the function inline.  ;;; places the body of the function inline.
20  ;;;  ;;;
21  ;;;    We cannot always do a local call even when we do have the function being  ;;;    We cannot always do a local call even when we do have the function being
22  ;;; called.  Local call can be explicitly disabled by a NOTINLINE declaration.  ;;; called.  Calls that cannot be shown to have legal arg counts are not
23  ;;; Calls that cannot be shown to have legal arg counts are also not converted.  ;;; converted.
24  ;;;  ;;;
25  ;;; Written by Rob MacLachlan  ;;; Written by Rob MacLachlan
26  ;;;  ;;;
# Line 151  Line 151 
151             (temps (gensym)))             (temps (gensym)))
152           `(lambda (,n-supplied ,@(temps))           `(lambda (,n-supplied ,@(temps))
153              (declare (fixnum ,n-supplied))              (declare (fixnum ,n-supplied))
154              ,(if (policy (lambda-bind fun) (zerop safety))              ,(if (policy nil (zerop safety))
155                   `(declare (ignore ,n-supplied))                   `(declare (ignore ,n-supplied))
156                   `(%verify-argument-count ,n-supplied ,nargs))                   `(%verify-argument-count ,n-supplied ,nargs))
157              (%funcall ,fun ,@(temps))))))              (%funcall ,fun ,@(temps))))))
# Line 240  Line 240 
240        (change-ref-leaf ref (or (functional-entry-function fun)        (change-ref-leaf ref (or (functional-entry-function fun)
241                                 (make-external-entry-point fun))))))                                 (make-external-entry-point fun))))))
242    
243    
244    
245  ;;; Local-Call-Analyze-1  --  Interface  ;;; Local-Call-Analyze-1  --  Interface
246  ;;;  ;;;
247  ;;;    Attempt to convert all references to Fun to local calls.  The reference  ;;;    Attempt to convert all references to Fun to local calls.  The reference
248  ;;; cannot be :Notinline, and must be the function for a call.  The function  ;;; must be the function for a call, and the function continuation must be used
249  ;;; continuation must be used only once, since otherwise we cannot be sure what  ;;; only once, since otherwise we cannot be sure what function is to be called.
250  ;;; function is to be called.  The call continuation would be multiply used if  ;;; The call continuation would be multiply used if there is hairy stuff such
251  ;;; there is hairy stuff such as conditionals in the expression that computes  ;;; as conditionals in the expression that computes the function.
 ;;; the function.  
 ;;;  
 ;;;    Except in the interpreter, we don't attempt to convert calls that appear  
 ;;; in a top-level lambda unless there is only one reference or the function is  
 ;;; a unwind-protect cleanup.  This allows top-level components to contain only  
 ;;; load-time code: any references to run-time functions will be as closures.  
252  ;;;  ;;;
253  ;;;    If we cannot convert a reference, then we mark the referenced function  ;;;    If we cannot convert a reference, then we mark the referenced function
254  ;;; as an entry-point, creating a new XEP if necessary.  ;;; as an entry-point, creating a new XEP if necessary.  We don't try to
255    ;;; convert calls that are in error (:ERROR kind.)
256  ;;;  ;;;
257  ;;;    This is broken off from Local-Call-Analyze so that people can force  ;;;    This is broken off from Local-Call-Analyze so that people can force
258  ;;; analysis of newly introduced calls.  Note that we don't do let conversion  ;;; analysis of newly introduced calls.  Note that we don't do let conversion
# Line 264  Line 260 
260  ;;;  ;;;
261  (defun local-call-analyze-1 (fun)  (defun local-call-analyze-1 (fun)
262    (declare (type functional fun))    (declare (type functional fun))
263    (let ((refs (leaf-refs fun)))    (let ((refs (leaf-refs fun))
264            (first-time t))
265      (dolist (ref refs)      (dolist (ref refs)
266        (let* ((cont (node-cont ref))        (let* ((cont (node-cont ref))
267               (dest (continuation-dest cont)))               (dest (continuation-dest cont)))
268          (cond ((and (basic-combination-p dest)          (cond ((and (basic-combination-p dest)
269                      (eq (basic-combination-fun dest) cont)                      (eq (basic-combination-fun dest) cont)
270                      (eq (continuation-use cont) ref)                      (eq (continuation-use cont) ref))
271                      (or (null (rest refs))  
272                          *converting-for-interpreter*                 (convert-call-if-possible ref dest)
                         (eq (functional-kind fun) :cleanup)  
                         (not (eq (functional-kind (node-home-lambda ref))  
                                  :top-level))))  
                (ecase (ref-inlinep ref)  
                  ((nil :inline :maybe-inline)  
                   (convert-call-if-possible ref dest))  
                  ((:notinline)))  
273    
274                 (unless (eq (basic-combination-kind dest) :local)                 (unless (eq (basic-combination-kind dest) :local)
275                   (reference-entry-point ref)))                   (reference-entry-point ref)))
276                (t                (t
277                 (reference-entry-point ref))))))                 (reference-entry-point ref))))
278          (setq first-time nil)))
279    
280    (undefined-value))    (undefined-value))
281    
# Line 301  Line 292 
292  ;;; triggered by reference deletion.  In particular, the Component-Lambdas are  ;;; triggered by reference deletion.  In particular, the Component-Lambdas are
293  ;;; being hacked to remove newly deleted and let converted lambdas, so it is  ;;; being hacked to remove newly deleted and let converted lambdas, so it is
294  ;;; important that the lambda is added to the Component-Lambdas when it is.  ;;; important that the lambda is added to the Component-Lambdas when it is.
295    ;;; Also, the COMPOENT-NEW-FUNCTIONS may contain all sorts of drivel, since it
296    ;;; is not updated when we delete functions, etc.  Only COMPONENT-LAMBDAS is
297    ;;; updated.
298  ;;;  ;;;
299  (defun local-call-analyze (component)  (defun local-call-analyze (component)
300    (declare (type component component))    (declare (type component component))
# Line 308  Line 302 
302      (unless (component-new-functions component) (return))      (unless (component-new-functions component) (return))
303      (let* ((fun (pop (component-new-functions component)))      (let* ((fun (pop (component-new-functions component)))
304             (kind (functional-kind fun)))             (kind (functional-kind fun)))
305        (cond ((eq kind :deleted))        (cond ((member kind '(:deleted :let :mv-let :assignment)))
306              ((and (null (leaf-refs fun)) (eq kind nil)              ((and (null (leaf-refs fun)) (eq kind nil)
307                    (not (functional-entry-function fun)))                    (not (functional-entry-function fun)))
308               (delete-functional fun))               (delete-functional fun))
# Line 322  Line 316 
316    (undefined-value))    (undefined-value))
317    
318    
319    ;;; MAYBE-EXPAND-LOCAL-INLINE  --  Internal
320    ;;;
321    ;;;    If policy is auspicious, Call is not in an XEP, and we don't seem to be
322    ;;; in an infinite recursive loop, then change the reference to reference a
323    ;;; fresh copy.  We return whichever function we decide to reference.
324    ;;;
325    (defun maybe-expand-local-inline (fun ref call)
326      (if (and (policy call (>= speed space) (>= speed cspeed))
327               (not (eq (functional-kind (node-home-lambda call)) :external))
328               (inline-expansion-ok call))
329          (with-ir1-environment call
330            (let* ((*lexical-environment* (functional-lexenv fun))
331                   (res (ir1-convert-lambda (functional-inline-expansion fun))))
332              (change-ref-leaf ref res)
333              res))
334          fun))
335    
336    
337  ;;; Convert-Call-If-Possible  --  Interface  ;;; Convert-Call-If-Possible  --  Interface
338  ;;;  ;;;
339  ;;;    Dispatch to the appropriate function to attempt to convert a call.  This  ;;;    Dispatch to the appropriate function to attempt to convert a call.  This
340  ;;; is called in IR1 optimize as well as in local call analysis.  If the call  ;;; is called in IR1 optimize as well as in local call analysis.  If the call
341  ;;; is already :Local, we do nothing.  If the call is in the top-level  ;;; is is already :Local, we do nothing.  If the call is already scheduled for
342  ;;; component, also do nothing, since we don't want to join top-level code into  ;;; deletion, also do nothing (in addition to saving time, this also avoids
343  ;;; normal components.  ;;; some problems with optimizing collections of functions that are partially
344    ;;; deleted.)
345    ;;;
346    ;;;    This is called both before and after FIND-INITIAL-DFO runs.  When called
347    ;;; on a :INITIAL component, we don't care whether the caller and callee are in
348    ;;; the same component.  Afterward, we must stick with whatever component
349    ;;; division we have chosen.
350    ;;;
351    ;;;    Before attempting to convert a call, we see if the function is supposed
352    ;;; to be inline expanded.  Call conversion proceeds as before after any
353    ;;; expansion.
354  ;;;  ;;;
355  ;;;    We bind *Compiler-Error-Context* to the node for the call so that  ;;;    We bind *Compiler-Error-Context* to the node for the call so that
356  ;;; warnings will get the right context.  ;;; warnings will get the right context.
357  ;;;  ;;;
358    ;;;
359  (defun convert-call-if-possible (ref call)  (defun convert-call-if-possible (ref call)
360    (declare (type ref ref) (type basic-combination call))    (declare (type ref ref) (type basic-combination call))
361    (unless (or (eq (basic-combination-kind call) :local)    (let* ((block (node-block call))
362                (let ((block (node-block call)))           (component (block-component block))
363                  (or (block-delete-p block)           (original-fun (ref-leaf ref)))
364                      (eq (functional-kind (block-home-lambda block))      (unless (or (member (basic-combination-kind call) '(:local :error))
365                          :deleted))))                  (block-delete-p block)
366      (let ((fun (let ((fun (ref-leaf ref)))                  (eq (functional-kind (block-home-lambda block)) :deleted)
367                   (if (external-entry-point-p fun)                  (not (or (eq (component-kind component) :initial)
368                       (functional-entry-function fun)                           (eq (block-component
369                       fun)))                                (node-block
370            (*compiler-error-context* call))                                 (lambda-bind (main-entry original-fun))))
371        (let ((c1 (block-component (node-block call)))                               component))))
372              (c2 (block-component (node-block (lambda-bind (main-entry fun))))))        (let ((fun (if (external-entry-point-p original-fun)
373          (assert (or (eq c1 c2)                       (functional-entry-function original-fun)
374                      (and (eq (component-kind c1) :initial)                       original-fun))
375                           (eq (component-kind c2) :initial)))))              (*compiler-error-context* call))
376        (assert (member (functional-kind fun) '(nil :escape :cleanup :optional)))  
377        (cond ((mv-combination-p call)          (when (and (eq (functional-inlinep fun) :inline)
378               (convert-mv-call ref call fun))                     (rest (leaf-refs original-fun)))
379              ((lambda-p fun)            (setq fun (maybe-expand-local-inline fun ref call)))
380               (convert-lambda-call ref call fun))  
381              (t          (assert (member (functional-kind fun)
382               (convert-hairy-call ref call fun)))))                          '(nil :escape :cleanup :optional)))
383            (cond ((mv-combination-p call)
384                   (convert-mv-call ref call fun))
385                  ((lambda-p fun)
386                   (convert-lambda-call ref call fun))
387                  (t
388                   (convert-hairy-call ref call fun))))))
389    
390    (undefined-value))    (undefined-value))
391    
392    
# Line 398  Line 428 
428  ;;; Convert-Lambda-Call  --  Internal  ;;; Convert-Lambda-Call  --  Internal
429  ;;;  ;;;
430  ;;;    Attempt to convert a call to a lambda.  If the number of args is wrong,  ;;;    Attempt to convert a call to a lambda.  If the number of args is wrong,
431  ;;; we give a warning and mark the Ref as :Notinline to remove it from future  ;;; we give a warning and mark the call as :ERROR to remove it from future
432  ;;; consideration.  If the argcount is O.K. then we just convert it.  ;;; consideration.  If the argcount is O.K. then we just convert it.
433  ;;;  ;;;
434  (defun convert-lambda-call (ref call fun)  (defun convert-lambda-call (ref call fun)
# Line 411  Line 441 
441             (compiler-warning             (compiler-warning
442              "Function called with ~R argument~:P, but wants exactly ~R."              "Function called with ~R argument~:P, but wants exactly ~R."
443              call-args nargs)              call-args nargs)
444             (setf (ref-inlinep ref) :notinline)))))             (setf (basic-combination-kind call) :error)))))
445    
446    
447    
# Line 433  Line 463 
463      (cond ((< call-args min-args)      (cond ((< call-args min-args)
464             (compiler-warning "Function called with ~R argument~:P, but wants at least ~R."             (compiler-warning "Function called with ~R argument~:P, but wants at least ~R."
465                               call-args min-args)                               call-args min-args)
466             (setf (ref-inlinep ref) :notinline))             (setf (basic-combination-kind call) :error))
467            ((<= call-args max-args)            ((<= call-args max-args)
468             (convert-call ref call             (convert-call ref call
469                           (elt (optional-dispatch-entry-points fun)                           (elt (optional-dispatch-entry-points fun)
# Line 443  Line 473 
473            (t            (t
474             (compiler-warning "Function called with ~R argument~:P, but wants at most ~R."             (compiler-warning "Function called with ~R argument~:P, but wants at most ~R."
475                               call-args max-args)                               call-args max-args)
476             (setf (ref-inlinep ref) :notinline))))             (setf (basic-combination-kind call) :error))))
   
477    (undefined-value))    (undefined-value))
478    
479    
# Line 526  Line 555 
555          (when (oddp (length more))          (when (oddp (length more))
556            (compiler-warning "Function called with odd number of ~            (compiler-warning "Function called with odd number of ~
557                               arguments in keyword portion.")                               arguments in keyword portion.")
558            (setf (ref-inlinep ref) :notinline)  
559              (setf (basic-combination-kind call) :error)
560            (return-from convert-more-call))            (return-from convert-more-call))
561    
562          (do ((key more (cddr key))          (do ((key more (cddr key))
# Line 536  Line 566 
566              (unless (constant-continuation-p cont)              (unless (constant-continuation-p cont)
567                (when flame                (when flame
568                  (compiler-note "Non-constant keyword in keyword call."))                  (compiler-note "Non-constant keyword in keyword call."))
569                (setf (ref-inlinep ref) :notinline)                (setf (basic-combination-kind call) :error)
570                (return-from convert-more-call))                (return-from convert-more-call))
571    
572              (let ((name (continuation-value cont))              (let ((name (continuation-value cont))
# Line 555  Line 585 
585          (when (and loser (not (optional-dispatch-allowp fun)))          (when (and loser (not (optional-dispatch-allowp fun)))
586            (compiler-warning "Function called with unknown argument keyword ~S."            (compiler-warning "Function called with unknown argument keyword ~S."
587                              loser)                              loser)
588            (setf (ref-inlinep ref) :notinline)            (setf (basic-combination-kind call) :error)
589            (return-from convert-more-call)))            (return-from convert-more-call)))
590    
591        (collect ((call-args))        (collect ((call-args))
# Line 837  Line 867 
867      (move-return-stuff fun call next-block)      (move-return-stuff fun call next-block)
868      (merge-lets fun call))      (merge-lets fun call))
869    
   (maybe-remove-free-function fun)  
870    (dolist (arg (basic-combination-args call))    (dolist (arg (basic-combination-args call))
871      (when arg      (when arg
872        (reoptimize-continuation arg)))        (reoptimize-continuation arg)))

Legend:
Removed from v.1.34  
changed lines
  Added in v.1.35

  ViewVC Help
Powered by ViewVC 1.1.5