X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-alieneval.lisp;h=1c421f107fe433640aff321679401721a509d881;hb=854a7c8f6987e05b6aebe186f30b7e125693afaf;hp=7a6e04195f20e5da8c70d844609d47b537fd68fc;hpb=adeddfb8570bb924b4899679912b4629008b7566;p=sbcl.git diff --git a/src/code/target-alieneval.lisp b/src/code/target-alieneval.lisp index 7a6e041..1c421f1 100644 --- a/src/code/target-alieneval.lisp +++ b/src/code/target-alieneval.lisp @@ -235,7 +235,7 @@ (when (constantp size) (setf alien-type (copy-alien-array-type alien-type)) (setf (alien-array-type-dimensions alien-type) - (cons (eval size) (cdr dims))))) + (cons (constant-form-value size) (cdr dims))))) (dims (setf size (car dims))) (t @@ -587,37 +587,6 @@ (t (error "~S is not an alien function." alien))))) -(defun alien-funcall-stdcall (alien &rest args) - #!+sb-doc - "Call the foreign function ALIEN with the specified arguments. ALIEN's - type specifies the argument and result types." - (declare (type alien-value alien)) - (let ((type (alien-value-type alien))) - (typecase type - (alien-pointer-type - (apply #'alien-funcall-stdcall (deref alien) args)) - (alien-fun-type - (unless (= (length (alien-fun-type-arg-types type)) - (length args)) - (error "wrong number of arguments for ~S~%expected ~W, got ~W" - type - (length (alien-fun-type-arg-types type)) - (length args))) - (let ((stub (alien-fun-type-stub type))) - (unless stub - (setf stub - (let ((fun (gensym)) - (parms (make-gensym-list (length args)))) - (compile nil - `(lambda (,fun ,@parms) - (declare (optimize (sb!c::insert-step-conditions 0))) - (declare (type (alien ,type) ,fun)) - (alien-funcall-stdcall ,fun ,@parms))))) - (setf (alien-fun-type-stub type) stub)) - (apply stub alien args))) - (t - (error "~S is not an alien function." alien))))) - (defmacro define-alien-routine (name result-type &rest args &environment lexenv) @@ -828,6 +797,7 @@ ENTER-ALIEN-CALLBACK pulls the corresponsing trampoline out and calls it.") (sb!kernel:get-lisp-obj-address args-pointer))) (res-sap (int-sap (sb!kernel:get-lisp-obj-address result-pointer)))) + (declare (ignorable args-sap res-sap)) (with-alien ,(loop with offset = 0 @@ -895,6 +865,11 @@ ENTER-ALIEN-CALLBACK pulls the corresponsing trampoline out and calls it.") return arguments)) +;;; To ensure that callback wrapper functions continue working even +;;; if #'ENTER-ALIEN-CALLBACK moves in memory, access to it is indirected +;;; through the *ENTER-ALIEN-CALLBACK* static symbol. -- JES, 2006-01-01 +(defvar *enter-alien-callback* #'enter-alien-callback) + ;;;; interface (not public, yet) for alien callbacks (defmacro alien-callback (specifier function &environment env)