Skip to content
Snippets Groups Projects
Commit 1b800016 authored by ram's avatar ram
Browse files

Don't call valid-function-use on mv-combinations. Don't annotate mv-calls to

inline functions or slot accessors as though they were non-mv calls.
parent a2889c6b
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/byte-comp.lisp,v 1.23 1994/03/07 11:35:30 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/byte-comp.lisp,v 1.24 1994/03/19 22:38:45 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -508,44 +508,50 @@ ...@@ -508,44 +508,50 @@
(args (basic-combination-args call)) (args (basic-combination-args call))
(name (continuation-function-name fun)) (name (continuation-function-name fun))
(info (gethash name *inline-function-table*))) (info (gethash name *inline-function-table*)))
(cond ((and info (flet ((annotate-args ()
(valid-function-use call (inline-function-info-type info))) (annotate-basic-combination-args call)
(annotate-basic-combination-args call)
(setf (node-tail-p call) nil)
(setf (basic-combination-info call) info)
(annotate-continuation fun 0)
(when (inline-function-info-safe info)
(dolist (arg args) (dolist (arg args)
(when (continuation-type-check arg) (when (continuation-type-check arg)
(setf (continuation-%type-check arg) :deleted))))) (setf (continuation-%type-check arg) :deleted)))
((and (mv-combination-p call) (eq name '%throw)) (annotate-continuation
(assert (= (length args) 2)) fun
(annotate-continuation (first args) 1) (if (continuation-function-name fun) :fdefinition 1))))
(annotate-continuation (second args) :unknown) (cond ((mv-combination-p call)
(setf (node-tail-p call) nil) (cond ((eq name '%throw)
(annotate-continuation fun 0)) (assert (= (length args) 2))
((and name (annotate-continuation (first args) 1)
(let ((leaf (ref-leaf (continuation-use fun)))) (annotate-continuation (second args) :unknown)
(and (slot-accessor-p leaf) (setf (node-tail-p call) nil)
(or (policy call (zerop safety)) (annotate-continuation fun 0))
(not (find 't args :key #'continuation-type-check))) (t
(if (consp name) (annotate-args))))
(not (continuation-dest (node-cont call))) ((and info
t)))) (valid-function-use call (inline-function-info-type info)))
(setf (basic-combination-info call) (annotate-basic-combination-args call)
(gethash (if (consp name) '%setf-instance-ref '%instance-ref) (setf (node-tail-p call) nil)
*inline-function-table*)) (setf (basic-combination-info call) info)
(setf (node-tail-p call) nil) (annotate-continuation fun 0)
(annotate-continuation fun 0) (when (inline-function-info-safe info)
(annotate-basic-combination-args call)) (dolist (arg args)
(t (when (continuation-type-check arg)
(annotate-basic-combination-args call) (setf (continuation-%type-check arg) :deleted)))))
(dolist (arg args) ((and name
(when (continuation-type-check arg) (let ((leaf (ref-leaf (continuation-use fun))))
(setf (continuation-%type-check arg) :deleted))) (and (slot-accessor-p leaf)
(annotate-continuation (or (policy call (zerop safety))
fun (not (find 't args
(if (continuation-function-name fun) :fdefinition 1))))) :key #'continuation-type-check)))
(if (consp name)
(not (continuation-dest (node-cont call)))
t))))
(setf (basic-combination-info call)
(gethash (if (consp name) '%setf-instance-ref '%instance-ref)
*inline-function-table*))
(setf (node-tail-p call) nil)
(annotate-continuation fun 0)
(annotate-basic-combination-args call))
(t
(annotate-args)))))
;; If this is (still) a tail-call, then blow away the return. ;; If this is (still) a tail-call, then blow away the return.
(when (node-tail-p call) (when (node-tail-p call)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment