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

Contents of /src/compiler/locall.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.11 - (hide annotations)
Thu Jan 3 13:08:49 1991 UTC (23 years, 3 months ago) by ram
Branch: MAIN
Changes since 1.10: +9 -3 lines
Added efficency note for when a rest arg prevents local call conversion.
Made let conversion set the LAMBDA-CALL-LEXENV.
1 wlott 1.1 ;;; -*- Package: C; Log: C.Log -*-
2     ;;;
3     ;;; **********************************************************************
4     ;;; This code was written as part of the Spice Lisp project at
5     ;;; Carnegie-Mellon University, and has been placed in the public domain.
6     ;;; If you want to use this code or any part of Spice Lisp, please contact
7     ;;; Scott Fahlman (FAHLMAN@CMUC).
8     ;;; **********************************************************************
9     ;;;
10     ;;; This file implements local call analysis. A local call is a function
11     ;;; call between functions being compiled at the same time. If we can tell at
12 ram 1.9 ;;; compile time that such a call is legal, then we change the combination
13     ;;; to call the correct lambda, mark it as local, and add this link to our call
14     ;;; graph. Once a call is local, it is then eligible for let conversion, which
15     ;;; places the body of the function inline.
16 wlott 1.1 ;;;
17     ;;; We cannot always do a local call even when we do have the function being
18     ;;; called. Local call can be explicitly disabled by a NOTINLINE declaration.
19     ;;; Calls that cannot be shown to have legal arg counts are also not converted.
20     ;;;
21     ;;; Written by Rob MacLachlan
22     ;;;
23     (in-package 'c)
24    
25    
26 ram 1.11 ;;; Propagate-To-Args -- Interface
27 wlott 1.1 ;;;
28     ;;; This function propagates information from the variables in the function
29 ram 1.11 ;;; Fun to the actual arguments in Call. This is also called by the VALUES IR1
30     ;;; optimizer when it sleazily converts MV-BINDs to LETs.
31 wlott 1.1 ;;;
32     ;;; We flush all arguments to Call that correspond to unreferenced variables
33     ;;; in Fun. We leave NILs in the Combination-Args so that the remaining args
34     ;;; still match up with their vars.
35     ;;;
36     ;;; We also apply the declared variable type assertion to the argument
37     ;;; continuations.
38     ;;;
39     (defun propagate-to-args (call fun)
40     (declare (type combination call) (type clambda fun))
41     (do ((args (basic-combination-args call) (cdr args))
42     (vars (lambda-vars fun) (cdr vars)))
43     ((null args))
44     (let ((arg (car args))
45     (var (car vars)))
46     (cond ((leaf-refs var)
47     (assert-continuation-type arg (leaf-type var)))
48     (t
49     (flush-dest arg)
50     (setf (car args) nil)))))
51    
52     (undefined-value))
53    
54    
55     ;;; Convert-Call -- Internal
56     ;;;
57     ;;; Convert a combination into a local call. We Propagate-To-Args, set the
58     ;;; combination kind to :Local, add Fun to the Calls of the function that the
59     ;;; call is in, then replace the function in the Ref node with the new
60     ;;; function.
61     ;;;
62     ;;; We change the Ref last, since changing the reference can trigger let
63     ;;; conversion of the new function, but will only do so if the call is local.
64     ;;;
65     (defun convert-call (ref call fun)
66     (declare (type ref ref) (type combination call) (type clambda fun))
67     (propagate-to-args call fun)
68     (setf (basic-combination-kind call) :local)
69 ram 1.6 (pushnew fun (lambda-calls (node-home-lambda call)))
70 wlott 1.1 (change-ref-leaf ref fun)
71     (undefined-value))
72    
73    
74     ;;;; External entry point creation:
75    
76     ;;; Make-XEP-Lambda -- Internal
77     ;;;
78     ;;; Return a Lambda form that can be used as the definition of the XEP for
79     ;;; Fun.
80     ;;;
81     ;;; If Fun is a lambda, then we check the number of arguments (conditional
82     ;;; on policy) and call Fun with all the arguments.
83     ;;;
84     ;;; If Fun is an Optional-Dispatch, then we dispatch off of the number of
85     ;;; supplied arguments by doing do an = test for each entry-point, calling the
86     ;;; entry with the appropriate prefix of the passed arguments.
87     ;;;
88     ;;; If there is a more arg, then there are a couple of optimizations that we
89     ;;; make (more for space than anything else):
90     ;;; -- If Min-Args is 0, then we make the more entry a T clause, since no
91     ;;; argument count error is possible.
92     ;;; -- We can omit the = clause for the last entry-point, allowing the case of
93     ;;; 0 more args to fall through to the more entry.
94     ;;;
95     ;;; We don't bother to policy conditionalize wrong arg errors in optional
96     ;;; dispatches, since the additional overhead is negligible compared to the
97     ;;; other hair going down.
98     ;;;
99     ;;; Note that if policy indicates it, argument type declarations in Fun will
100     ;;; be verified. Since nothing is known about the type of the XEP arg vars,
101     ;;; type checks will be emitted when the XEP's arg vars are passed to the
102     ;;; actual function.
103     ;;;
104     (defun make-xep-lambda (fun)
105     (declare (type functional fun))
106     (etypecase fun
107     (clambda
108     (let ((nargs (length (lambda-vars fun)))
109     (n-supplied (gensym)))
110     (collect ((temps))
111     (dotimes (i nargs)
112     (temps (gensym)))
113     `(lambda (,n-supplied ,@(temps))
114     (declare (fixnum ,n-supplied))
115 ram 1.4 ,(if (policy (lambda-bind fun) (zerop safety))
116 wlott 1.1 `(declare (ignore ,n-supplied))
117     `(%verify-argument-count ,n-supplied ,nargs))
118     (%funcall ,fun ,@(temps))))))
119     (optional-dispatch
120     (let* ((min (optional-dispatch-min-args fun))
121     (max (optional-dispatch-max-args fun))
122     (more (optional-dispatch-more-entry fun))
123     (n-supplied (gensym)))
124     (collect ((temps)
125     (entries))
126     (dotimes (i max)
127     (temps (gensym)))
128    
129     (do ((eps (optional-dispatch-entry-points fun) (rest eps))
130     (n min (1+ n)))
131     ((null eps))
132     (entries `((= ,n-supplied ,n)
133     (%funcall ,(first eps) ,@(subseq (temps) 0 n)))))
134    
135     `(lambda (,n-supplied ,@(temps))
136     (declare (fixnum ,n-supplied))
137     (cond
138     ,@(if more (butlast (entries)) (entries))
139     ,@(when more
140     `((,(if (zerop min) 't `(>= ,n-supplied ,max))
141     ,(let ((n-context (gensym))
142     (n-count (gensym)))
143     `(multiple-value-bind
144     (,n-context ,n-count)
145     (%more-arg-context ,n-supplied ,max)
146     (%funcall ,more ,@(temps) ,n-context ,n-count))))))
147     (t
148     (%argument-count-error ,n-supplied)))))))))
149    
150    
151     ;;; Make-External-Entry-Point -- Internal
152     ;;;
153     ;;; Make an external entry point (XEP) for Fun and return it. We convert
154     ;;; the result of Make-XEP-Lambda in the correct environment, then associate
155     ;;; this lambda with Fun as its XEP. After the conversion, we iterate over the
156     ;;; function's associated lambdas, redoing local call analysis so that the XEP
157     ;;; calls will get converted.
158     ;;;
159     ;;; We set Reanalyze and Reoptimize in the component, just in case we
160     ;;; discover an XEP after the initial local call analyze pass.
161     ;;;
162     (defun make-external-entry-point (fun)
163     (declare (type functional fun))
164     (assert (not (functional-entry-function fun)))
165     (with-ir1-environment (lambda-bind (main-entry fun))
166     (let ((res (ir1-convert-lambda (make-xep-lambda fun))))
167     (setf (functional-kind res) :external)
168     (setf (functional-entry-function res) fun)
169     (setf (functional-entry-function fun) res)
170     (setf (component-reanalyze *current-component*) t)
171     (setf (component-reoptimize *current-component*) t)
172     (etypecase fun
173     (clambda (local-call-analyze-1 fun))
174     (optional-dispatch
175     (dolist (ep (optional-dispatch-entry-points fun))
176     (local-call-analyze-1 ep))
177     (when (optional-dispatch-more-entry fun)
178     (local-call-analyze-1 (optional-dispatch-more-entry fun)))))
179     res)))
180    
181    
182     ;;; Reference-Entry-Point -- Internal
183     ;;;
184     ;;; Notice a Ref that is not in a local-call context. If the Ref is already
185     ;;; to an XEP, then do nothing, otherwise change it to the XEP, making an XEP
186     ;;; if necessary.
187     ;;;
188     ;;; If Ref is to a special :Cleanup or :Escape function, then we treat it as
189     ;;; though it was not an XEP reference (i.e. leave it alone.)
190     ;;;
191     (defun reference-entry-point (ref)
192     (declare (type ref ref))
193     (let ((fun (ref-leaf ref)))
194     (unless (or (external-entry-point-p fun)
195     (member (functional-kind fun) '(:escape :cleanup)))
196     (change-ref-leaf ref (or (functional-entry-function fun)
197     (make-external-entry-point fun))))))
198    
199    
200     ;;; Local-Call-Analyze-1 -- Interface
201     ;;;
202     ;;; Attempt to convert all references to Fun to local calls. The reference
203     ;;; cannot be :Notinline, and must be the function for a call. The function
204     ;;; continuation must be used only once, since otherwise we cannot be sure what
205     ;;; function is to be called. The call continuation would be multiply used if
206     ;;; there is hairy stuff such as conditionals in the expression that computes
207     ;;; the function.
208     ;;;
209 ram 1.5 ;;; Except in the interpreter, we don't attempt to convert calls that appear
210 ram 1.10 ;;; in a top-level lambda unless there is only one reference or the function is
211     ;;; a unwind-protect cleanup. This allows top-level components to contain only
212     ;;; load-time code: any references to run-time functions will be as closures.
213 ram 1.3 ;;;
214 wlott 1.1 ;;; If we cannot convert a reference, then we mark the referenced function
215     ;;; as an entry-point, creating a new XEP if necessary.
216     ;;;
217     ;;; This is broken off from Local-Call-Analyze so that people can force
218     ;;; analysis of newly introduced calls. Note that we don't do let conversion
219     ;;; here.
220     ;;;
221     (defun local-call-analyze-1 (fun)
222     (declare (type functional fun))
223 ram 1.3 (let ((refs (leaf-refs fun)))
224     (dolist (ref refs)
225     (let* ((cont (node-cont ref))
226     (dest (continuation-dest cont)))
227     (cond ((and (basic-combination-p dest)
228     (eq (basic-combination-fun dest) cont)
229     (eq (continuation-use cont) ref)
230     (or (null (rest refs))
231 ram 1.5 *converting-for-interpreter*
232 ram 1.10 (eq (functional-kind fun) :cleanup)
233 ram 1.6 (not (eq (functional-kind (node-home-lambda ref))
234 ram 1.3 :top-level))))
235     (ecase (ref-inlinep ref)
236     ((nil :inline)
237     (convert-call-if-possible ref dest))
238     ((:notinline)))
239    
240     (unless (eq (basic-combination-kind dest) :local)
241     (reference-entry-point ref)))
242     (t
243     (reference-entry-point ref))))))
244 wlott 1.1
245     (undefined-value))
246    
247    
248     ;;; Local-Call-Analyze -- Interface
249     ;;;
250     ;;; We examine all New-Functions in component, attempting to convert calls
251     ;;; into local calls when it is legal. We also attempt to convert each lambda
252     ;;; to a let. Let conversion is also triggered by deletion of a function
253     ;;; reference, but functions that start out eligible for conversion must be
254     ;;; noticed sometime.
255     ;;;
256     ;;; Note that there is a lot of action going on behind the scenes here,
257     ;;; triggered by reference deletion. In particular, the Component-Lambdas are
258     ;;; being hacked to remove newly deleted and let converted lambdas, so it is
259     ;;; important that the lambda is added to the Component-Lambdas when it is.
260     ;;;
261     (defun local-call-analyze (component)
262     (declare (type component component))
263     (loop
264     (unless (component-new-functions component) (return))
265     (let ((fun (pop (component-new-functions component))))
266 ram 1.8 (cond ((eq (functional-kind fun) :deleted))
267     ((and (null (leaf-refs fun))
268     (ecase (functional-kind fun)
269     ((nil :escape :cleanup) t)
270     ((:optional :top-level) nil)))
271     (delete-functional fun))
272     (t
273     (when (lambda-p fun)
274     (push fun (component-lambdas component)))
275     (local-call-analyze-1 fun)
276     (when (lambda-p fun)
277     (maybe-let-convert fun))))))
278 wlott 1.1
279     (undefined-value))
280    
281    
282     ;;; Convert-Call-If-Possible -- Interface
283     ;;;
284     ;;; Dispatch to the appropriate function to attempt to convert a call. This
285     ;;; is called in IR1 optimize as well as in local call analysis. If the call
286     ;;; is already :Local, we do nothing. If the call is in the top-level
287     ;;; component, also do nothing, since we don't want to join top-level code into
288     ;;; normal components.
289     ;;;
290     ;;; We bind *Compiler-Error-Context* to the node for the call so that
291     ;;; warnings will get the right context.
292     ;;;
293     (defun convert-call-if-possible (ref call)
294     (declare (type ref ref) (type basic-combination call))
295     (let ((fun (let ((fun (ref-leaf ref)))
296     (if (external-entry-point-p fun)
297     (functional-entry-function fun)
298     fun)))
299     (*compiler-error-context* call))
300     (cond ((eq (basic-combination-kind call) :local))
301     ((mv-combination-p call)
302     (convert-mv-call ref call fun))
303     ((lambda-p fun)
304     (convert-lambda-call ref call fun))
305     (t
306     (convert-hairy-call ref call fun))))
307     (undefined-value))
308    
309    
310     ;;; Convert-MV-Call -- Internal
311     ;;;
312     ;;; Attempt to convert a multiple-value call. The only interesting case is
313     ;;; a call to a function that Looks-Like-An-MV-Bind, has exactly one reference
314     ;;; and no XEP, and is called with one values continuation.
315     ;;;
316     ;;; We change the call to be to the last optional entry point and change the
317     ;;; call to be local. Due to our preconditions, the call should eventually be
318     ;;; converted to a let, but we can't do that now, since there may be stray
319     ;;; references to the e-p lambda due to optional defaulting code.
320     ;;;
321     ;;; We also use variable types for the called function to construct an
322     ;;; assertion for the values continuation.
323     ;;;
324     (defun convert-mv-call (ref call fun)
325     (declare (type ref ref) (type mv-combination call) (type functional fun))
326     (when (and (looks-like-an-mv-bind fun)
327     (not (functional-entry-function fun))
328     (= (length (leaf-refs fun)) 1)
329     (= (length (basic-combination-args call)) 1))
330     (let ((ep (car (last (optional-dispatch-entry-points fun)))))
331     (change-ref-leaf ref ep)
332     (setf (basic-combination-kind call) :local)
333 ram 1.6 (pushnew ep (lambda-calls (node-home-lambda call)))
334 wlott 1.1
335     (assert-continuation-type
336     (first (basic-combination-args call))
337     (make-values-type :optional (mapcar #'leaf-type (lambda-vars ep))
338     :rest *universal-type*))))
339     (undefined-value))
340    
341    
342     ;;; Convert-Lambda-Call -- Internal
343     ;;;
344     ;;; Attempt to convert a call to a lambda. If the number of args is wrong,
345     ;;; we give a warning and mark the Ref as :Notinline to remove it from future
346     ;;; consideration. If the argcount is O.K. then we just convert it.
347     ;;;
348     (defun convert-lambda-call (ref call fun)
349 ram 1.9 (declare (type ref ref) (type combination call) (type clambda fun))
350 wlott 1.1 (let ((nargs (length (lambda-vars fun)))
351     (call-args (length (combination-args call))))
352     (cond ((= call-args nargs)
353     (convert-call ref call fun))
354     (t
355     (compiler-warning
356     "Function called with ~R argument~:P, but wants exactly ~R."
357     call-args nargs)
358     (setf (ref-inlinep ref) :notinline)))))
359    
360    
361    
362     ;;;; Optional, more and keyword calls:
363    
364     ;;; Convert-Hairy-Call -- Internal
365     ;;;
366     ;;; Similar to Convert-Lambda-Call, but deals with Optional-Dispatches. If
367     ;;; only fixed args are supplied, then convert a call to the correct entry
368     ;;; point. If keyword args are supplied, then dispatch to a subfunction. We
369     ;;; don't convert calls to functions that have a more (or rest) arg.
370     ;;;
371     (defun convert-hairy-call (ref call fun)
372     (declare (type ref ref) (type combination call)
373     (type optional-dispatch fun))
374     (let ((min-args (optional-dispatch-min-args fun))
375     (max-args (optional-dispatch-max-args fun))
376     (call-args (length (combination-args call))))
377     (cond ((< call-args min-args)
378     (compiler-warning "Function called with ~R argument~:P, but wants at least ~R."
379     call-args min-args)
380     (setf (ref-inlinep ref) :notinline))
381     ((<= call-args max-args)
382     (convert-call ref call
383     (elt (optional-dispatch-entry-points fun)
384     (- call-args min-args))))
385     ((not (optional-dispatch-more-entry fun))
386     (compiler-warning "Function called with ~R argument~:P, but wants at most ~R."
387     call-args max-args)
388     (setf (ref-inlinep ref) :notinline))
389     ((optional-dispatch-keyp fun)
390     (cond ((oddp (- call-args max-args))
391     (compiler-warning "Function called with odd number of ~
392     arguments in keyword portion."))
393     (t
394     (convert-keyword-call ref call fun))))))
395    
396     (undefined-value))
397    
398    
399     ;;; Convert-Hairy-Fun-Entry -- Internal
400     ;;;
401     ;;; This function is used to convert a call to an entry point when complex
402     ;;; transformations need to be done on the original arguments. Entry is the
403     ;;; entry point function that we are calling. Vars is a list of variable names
404     ;;; which are bound to the oringinal call arguments. Ignores is the subset of
405     ;;; Vars which are ignored. Args is the list of arguments to the entry point
406     ;;; function.
407     ;;;
408     ;;; In order to avoid gruesome graph grovelling, we introduce a new function
409     ;;; that rearranges the arguments and calls the entry point. We analyze the
410     ;;; new function and the entry point immediately so that everything gets
411     ;;; converted during the single pass.
412     ;;;
413     (defun convert-hairy-fun-entry (ref call entry vars ignores args)
414 ram 1.9 (declare (list vars ignores args) (type ref ref) (type combination call)
415     (type clambda entry))
416 wlott 1.1 (let ((new-fun
417     (with-ir1-environment call
418     (ir1-convert-lambda
419     `(lambda ,vars
420     (declare (ignore . ,ignores))
421 ram 1.6 (%funcall ,entry . ,args))))))
422 wlott 1.1 (convert-call ref call new-fun)
423     (dolist (ref (leaf-refs entry))
424     (convert-call-if-possible ref (continuation-dest (node-cont ref))))))
425    
426    
427     ;;; Convert-Keyword-Call -- Internal
428     ;;;
429     ;;; Use Convert-Hairy-Fun-Entry to convert a keyword call to a known
430     ;;; functions into a local call to the Main-Entry.
431     ;;;
432     ;;; First we verify that all keywords are constant and legal. If there
433     ;;; aren't, then we warn the user and don't attempt to convert the call.
434     ;;;
435     ;;; We massage the supplied keyword arguments into the order expected by the
436     ;;; main entry. This is done by binding all the arguments to the keyword call
437     ;;; to variables in the introduced lambda, then passing these values variables
438     ;;; in the correct order when calling the main entry. Unused arguments
439     ;;; (such as the keywords themselves) are discarded simply by not passing them
440     ;;; along.
441     ;;;
442     (defun convert-keyword-call (ref call fun)
443     (declare (type ref ref) (type combination call) (type optional-dispatch fun))
444     (let* ((max (optional-dispatch-max-args fun))
445     (arglist (optional-dispatch-arglist fun))
446     (args (combination-args call))
447     (keys (nthcdr max args))
448 ram 1.11 (flame (policy call (or (> speed brevity) (> space brevity))))
449 wlott 1.1 (loser nil))
450     (collect ((temps)
451     (ignores)
452     (supplied)
453     (key-vars))
454    
455     (dolist (var arglist)
456     (let ((info (lambda-var-arg-info var)))
457     (when info
458     (ecase (arg-info-kind info)
459     (:rest
460 ram 1.11 (when flame
461     (compiler-note
462     "Rest arg prevents use of local call convention."))
463 wlott 1.1 (setf (ref-inlinep ref) :notinline)
464     (return-from convert-keyword-call))
465     (:keyword
466     (key-vars var))
467     (:optional)))))
468    
469     (dotimes (i max)
470     (temps (gensym)))
471    
472     (do ((key keys (cddr key)))
473     ((null key))
474     (let ((cont (first key)))
475     (unless (constant-continuation-p cont)
476 ram 1.11 (when flame
477 wlott 1.1 (compiler-note "Non-constant keyword in keyword call."))
478     (setf (ref-inlinep ref) :notinline)
479     (return-from convert-keyword-call))
480    
481     (let ((name (continuation-value cont)))
482     (dolist (var (key-vars)
483     (let ((dummy1 (gensym))
484     (dummy2 (gensym)))
485     (temps dummy1 dummy2)
486     (ignores dummy1 dummy2)
487     (setq loser name)))
488     (let ((info (lambda-var-arg-info var)))
489     (when (eq (arg-info-keyword info) name)
490     (let ((dummy (gensym))
491     (temp (gensym)))
492     (temps dummy temp)
493     (ignores dummy)
494     (supplied (cons var temp)))
495     (return)))))))
496    
497     (when (and loser (not (optional-dispatch-allowp fun)))
498     (compiler-warning "Function called with unknown argument keyword ~S."
499     loser)
500     (setf (ref-inlinep ref) :notinline)
501     (return-from convert-keyword-call))
502    
503     (collect ((call-args))
504     (do ((var arglist (cdr var))
505     (temp (temps) (cdr temp)))
506     (())
507     (let ((info (lambda-var-arg-info (car var))))
508     (if info
509     (case (arg-info-kind info)
510     (:optional
511     (call-args (car temp))
512     (when (arg-info-supplied-p info)
513     (call-args t)))
514     (t
515     (return)))
516     (call-args (car temp)))))
517    
518     (dolist (var (key-vars))
519     (let ((info (lambda-var-arg-info var))
520     (temp (cdr (assoc var (supplied)))))
521     (if temp
522     (call-args temp)
523     (call-args (arg-info-default info)))
524     (when (arg-info-supplied-p info)
525     (call-args (not (null temp))))))
526    
527     (convert-hairy-fun-entry ref call (optional-dispatch-main-entry fun)
528     (temps) (ignores) (call-args)))))
529    
530     (undefined-value))
531    
532    
533     ;;;; Let conversion:
534     ;;;
535     ;;; Converting to a let has differing significance to various parts of the
536     ;;; compiler:
537     ;;; -- The body of a Let is spliced in immediately after the the corresponding
538     ;;; combination node, making the control transfer explicit and allowing lets
539     ;;; to mashed together into a single block. The value of the let is
540     ;;; delivered directly to the original continuation for the call,
541     ;;; eliminating the need to propagate information from the dummy result
542     ;;; continuation.
543     ;;; -- As far as IR1 optimization is concerned, it is interesting in that there
544     ;;; is only one expression that the variable can be bound to, and this is
545     ;;; easily substitited for.
546     ;;; -- Lets are interesting to environment analysis and the back end because in
547     ;;; most ways a let can be considered to be "the same function" as its home
548     ;;; function.
549     ;;; -- Let conversion has dynamic scope implications, since control transfers
550     ;;; within the same environment are local. In a local control transfer,
551     ;;; cleanup code must be emitted to remove dynamic bindings that are no
552     ;;; longer in effect.
553    
554    
555 ram 1.6 ;;; Merge-Lets -- Internal
556 wlott 1.1 ;;;
557     ;;; Handle the environment semantics of let conversion. We add the lambda
558 ram 1.6 ;;; and its lets to lets for the call's home function. We merge the calls for
559     ;;; Fun with the calls for the home function, removing Fun in the process. We
560     ;;; also merge the Entries.
561 wlott 1.1 ;;;
562 ram 1.6 (defun merge-lets (fun call)
563 wlott 1.1 (declare (type clambda fun) (type basic-combination call))
564     (let* ((prev (node-prev call))
565 ram 1.6 (home (block-home-lambda (continuation-block prev)))
566 ram 1.3 (home-env (lambda-environment home)))
567 wlott 1.1 (push fun (lambda-lets home))
568     (setf (lambda-home fun) home)
569 ram 1.3 (setf (lambda-environment fun) home-env)
570 wlott 1.1
571 ram 1.6 (let ((lets (lambda-lets fun)))
572 wlott 1.1 (dolist (let lets)
573 ram 1.3 (setf (lambda-home let) home)
574     (setf (lambda-environment let) home-env))
575 wlott 1.1
576     (setf (lambda-lets home) (nconc lets (lambda-lets home)))
577     (setf (lambda-lets fun) ()))
578    
579     (setf (lambda-calls home)
580     (nunion (lambda-calls fun)
581     (delete fun (lambda-calls home))))
582     (setf (lambda-calls fun) ())
583    
584     (setf (lambda-entries home)
585     (nconc (lambda-entries fun) (lambda-entries home)))
586     (setf (lambda-entries fun) ()))
587     (undefined-value))
588    
589    
590     ;;; Insert-Let-Body -- Internal
591     ;;;
592     ;;; Handle the control semantics of let conversion. We split the call block
593     ;;; immediately after the call, and link the head and tail of Fun to the call
594     ;;; block and the following block. We also unlink the function head and tail
595     ;;; from the component head and tail and flush the function from the
596     ;;; Component-Lambdas. We set Component-Reanalyze to true to indicate that the
597     ;;; DFO should be recomputed.
598     ;;;
599     (defun insert-let-body (fun call)
600     (declare (type clambda fun) (type basic-combination call))
601 ram 1.11 (setf (lambda-call-lexenv fun) (node-lexenv call))
602 wlott 1.1 (let* ((call-block (node-block call))
603     (bind-block (node-block (lambda-bind fun)))
604     (component (block-component call-block)))
605     (let ((*current-component* component))
606     (node-ends-block call))
607     (setf (component-lambdas component)
608     (delete fun (component-lambdas component)))
609     (assert (= (length (block-succ call-block)) 1))
610     (let ((next-block (first (block-succ call-block))))
611     (unlink-blocks call-block next-block)
612     (unlink-blocks (component-head component) bind-block)
613     (link-blocks call-block bind-block)
614     (let ((return (lambda-return fun)))
615     (when return
616     (let ((return-block (node-block return)))
617     (unlink-blocks return-block (component-tail component))
618     (link-blocks return-block next-block)))))
619     (setf (component-reanalyze component) t))
620     (undefined-value))
621    
622    
623     ;;; Move-Return-Uses -- Internal
624     ;;;
625     ;;; Handle the value semantics of let conversion. When Fun has a return
626     ;;; node, we delete it and move all the uses of the result continuation to
627     ;;; Call's Cont.
628     ;;;
629     ;;; If the actual continuation is only used by the let call, then we
630     ;;; intersect the type assertion on the dummy continuation with the assertion
631     ;;; for the actual continuation; in all other cases assertions on the dummy
632     ;;; continuation are lost.
633     ;;;
634 ram 1.7 ;;; We also intersect the derived type of the call with the derived type of
635     ;;; all the dummy continuation's uses. This serves mainly to propagate
636     ;;; TRULY-THE through lets.
637     ;;;
638 wlott 1.1 (defun move-return-uses (fun call)
639     (declare (type clambda fun) (type basic-combination call))
640     (let ((return (lambda-return fun)))
641     (when return
642     (unlink-node return)
643     (delete-return return)
644    
645     (let ((result (return-result return))
646 ram 1.7 (cont (node-cont call))
647     (call-type (node-derived-type call)))
648 wlott 1.1 (when (eq (continuation-use cont) call)
649     (assert-continuation-type cont (continuation-asserted-type result)))
650 ram 1.7 (unless (eq call-type *wild-type*)
651     (do-uses (use result)
652     (derive-node-type use call-type)))
653    
654 wlott 1.1 (delete-continuation-use call)
655     (add-continuation-use call (node-prev (lambda-bind fun)))
656     (substitute-continuation-uses cont result))))
657    
658     (undefined-value))
659    
660    
661     ;;; Let-Convert -- Internal
662     ;;;
663     ;;; Actually do let conversion. We call subfunctions to do most of the
664     ;;; work. We change the Call's cont to be the continuation heading the bind
665     ;;; block, and also do Reoptimize-Continuation on the args and Cont so that
666 ram 1.5 ;;; let-specific IR1 optimizations get a chance. We blow away any entry for
667     ;;; the function in *free-functions* so that nobody will create new reference
668     ;;; to it.
669 wlott 1.1 ;;;
670     (defun let-convert (fun call)
671     (declare (type clambda fun) (type basic-combination call))
672 ram 1.2 (insert-let-body fun call)
673 ram 1.6 (merge-lets fun call)
674 wlott 1.1 (move-return-uses fun call)
675 ram 1.5
676     (let* ((fun (or (lambda-optional-dispatch fun) fun))
677     (entry (gethash (leaf-name fun) *free-functions*)))
678     (when (eq entry fun)
679     (remhash (leaf-name fun) *free-functions*)))
680 wlott 1.1
681     (dolist (arg (basic-combination-args call))
682     (when arg
683     (reoptimize-continuation arg)))
684     (reoptimize-continuation (node-cont call))
685     (undefined-value))
686    
687    
688     ;;; Maybe-Let-Convert -- Interface
689     ;;;
690     ;;; This function is called when there is some reason to believe that
691     ;;; the lambda Fun might be converted into a let. This is done after local
692     ;;; call analysis, and also when a reference is deleted. We only convert to a
693     ;;; let when the function is a normal local function, has no XEP, and is
694     ;;; referenced in exactly one local call. Conversion is also inhibited if the
695     ;;; only reference is in a block about to be deleted.
696     ;;;
697     ;;; These rules may seem unnecessarily restrictive, since there are some
698     ;;; cases where we could do the return with a jump that don't satisfy these
699     ;;; requirements. The reason for doing things this way is that it makes the
700     ;;; concept of a let much more useful at the level of IR1 semantics. Low-level
701     ;;; control and environment optimizations can always be done later on.
702     ;;;
703     ;;; We don't attempt to convert calls to functions that have an XEP, since
704     ;;; we might be embarrassed later when we want to convert a newly discovered
705     ;;; local call.
706     ;;;
707     (defun maybe-let-convert (fun)
708     (declare (type clambda fun))
709     (let ((refs (leaf-refs fun)))
710     (when (and refs (null (rest refs))
711     (not (block-delete-p (node-block (first refs))))
712     (not (functional-kind fun))
713     (not (functional-entry-function fun)))
714     (let* ((ref-cont (node-cont (first refs)))
715     (dest (continuation-dest ref-cont)))
716     (when (and (basic-combination-p dest)
717     (eq (basic-combination-fun dest) ref-cont)
718     (eq (basic-combination-kind dest) :local))
719     (let-convert fun dest)
720     (setf (functional-kind fun)
721     (if (mv-combination-p dest) :mv-let :let))))))
722     (undefined-value))

  ViewVC Help
Powered by ViewVC 1.1.5