/[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.2 by ram, Mon Feb 19 10:50:05 1990 UTC revision 1.3 by ram, Tue Apr 24 15:45:04 1990 UTC
# Line 205  Line 205 
205  ;;; there is hairy stuff such as conditionals in the expression that computes  ;;; there is hairy stuff such as conditionals in the expression that computes
206  ;;; the function.  ;;; the function.
207  ;;;  ;;;
208    ;;;    We don't attempt to convert calls that appear in a top-level lambda
209    ;;; unless there is only one reference.  This ensures that top-level components
210    ;;; will contain only load-time code: any references to run-time functions will
211    ;;; be as closures.
212    ;;;
213  ;;;    If we cannot convert a reference, then we mark the referenced function  ;;;    If we cannot convert a reference, then we mark the referenced function
214  ;;; as an entry-point, creating a new XEP if necessary.  ;;; as an entry-point, creating a new XEP if necessary.
215  ;;;  ;;;
# Line 214  Line 219 
219  ;;;  ;;;
220  (defun local-call-analyze-1 (fun)  (defun local-call-analyze-1 (fun)
221    (declare (type functional fun))    (declare (type functional fun))
222    (dolist (ref (leaf-refs fun))    (let ((refs (leaf-refs fun)))
223      (let* ((cont (node-cont ref))      (dolist (ref refs)
224             (dest (continuation-dest cont)))        (let* ((cont (node-cont ref))
225        (cond ((and (basic-combination-p dest)               (dest (continuation-dest cont)))
226                    (eq (basic-combination-fun dest) cont)          (cond ((and (basic-combination-p dest)
227                    (eq (continuation-use cont) ref))                      (eq (basic-combination-fun dest) cont)
228               (ecase (ref-inlinep ref)                      (eq (continuation-use cont) ref)
229                 ((nil :inline)                      (or (null (rest refs))
230                  (convert-call-if-possible ref dest))                          (not (eq (functional-kind
231                 ((:notinline)))                                    (lambda-home
232                                       (block-lambda (node-block ref))))
233               (unless (eq (basic-combination-kind dest) :local)                                   :top-level))))
234                 (reference-entry-point ref)))                 (ecase (ref-inlinep ref)
235              (t                   ((nil :inline)
236               (reference-entry-point ref)))))                    (convert-call-if-possible ref dest))
237                     ((:notinline)))
238    
239                   (unless (eq (basic-combination-kind dest) :local)
240                     (reference-entry-point ref)))
241                  (t
242                   (reference-entry-point ref))))))
243    
244    (undefined-value))    (undefined-value))
245    
# Line 545  Line 556 
556  (defun merge-cleanups-and-lets (fun call)  (defun merge-cleanups-and-lets (fun call)
557    (declare (type clambda fun) (type basic-combination call))    (declare (type clambda fun) (type basic-combination call))
558    (let* ((prev (node-prev call))    (let* ((prev (node-prev call))
559           (home (lambda-home (block-lambda (continuation-block prev)))))           (home (lambda-home (block-lambda (continuation-block prev))))
560             (home-env (lambda-environment home)))
561      (push fun (lambda-lets home))      (push fun (lambda-lets home))
562      (setf (lambda-home fun) home)      (setf (lambda-home fun) home)
563        (setf (lambda-environment fun) home-env)
564    
565      (let ((cleanup (find-enclosing-cleanup      (let ((cleanup (find-enclosing-cleanup
566                      (block-end-cleanup (continuation-block prev))))                      (block-end-cleanup (continuation-block prev))))
567            (lets (lambda-lets fun)))            (lets (lambda-lets fun)))
568        (dolist (let lets)        (dolist (let lets)
569          (setf (lambda-home let) home))          (setf (lambda-home let) home)
570            (setf (lambda-environment let) home-env))
571        (when cleanup        (when cleanup
572          (dolist (let lets)          (dolist (let lets)
573            (unless (lambda-cleanup let)            (unless (lambda-cleanup let)

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

  ViewVC Help
Powered by ViewVC 1.1.5