X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Faliencomp.lisp;h=487b61985412be369f5bf3e41e257155a1c06b8b;hb=b7a8f5313a83dea33ce60551a4fb987b415c2cc6;hp=80176a6c51f149870d5fb680f9b6b7c9f9178fcf;hpb=0a82f2db352cc348d2107a882e50af222ff97ed3;p=sbcl.git diff --git a/src/compiler/aliencomp.lisp b/src/compiler/aliencomp.lisp index 80176a6..487b619 100644 --- a/src/compiler/aliencomp.lisp +++ b/src/compiler/aliencomp.lisp @@ -68,7 +68,6 @@ (defknown alien-funcall (alien-value &rest *) * (any recursive)) -(defknown %alien-funcall (system-area-pointer alien-type &rest *) *) ;;;; cosmetic transforms @@ -186,7 +185,7 @@ (typecase alien-type (alien-pointer-type (when (cdr indices) - (abort-ir1-transform "too many indices for pointer deref: ~D" + (abort-ir1-transform "too many indices for pointer deref: ~W" (length indices))) (let ((element-type (alien-pointer-type-to alien-type))) (if indices @@ -470,7 +469,7 @@ (let ((alien-node (continuation-use alien))) (typecase alien-node (combination - (extract-function-args alien '%sap-alien 2) + (extract-fun-args alien '%sap-alien 2) '(lambda (sap type) (declare (ignore type)) sap)) @@ -582,7 +581,7 @@ (unless (and (constant-continuation-p inside-amount) (not (minusp (continuation-value inside-amount)))) (give-up-ir1-transform))))) - (extract-function-args value 'ash 2) + (extract-fun-args value 'ash 2) '(lambda (value amount1 amount2) (ash value (+ amount1 amount2)))) @@ -607,7 +606,7 @@ (let ((arg-types (alien-fun-type-arg-types alien-type))) (unless (= (length args) (length arg-types)) (abort-ir1-transform - "wrong number of arguments; expected ~D, got ~D" + "wrong number of arguments; expected ~W, got ~W" (length arg-types) (length args))) (collect ((params) (deports)) @@ -640,7 +639,7 @@ (let ((type (continuation-value type))) (unless (alien-fun-type-p type) (error "Something is broken.")) - (specifier-type + (values-specifier-type (compute-alien-rep-type (alien-fun-type-result-type type))))) @@ -648,9 +647,9 @@ ((function type &rest args) node ltn-policy) (setf (basic-combination-info node) :funny) (setf (node-tail-p node) nil) - (annotate-ordinary-continuation function ltn-policy) + (annotate-ordinary-continuation function) (dolist (arg args) - (annotate-ordinary-continuation arg ltn-policy))) + (annotate-ordinary-continuation arg))) (defoptimizer (%alien-funcall ir2-convert) ((function type &rest args) call block)