X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;ds=inline;f=src%2Fprimitives.cl;h=c113bdfd6156d12aa3520226d2abf60a782a8266;hb=e1ba5e8ff148275ed252b179f43a4b045c1dcaf6;hp=ee529806dcd8a55c3f981be65c9d2a4337936ba0;hpb=4dad9a2d968de896ec97c7470620ab921fcf275f;p=uffi.git diff --git a/src/primitives.cl b/src/primitives.cl index ee52980..c113bdf 100644 --- a/src/primitives.cl +++ b/src/primitives.cl @@ -1,4 +1,4 @@ -;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- +;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; @@ -7,7 +7,7 @@ ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Feb 2002 ;;;; -;;;; $Id: primitives.cl,v 1.5 2002/03/14 21:32:23 kevin Exp $ +;;;; $Id: primitives.cl,v 1.10 2002/03/18 22:47:57 kevin Exp $ ;;;; ;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg ;;;; @@ -19,11 +19,11 @@ (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) (in-package :uffi) -(defmacro def-constant (name value) +(defmacro def-constant (name value &key (export nil)) "Macro to define a constant and to export it" `(eval-when (:compile-toplevel :load-toplevel :execute) (defconstant ,name ,value) - (export ',name))) + ,(if export (list 'export `(quote ,name)) (values)))) (defmacro def-type (name type) "Generates a (deftype) statement for CL. Currently, only CMUCL @@ -37,11 +37,8 @@ supports takes advantage of this optimization." ) (defmacro null-char-p (val) - `(if (or (eql ,val 0) - (eq ,val #\Null)) - t - nil)) - + "Returns T if character is NULL" + `(zerop ,val)) (defmacro def-foreign-type (name type) #+lispworks `(fli:define-c-typedef ,name ,(convert-from-uffi-type type :type)) @@ -78,6 +75,8 @@ supports takes advantage of this optimization." (:char . c-call:char) (:unsigned-char . (alien:unsigned 8)) (:byte . (alien:unsigned 8)) + (:short . c-call:unsigned-short) + (:unsigned-short . c-call:unsigned-short) (:int . alien:integer) (:unsigned-int . c-call:unsigned-int) (:long . c-call:long) (:unsigned-long . c-call:unsigned-long) (:float . c-call:float) (:double . c-call:double) @@ -87,7 +86,7 @@ supports takes advantage of this optimization." '((* . *) (:void . :void) (:short . :short) (:pointer-void . (* :void)) - (:cstring . (* :char)) + (:cstring . (* :unsigned-char)) (:char . :char) (:unsigned-char . :unsigned-char) (:byte . :byte) @@ -99,9 +98,10 @@ supports takes advantage of this optimization." (defconstant +type-conversion-list+ '((* . :pointer) (:void . :void) (:short . :short) - (:pointer-void . (:pointer :void)) - (:cstring . (:pointer :char)) - (:char . :char) + (:pointer-void . (:pointer :unsigned :void)) + (:cstring . (:pointer (:unsigned :char))) + (:char . :char) + (:byte :byte) (:unsigned-char . (:unsigned :char)) (:int . :int) (:unsigned-int . (:unsigned :int)) (:long . :long) (:unsigned-long . (:unsigned :long))