--- /dev/null
+;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: aggregates.cl
+;;;; Purpose: UFFI source to handle aggregate types
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: aggregates.cl,v 1.1 2002/04/04 04:56:46 desoi Exp $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; UFFI users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :uffi)
+
+
+;;;
+;;; AGGREGATE SUPPORT IS NOT COMPLETE FOR MCL
+;;;
+
+;! Need to finish enums, records and variants (unions)
+
+(defmacro def-enum (enum-name args &key (separator-string "#"))
+ "Creates a constants for a C type enum list, symbols are created
+in the created in the current package. The symbol is the concatenation
+of the enum-name name, separator-string, and field-name"
+ (let ((counter 0)
+ (cmds nil)
+ (constants nil))
+ (declare (fixnum counter))
+ (dolist (arg args)
+ (let ((name (if (listp arg) (car arg) arg))
+ (value (if (listp arg)
+ (prog1
+ (setq counter (cadr arg))
+ (incf counter))
+ (prog1
+ counter
+ (incf counter)))))
+ (setq name (intern (concatenate 'string
+ (symbol-name enum-name)
+ separator-string
+ (symbol-name name))))
+ (push `(uffi:def-constant ,name ,value) constants)))
+ (setf cmds (append '(progn)
+ #+allegro `((ff:def-foreign-type ,enum-name :int))
+ #+lispworks `((fli:define-c-typedef ,enum-name :int))
+ #+cmu `((alien:def-alien-type ,enum-name alien:signed))
+ (nreverse constants)))
+ cmds))
+
+
+#|
+(defmacro def-array-pointer (name-array type)
+ #+allegro
+ `(ff:def-foreign-type ,name-array
+ (:array ,(convert-from-uffi-type type :array)))
+ #+lispworks
+ `(fli:define-c-typedef ,name-array
+ (:c-array ,(convert-from-uffi-type type :array)))
+ #+cmu
+ `(alien:def-alien-type ,name-array
+ (* ,(convert-from-uffi-type type :array)))
+ )
+
+|#
+
+; this is how rref expands array slot access (minus adding the struct offset)
+(defmacro deref-array (obj type i)
+ "Returns a field from a row"
+ `(,(accessor-symbol type :get) ,obj (* (the fixnum ,i) ,(foreign-object-size type))))
+
+(defmacro deref-array-set (obj type i value)
+ `(,(accessor-symbol type :set) ,obj ,value (* (the fixnum ,i) ,(foreign-object-size type))))
+
+(defsetf deref-array deref-array-set)
+
+
+
+(defun process-struct-fields (name fields)
+ (let (processed)
+ (dolist (field fields)
+ (let ((field-name (car field))
+ (type (cadr field)))
+ (push (append (list field-name)
+ (if (eq type :pointer-self)
+ #+cmu `((* (alien:struct ,name)))
+ #-cmu `((* ,name))
+ `(,(convert-from-uffi-type type :struct))))
+ processed)))
+ (nreverse processed)))
+
+
+(defmacro def-struct (name &rest fields)
+ `(ccl:defrecord ,name ,@(process-struct-fields name fields))
+ )
+
+
+(defmacro def-union (name &rest fields)
+ `(ccl:defrecord ,name ,@(process-struct-fields name fields))
+ )
+
+
+#| not done for mcl
+(defmacro get-slot-value (obj type slot)
+ (declare (ignore type))
+ #+allegro
+ `(ff:fslot-value-typed ,type :c ,obj ,slot)
+ #+lispworks
+ `(fli:foreign-slot-value ,obj ,slot)
+ #+cmu
+ `(alien:slot ,obj ,slot)
+ )
+
+(defmacro get-slot-pointer (obj type slot)
+ #+(or lispworks cmu) (declare (ignore type))
+ #+allegro
+ `(ff:fslot-value-typed ,type :c ,obj ,slot)
+ #+lispworks
+ `(fli:foreign-slot-pointer ,obj ,slot)
+ #+cmu
+ `(alien:slot ,obj ,slot)
+ )
+
+|#
+
--- /dev/null
+;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: function.cl
+;;;; Purpose: UFFI source to C function defintions
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: functions.cl,v 1.1 2002/04/04 05:01:45 desoi Exp $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; UFFI users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :uffi)
+
+(defun process-function-args (args)
+ (if (null args)
+ #+lispworks nil
+ #+allegro '(:void)
+ #+cmu nil
+ #+mcl nil
+ (let (processed)
+ (dolist (arg args)
+ (push (process-one-function-arg arg) processed))
+ (nreverse processed))))
+
+(defun process-one-function-arg (arg)
+ (let ((name (car arg))
+ (type (convert-from-uffi-type (cadr arg) :routine)))
+ (if (and (listp type) (listp (car type)))
+ (append (list name) type)
+ (list name type))
+ ))
+
+(defun allegro-convert-return-type (type)
+ (if (and (listp type) (not (listp (car type))))
+ (list type)
+ type))
+
+;; name is either a string representing foreign name, or a list
+;; of foreign-name as a string and lisp name as a symbol
+
+
+(defmacro def-function (names args &key module returning)
+ (declare (ignore module))
+
+ (let* ((result-type (convert-from-uffi-type returning :return))
+ (function-args (process-function-args args))
+ (foreign-name (if (atom names) names (car names)))
+ (lisp-name (if (atom names) (make-lisp-name names) (cadr names))))
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (ccl:define-entry-point (,lisp-name ,foreign-name)
+ ,function-args
+ ,result-type))))
+
+
+(defun make-lisp-name (name)
+ (let ((converted (substitute #\- #\_ name)))
+ (intern
+ #+case-sensitive converted
+ #-case-sensitive (string-upcase converted))))
+
+
--- /dev/null
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: libraries.cl
+;;;; Purpose: UFFI source to load foreign libraries
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: libraries.cl,v 1.1 2002/04/04 05:02:03 desoi Exp $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; UFFI users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :uffi)
+
+(defvar *loaded-libraries* nil
+ "List of foreign libraries loaded. Used to prevent reloading a library")
+
+
+(defmacro load-foreign-library (filename &key module supporting-libraries)
+ (declare (ignore module supporting-libraries))
+ `(eval-when (:compile-toplevel :load-toplevel :execute)
+ (when (ccl:add-to-shared-library-search-path ,filename t)
+ (pushnew filename *loaded-libraries*))))
+
+(defun convert-supporting-libraries-to-string (libs)
+ (let (lib-load-list)
+ (dolist (lib libs)
+ (push (format nil "-l~A" lib) lib-load-list))
+ (nreverse lib-load-list)))
--- /dev/null
+;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: objects.cl
+;;;; Purpose: UFFI source to handle objects and pointers
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: objects.cl,v 1.1 2002/04/04 05:02:27 desoi Exp $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; UFFI users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :uffi)
+
+
+;;;
+;;; Some MCL specific utilities
+;;;
+(defun foreign-object-size (type)
+ "Returns the size for the specified mcl type or record type"
+ (let ((mcl-type (ccl:find-mactype type nil t)))
+ (if mcl-type
+ (ccl::mactype-record-size mcl-type)
+ (ccl:record-length (ccl:find-record-descriptor type t t)) ) ) ) ;error if not a record
+
+
+; trap macros don't work right directly in the macros
+(eval-when (:compile-toplevel :load-toplevel :execute)
+
+(defun new-ptr (size)
+ (#_NewPtr size))
+
+(defun dispose-ptr (ptr)
+ (#_DisposePtr ptr))
+
+)
+
+;;;
+;;; Start of standard UFFI
+;;;
+(defmacro allocate-foreign-object (type &optional (size :unspecified))
+ "Allocates an instance of TYPE. If size is specified, then allocate
+an array of TYPE with size SIZE."
+ (if (eq size :unspecified)
+ `(new-ptr ,(foreign-object-size (convert-from-uffi-type type :allocation)))
+ `(new-ptr ,(* size (foreign-object-size (convert-from-uffi-type type :allocation))))))
+
+
+
+(defmacro free-foreign-object (obj)
+ `(dispose-ptr ,obj))
+
+(defmacro null-pointer-p (obj)
+ `(ccl:%null-ptr-p ,obj))
+
+
+(defmacro make-null-pointer (type)
+ (declare (ignore type))
+ `(ccl:%null-ptr))
+
+
+;! need to check uffi update and see if :routine is the right context
+
+(defun accessor-symbol (type get-or-set)
+ "Returns the symbol used to access the foreign type."
+ (let* ((mcl-type (convert-from-uffi-type (eval type) :routine))
+ (mac-type (ccl:find-mactype mcl-type))
+ name)
+ (ecase get-or-set
+ (:get (setf name (ccl::mactype-get-function mac-type)))
+ (:set (setf name (ccl::mactype-set-function mac-type))))
+ (find-symbol (symbol-name name) :ccl)))
+
+(defmacro deref-pointer (ptr type)
+ `(,(accessor-symbol type :get) ,ptr))
+
+
+(defmacro deref-pointer-set (ptr type value)
+ `(,(accessor-symbol type :set) ,ptr ,value))
+
+
+(defsetf deref-pointer deref-pointer-set)
+
+
+(defmacro pointer-address (obj)
+ `(ccl:%ptr-to-int ,obj))
+
+
+(defmacro with-foreign-objects (bindings &rest body)
+ (let ((simple nil) (recs nil) type)
+ (dolist (spec (reverse bindings)) ;keep order - macroexpands to let*
+ (setf type (convert-from-uffi-type (eval (nth 1 spec)) :allocate))
+ (if (ccl:mactype-p type)
+ (push (list (first spec) (foreign-object-size type)) simple)
+ (push spec recs)))
+ (cond ((and simple recs)
+ `(ccl:%stack-block ,simple
+ (ccl:rlet ,recs
+ ,@body)))
+ (simple `(ccl:%stack-block ,simple ,@body))
+ (recs `(ccl:rlet ,recs ,@body)))))
+
+
+(defmacro with-foreign-object ((var type) &rest body)
+ `(with-foreign-objects ((,var ,type)) ,@body))
--- /dev/null
+;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: package.cl
+;;;; Purpose: Defines UFFI package
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; UFFI users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :cl-user)
+
+(defpackage :uffi
+ (:use :cl)
+ (:export
+
+ ;; immediate types
+ #:def-constant
+ #:def-foreign-type
+ #:def-type
+ #:null-char-p
+
+ ;; aggregate types
+ #:def-enum
+ #:def-struct
+ #:get-slot-value
+ #:get-slot-pointer
+ #:def-array-pointer
+ #:deref-array
+ #:def-union
+
+ ;; objects
+ #:allocate-foreign-object
+ #:free-foreign-object
+ #:with-foreign-object
+ #:with-foreign-objects
+ #:pointer-address
+ #:deref-pointer
+ #:ensure-char-character
+ #:ensure-char-integer
+ #:null-pointer-p
+ #:make-null-pointer
+ #:+null-cstring-pointer+
+ #:char-array-to-pointer
+
+ ;; string functions
+ #:convert-from-cstring
+ #:convert-to-cstring
+ #:free-cstring
+ #:with-cstring
+ #:with-cstrings
+ #:convert-from-foreign-string
+ #:convert-to-foreign-string
+ #:allocate-foreign-string
+ #:with-foreign-string
+
+ ;; function call
+ #:def-function
+
+ ;; Libraries
+ #:load-foreign-library
+
+ ;; Utilities
+ ))
--- /dev/null
+;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: primitives.cl
+;;;; Purpose: UFFI source to handle immediate types
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: primitives.cl,v 1.1 2002/04/04 05:03:14 desoi Exp $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; UFFI users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :uffi)
+
+
+(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)
+ ,(if export (list 'export `(quote ,name)) (values))))
+
+(defmacro def-type (name type)
+ "Generates a (deftype) statement for CL. Currently, only CMUCL
+supports takes advantage of this optimization."
+ (declare (ignore type))
+ `(deftype ,name () t))
+
+(defmacro null-char-p (val)
+ "Returns T if character is NULL"
+ `(zerop ,val))
+
+(defmacro def-foreign-type (name type)
+ `(ccl::def-mactype ,name ,(ccl:find-mactype (convert-from-uffi-type type :type))))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defvar +type-conversion-hash+ (make-hash-table :size 20)))
+
+
+(defconstant +type-conversion-list+
+ '((* . :pointer) (:void . :void)
+ (:short . :short)
+ (:pointer-void . :pointer)
+ (:cstring . :string)
+ (:char . :character)
+ (:unsigned-char . :unsigned-byte)
+ (:byte . :byte)
+ (:int . :integer) (:unsigned-int . :unsigned-integer)
+ (:long . :long) (:unsigned-long . :unsigned-long)
+ (:float . :single-float) (:double . :double-float)
+ (:array . :array)))
+
+(dolist (type +type-conversion-list+)
+ (setf (gethash (car type) +type-conversion-hash+) (cdr type)))
+
+
+(defmethod ph (&optional (os *standard-output*))
+ (maphash #'(lambda (k v) (format os "~&~S => ~S" k v)) +type-conversion-hash+))
+
+(defun convert-from-uffi-type (type context)
+ "Converts from a uffi type to an implementation specific type"
+ (if (atom type)
+ (cond
+ #+mcl
+ ((and (eq type :void) (eq context :return)) nil)
+ (t
+ (let ((found-type (gethash type +type-conversion-hash+)))
+ (if found-type
+ found-type
+ type))))
+ (cons (convert-from-uffi-type (first type) context)
+ (convert-from-uffi-type (rest type) context))))
+
+
+
+
+
+
--- /dev/null
+;;;; -*- Mode: ANSI-Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: UFFI -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name: strings.cl
+;;;; Purpose: UFFI source to handle strings, cstring and foreigns
+;;;; Programmer: Kevin M. Rosenberg
+;;;; Date Started: Feb 2002
+;;;;
+;;;; $Id: strings.cl,v 1.1 2002/04/04 05:03:38 desoi Exp $
+;;;;
+;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; UFFI users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
+(in-package :uffi)
+
+
+(defvar +null-cstring-pointer+ (ccl:%null-ptr))
+
+(defmacro convert-from-cstring (obj)
+ "Converts a string from a c-call. Same as convert-from-foreign-string, except
+that CMU automatically converts strings from c-calls."
+ #+cmu obj
+ #+lispworks
+ (let ((stored (gensym)))
+ `(let ((,stored ,obj))
+ (if (fli:null-pointer-p ,stored)
+ nil
+ (fli:convert-from-foreign-string ,stored))))
+ #+allegro
+ (let ((stored (gensym)))
+ `(let ((,stored ,obj))
+ (if (zerop ,stored)
+ nil
+ (values (excl:native-to-string ,stored)))))
+ #+mcl
+ (let ((stored (gensym)))
+ `(let ((,stored ,obj))
+ (if (ccl:%null-ptr-p ,stored)
+ nil
+ (values (ccl:%get-cstring ,stored)))))
+
+
+ )
+
+(defmacro convert-to-cstring (obj)
+ #+lispworks
+ `(if (null ,obj)
+ +null-cstring-pointer+
+ (fli:convert-to-foreign-string ,obj))
+ #+allegro
+ `(if (null ,obj)
+ 0
+ (values (excl:string-to-native ,obj)))
+ #+cmu
+ (declare (ignore obj))
+ #+mcl
+ `(if (null ,obj)
+ +null-cstring-pointer+
+ (let ((ptr (new-ptr (1+ (length ,obj)))))
+ (ccl:%put-cstring ptr ,obj)
+ ptr))
+ )
+
+(defmacro free-cstring (obj)
+ #+lispworks
+ `(unless (fli:null-pointer-p ,obj)
+ (fli:free-foreign-object ,obj))
+ #+allegro
+ `(unless (zerop obj)
+ (ff:free-fobject ,obj))
+ #+cmu
+ (declare (ignore obj))
+ #+mcl
+ `(unless (ccl:%null-ptr-p ,obj)
+ (dispose-ptr ,obj))
+
+ )
+
+;; Either length or null-terminated-p must be non-nil
+(defmacro convert-from-foreign-string (obj &key
+ length
+ (null-terminated-p t))
+ #+allegro
+ `(if (zerop ,obj)
+ nil
+ (values (excl:native-to-string
+ ,obj
+ ,@(if length (list :length length) (values))
+ :truncate (not ,null-terminated-p))))
+ #+lispworks
+ `(if (fli:null-pointer-p ,obj)
+ nil
+ (fli:convert-from-foreign-string
+ ,obj
+ ,@(if length (list :length length) (values))
+ :null-terminated-p ,null-terminated-p
+ :external-format '(:latin-1 :eol-style :lf)))
+ #+cmu
+ `(cmucl-naturalize-cstring (alien:alien-sap ,obj)
+ :length ,length
+ :null-terminated-p ,null-terminated-p)
+ #+mcl
+ (declare (ignore null-terminated-p))
+ #+mcl
+ `(if (ccl:%null-ptr-p ,obj)
+ nil
+ (ccl:%get-cstring ,obj 0 ,@(if length (list length) nil)))
+ )
+
+(defmacro convert-to-foreign-string (obj)
+ #+lispworks
+ `(if (null ,obj)
+ +null-cstring-pointer+
+ (fli:convert-to-foreign-string ,obj))
+ #+allegro
+ `(if (null ,obj)
+ 0
+ (values (excl:string-to-native ,obj)))
+ #+cmu
+ (let ((size (gensym))
+ (storage (gensym))
+ (i (gensym)))
+ `(when (stringp ,obj)
+ (let* ((,size (length ,obj))
+ (,storage (alien:make-alien char (1+ ,size))))
+ (setq ,storage (alien:cast ,storage (* char)))
+ (dotimes (,i ,size)
+ (declare (fixnum ,i)
+ (optimize (speed 3) (safety 0)))
+ (setf (alien:deref ,storage ,i) (char-code (char ,obj ,i))))
+ (setf (alien:deref ,storage ,size) 0)
+ ,storage)))
+ #+mcl
+ `(if (null ,obj)
+ +null-cstring-pointer+
+ (let ((ptr (new-ptr (1+ (length ,obj)))))
+ (ccl:%put-cstring ptr ,obj)
+ ptr))
+ )
+
+
+(defmacro allocate-foreign-string (size &key (unsigned t))
+ #+cmu
+ (let ((array-def (gensym)))
+ `(let ((,array-def (list 'alien:array 'c-call:char ,size)))
+ (eval `(alien:cast (alien:make-alien ,,array-def)
+ ,(if ,unsigned
+ '(* (alien:unsigned 8))
+ '(* (alien:signed 8)))))))
+ #+lispworks
+ `(fli:allocate-foreign-object :type
+ ,(if unsigned
+ ''(:unsigned :char)
+ :char)
+ :nelems ,size)
+ #+allegro
+ (declare (ignore unsigned))
+ #+allegro
+ `(ff:allocate-fobject :char :c ,size)
+ #+mcl
+ (declare (ignore unsigned))
+ #+mcl
+ `(new-ptr ,size)
+
+ )
+
+
+; I'm sure there must be a better way to write this...
+(defmacro with-cstring ((foreign-string lisp-string) &body body)
+ `(if (stringp ,lisp-string)
+ (ccl:with-cstrs ((,foreign-string ,lisp-string))
+ ,@body)
+ (let ((,foreign-string +null-cstring-pointer+))
+ ,@body)))
+
+
+#| Works but, supposedly the built in method is better
+(defmacro with-cstring ((foreign-string lisp-string) &body body)
+ (let ((result (gensym)))
+ `(let* ((,foreign-string (convert-to-cstring ,lisp-string))
+ (,result ,@body))
+ (dispose-ptr ,foreign-string)
+ ,result))
+ )
+
+|#
+
+
+
+
+
projects / uffi.git / commitdiff