X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-alieneval.lisp;h=f399057c88f2a3de79461e90d32746d5e88ef465;hb=90ca09b75fbc3b63b2f7d09c67b04b866dd783f6;hp=67daaec2d617188bc26e2d6b7b86b52204ccbb9c;hpb=416152f084604094445a758ff399871132dff2bd;p=sbcl.git diff --git a/src/code/target-alieneval.lisp b/src/code/target-alieneval.lisp index 67daaec..f399057 100644 --- a/src/code/target-alieneval.lisp +++ b/src/code/target-alieneval.lisp @@ -45,7 +45,7 @@ (error "badly formed alien name")) (values (cadr name) (car name)))))) -(defmacro def-alien-variable (name type &environment env) +(defmacro define-alien-variable (name type &environment env) #!+sb-doc "Define NAME as an external alien variable of type TYPE. NAME should be a list of a string holding the alien name and a symbol to use as the Lisp @@ -57,13 +57,17 @@ `(eval-when (:compile-toplevel :load-toplevel :execute) ,@(when *new-auxiliary-types* `((%def-auxiliary-alien-types ',*new-auxiliary-types*))) - (%def-alien-variable ',lisp-name - ',alien-name - ',alien-type)))))) + (%define-alien-variable ',lisp-name + ',alien-name + ',alien-type)))))) -;;; Do the actual work of DEF-ALIEN-VARIABLE. +(defmacro def-alien-variable (&rest rest) + (deprecation-warning 'def-alien-variable 'define-alien-variable) + `(define-alien-variable ,@rest)) + +;;; Do the actual work of DEFINE-ALIEN-VARIABLE. (eval-when (:compile-toplevel :load-toplevel :execute) - (defun %def-alien-variable (lisp-name alien-name type) + (defun %define-alien-variable (lisp-name alien-name type) (setf (info :variable :kind lisp-name) :alien) (setf (info :variable :where-from lisp-name) :defined) (clear-info :variable :constant-value lisp-name) @@ -325,7 +329,7 @@ (let* ((field (slot-or-lose type slot)) (offset (alien-record-field-offset field)) (field-type (alien-record-field-type field))) - (%sap-alien (sap+ (alien-sap alien) (/ offset sb!vm:byte-bits)) + (%sap-alien (sap+ (alien-sap alien) (/ offset sb!vm:n-byte-bits)) (make-alien-pointer-type :to field-type))))))) ;;;; the DEREF operator @@ -341,7 +345,7 @@ (etypecase type (alien-pointer-type (when (cdr indices) - (error "too many indices when derefing ~S: ~D" + (error "too many indices when DEREF'ing ~S: ~W" type (length indices))) (let ((element-type (alien-pointer-type-to type))) @@ -353,7 +357,7 @@ 0)))) (alien-array-type (unless (= (length indices) (length (alien-array-type-dimensions type))) - (error "incorrect number of indices when derefing ~S: ~D" + (error "incorrect number of indices when DEREF'ing ~S: ~W" type (length indices))) (labels ((frob (dims indices offset) (if (null dims) @@ -399,7 +403,7 @@ (type list indices) (optimize (inhibit-warnings 3))) (multiple-value-bind (target-type offset) (deref-guts alien indices) - (%sap-alien (sap+ (alien-value-sap alien) (/ offset sb!vm:byte-bits)) + (%sap-alien (sap+ (alien-value-sap alien) (/ offset sb!vm:n-byte-bits)) (make-alien-pointer-type :to target-type)))) ;;;; accessing heap alien variables @@ -495,11 +499,11 @@ (optimize (inhibit-warnings 3))) (if (or (alien-pointer-type-p target-type) (alien-array-type-p target-type) - (alien-function-type-p target-type)) + (alien-fun-type-p target-type)) (let ((alien-type (alien-value-type alien))) (if (or (alien-pointer-type-p alien-type) (alien-array-type-p alien-type) - (alien-function-type-p alien-type)) + (alien-fun-type-p alien-type)) (naturalize (alien-value-sap alien) target-type) (error "~S cannot be casted." alien))) (error "cannot cast to alien type ~S" (unparse-alien-type target-type)))) @@ -516,8 +520,8 @@ (values (ceiling bits (ecase units (:bits 1) - (:bytes sb!vm:byte-bits) - (:words sb!vm:word-bits)))) + (:bytes sb!vm:n-byte-bits) + (:words sb!vm:n-word-bits)))) (error "unknown size for alien type ~S" (unparse-alien-type alien-type))))) @@ -547,7 +551,7 @@ (funcall (coerce (compute-deposit-lambda type) 'function) sap offset type value)) -;;;; ALIEN-FUNCALL, DEF-ALIEN-ROUTINE +;;;; ALIEN-FUNCALL, DEFINE-ALIEN-ROUTINE (defun alien-funcall (alien &rest args) #!+sb-doc @@ -558,14 +562,14 @@ (typecase type (alien-pointer-type (apply #'alien-funcall (deref alien) args)) - (alien-function-type - (unless (= (length (alien-function-type-arg-types type)) + (alien-fun-type + (unless (= (length (alien-fun-type-arg-types type)) (length args)) - (error "wrong number of arguments for ~S~%expected ~D, got ~D" + (error "wrong number of arguments for ~S~%expected ~W, got ~W" type - (length (alien-function-type-arg-types type)) + (length (alien-fun-type-arg-types type)) (length args))) - (let ((stub (alien-function-type-stub type))) + (let ((stub (alien-fun-type-stub type))) (unless stub (setf stub (let ((fun (gensym)) @@ -574,14 +578,16 @@ `(lambda (,fun ,@parms) (declare (type (alien ,type) ,fun)) (alien-funcall ,fun ,@parms))))) - (setf (alien-function-type-stub type) stub)) + (setf (alien-fun-type-stub type) stub)) (apply stub alien args))) (t (error "~S is not an alien function." alien))))) -(defmacro def-alien-routine (name result-type &rest args &environment lexenv) +(defmacro define-alien-routine (name result-type + &rest args + &environment lexenv) #!+sb-doc - "DEF-ALIEN-ROUTINE Name Result-Type {(Arg-Name Arg-Type [Style])}* + "DEFINE-ALIEN-ROUTINE Name Result-Type {(Arg-Name Arg-Type [Style])}* Define a foreign interface function for the routine with the specified NAME. Also automatically DECLAIM the FTYPE of the defined function. @@ -653,7 +659,7 @@ ;; anyway, and (2) such a declamation can be (especially for ;; alien values) both messy to do by hand and very important ;; for performance of later code which uses the return value. - (declaim (ftype (function (mapcar (constantly t) ',args) + (declaim (ftype (function ,(mapcar (constantly t) args) (alien ,result-type)) ,lisp-name)) @@ -672,6 +678,10 @@ (values ,@temps ,@(results)))) `(values (alien-funcall ,lisp-name ,@(alien-args)) ,@(results))))))))) + +(defmacro def-alien-routine (&rest rest) + (deprecation-warning 'def-alien-routine 'define-alien-routine) + `(define-alien-routine ,@rest)) (defun alien-typep (object type) #!+sb-doc