/[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.5 by ram, Tue May 29 16:16:29 1990 UTC revision 1.6 by ram, Mon Jul 23 14:53:48 1990 UTC
# Line 64  Line 64 
64    (declare (type ref ref) (type combination call) (type clambda fun))    (declare (type ref ref) (type combination call) (type clambda fun))
65    (propagate-to-args call fun)    (propagate-to-args call fun)
66    (setf (basic-combination-kind call) :local)    (setf (basic-combination-kind call) :local)
67    (pushnew fun (lambda-calls (lambda-home (block-lambda (node-block call)))))    (pushnew fun (lambda-calls (node-home-lambda call)))
68    (change-ref-leaf ref fun)    (change-ref-leaf ref fun)
69    (undefined-value))    (undefined-value))
70    
# Line 227  Line 227 
227                      (eq (continuation-use cont) ref)                      (eq (continuation-use cont) ref)
228                      (or (null (rest refs))                      (or (null (rest refs))
229                          *converting-for-interpreter*                          *converting-for-interpreter*
230                          (not (eq (functional-kind                          (not (eq (functional-kind (node-home-lambda ref))
                                   (lambda-home  
                                    (block-lambda (node-block ref))))  
231                                   :top-level))))                                   :top-level))))
232                 (ecase (ref-inlinep ref)                 (ecase (ref-inlinep ref)
233                   ((nil :inline)                   ((nil :inline)
# Line 323  Line 321 
321      (let ((ep (car (last (optional-dispatch-entry-points fun)))))      (let ((ep (car (last (optional-dispatch-entry-points fun)))))
322        (change-ref-leaf ref ep)        (change-ref-leaf ref ep)
323        (setf (basic-combination-kind call) :local)        (setf (basic-combination-kind call) :local)
324        (pushnew ep        (pushnew ep (lambda-calls (node-home-lambda call)))
                (lambda-calls (lambda-home (block-lambda (node-block call)))))  
325    
326        (assert-continuation-type        (assert-continuation-type
327         (first (basic-combination-args call))         (first (basic-combination-args call))
# Line 412  Line 409 
409             (ir1-convert-lambda             (ir1-convert-lambda
410              `(lambda ,vars              `(lambda ,vars
411                 (declare (ignore . ,ignores))                 (declare (ignore . ,ignores))
412                 (%funcall ,entry . ,args))                 (%funcall ,entry . ,args))))))
             (node-source call)))))  
413      (convert-call ref call new-fun)      (convert-call ref call new-fun)
414      (dolist (ref (leaf-refs entry))      (dolist (ref (leaf-refs entry))
415        (convert-call-if-possible ref (continuation-dest (node-cont ref))))))        (convert-call-if-possible ref (continuation-dest (node-cont ref))))))
# Line 543  Line 539 
539  ;;;    longer in effect.  ;;;    longer in effect.
540    
541    
542  ;;; Merge-Cleanups-And-Lets  --  Internal  ;;; Merge-Lets  --  Internal
543  ;;;  ;;;
544  ;;;    Handle the environment semantics of let conversion.  We add the lambda  ;;;    Handle the environment semantics of let conversion.  We add the lambda
545  ;;; and its lets to lets for the call's home function and move any cleanups and  ;;; and its lets to lets for the call's home function.  We merge the calls for
546  ;;; calls to the home function.  We merge the calls for Fun with the calls for  ;;; Fun with the calls for the home function, removing Fun in the process.  We
547  ;;; the home function, removing Fun in the process.  We also merge the Entries.  ;;; also merge the Entries.
 ;;; This must run after INSERT-LET-BODY, since the call to NODE-ENDS-BLOCK  
 ;;; figures out the actual cleanup current at the let call (and sets the  
 ;;; start/end cleanups accordingly.)  
548  ;;;  ;;;
549  (defun merge-cleanups-and-lets (fun call)  (defun merge-lets (fun call)
550    (declare (type clambda fun) (type basic-combination call))    (declare (type clambda fun) (type basic-combination call))
551    (let* ((prev (node-prev call))    (let* ((prev (node-prev call))
552           (home (lambda-home (block-lambda (continuation-block prev))))           (home (block-home-lambda (continuation-block prev)))
553           (home-env (lambda-environment home)))           (home-env (lambda-environment home)))
554      (push fun (lambda-lets home))      (push fun (lambda-lets home))
555      (setf (lambda-home fun) home)      (setf (lambda-home fun) home)
556      (setf (lambda-environment fun) home-env)      (setf (lambda-environment fun) home-env)
557    
558      (let ((cleanup (find-enclosing-cleanup      (let ((lets (lambda-lets fun)))
                     (block-end-cleanup (continuation-block prev))))  
           (lets (lambda-lets fun)))  
559        (dolist (let lets)        (dolist (let lets)
560          (setf (lambda-home let) home)          (setf (lambda-home let) home)
561          (setf (lambda-environment let) home-env))          (setf (lambda-environment let) home-env))
       (when cleanup  
         (dolist (let lets)  
           (unless (lambda-cleanup let)  
             (setf (lambda-cleanup let) cleanup)))  
         (setf (lambda-cleanup fun) cleanup))  
562    
563        (setf (lambda-lets home) (nconc lets (lambda-lets home)))        (setf (lambda-lets home) (nconc lets (lambda-lets home)))
564        (setf (lambda-lets fun) ()))        (setf (lambda-lets fun) ()))
# Line 661  Line 647 
647  (defun let-convert (fun call)  (defun let-convert (fun call)
648    (declare (type clambda fun) (type basic-combination call))    (declare (type clambda fun) (type basic-combination call))
649    (insert-let-body fun call)    (insert-let-body fun call)
650    (merge-cleanups-and-lets fun call)    (merge-lets fun call)
651    (move-return-uses fun call)    (move-return-uses fun call)
652    
653    (let* ((fun (or (lambda-optional-dispatch fun) fun))    (let* ((fun (or (lambda-optional-dispatch fun) fun))

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

  ViewVC Help
Powered by ViewVC 1.1.5