X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgtn.lisp;h=3d6c0c857974250e7b65e4d8ed2f985ffb3b5c5d;hb=8dd43b84a688fde72f6d957c59f7207d539990f7;hp=0aa7f2bfac4f889c85bde5e326f8bd8f7011706d;hpb=b05f52060838600d14b5d8ad4604a61351dd7017;p=sbcl.git diff --git a/src/compiler/gtn.lisp b/src/compiler/gtn.lisp index 0aa7f2b..3d6c0c8 100644 --- a/src/compiler/gtn.lisp +++ b/src/compiler/gtn.lisp @@ -84,12 +84,11 @@ (values)) -;;; Return true if FUN's result continuation is used in a -;;; tail-recursive full call. We only consider explicit :FULL calls. -;;; It is assumed that known calls are never part of a tail-recursive -;;; loop, so we don't need to enforce tail-recursion. In any case, we -;;; don't know which known calls will actually be full calls until -;;; after LTN. +;;; Return true if FUN's result is used in a tail-recursive full +;;; call. We only consider explicit :FULL calls. It is assumed that +;;; known calls are never part of a tail-recursive loop, so we don't +;;; need to enforce tail-recursion. In any case, we don't know which +;;; known calls will actually be full calls until after LTN. (defun has-full-call-use (fun) (declare (type clambda fun)) (let ((return (lambda-return fun))) @@ -116,12 +115,11 @@ (block punt (dolist (fun funs t) (dolist (ref (leaf-refs fun)) - (let* ((cont (node-cont ref)) - (dest (continuation-dest cont))) - (when (and dest + (let* ((lvar (node-lvar ref)) + (dest (and lvar (lvar-dest lvar)))) + (when (and (basic-combination-p dest) (not (node-tail-p dest)) - (basic-combination-p dest) - (eq (basic-combination-fun dest) cont) + (eq (basic-combination-fun dest) lvar) (eq (basic-combination-kind dest) :local)) (return-from punt nil))))))))) @@ -137,7 +135,7 @@ inhibit-warnings)) (dolist (fun funs (let ((*compiler-error-context* (lambda-bind (first funs)))) - (compiler-note + (compiler-notify "Return value count mismatch prevents known return ~ from these functions:~ ~{~% ~A~}" @@ -150,7 +148,7 @@ (declare (ignore ignore)) (when (eq count :unknown) (let ((*compiler-error-context* (lambda-bind fun))) - (compiler-note + (compiler-notify "Return type not fixed values, so can't use known return ~ convention:~% ~S" (type-specifier rtype))) @@ -167,7 +165,8 @@ (multiple-value-bind (types count) (values-types (tail-set-type tails)) (let ((ptypes (mapcar #'primitive-type types)) (use-standard (use-standard-returns tails))) - (when (and (eq count :unknown) (not use-standard)) + (when (and (eq count :unknown) (not use-standard) + (not (eq (tail-set-type tails) *empty-type*))) (return-value-efficiency-note tails)) (if (or (eq count :unknown) use-standard) (make-return-info :kind :unknown