From 5bd05c7e835ff4ce78e6eb9c928a6f71471ce528 Mon Sep 17 00:00:00 2001 From: John DeSoi Date: Thu, 4 Apr 2002 05:03:38 +0000 Subject: [PATCH] r1737: Initial MCL version. --- src/mcl/aggregates.cl | 132 ++++++++++++++++++++++++++++ src/mcl/functions.cl | 69 +++++++++++++++ src/mcl/libraries.cl | 36 ++++++++ src/mcl/objects.cl | 112 ++++++++++++++++++++++++ src/mcl/package.cl | 71 +++++++++++++++ src/mcl/primitives.cl | 84 ++++++++++++++++++ src/mcl/strings.cl | 197 ++++++++++++++++++++++++++++++++++++++++++ 7 files changed, 701 insertions(+) create mode 100644 src/mcl/aggregates.cl create mode 100644 src/mcl/functions.cl create mode 100644 src/mcl/libraries.cl create mode 100644 src/mcl/objects.cl create mode 100644 src/mcl/package.cl create mode 100644 src/mcl/primitives.cl create mode 100644 src/mcl/strings.cl diff --git a/src/mcl/aggregates.cl b/src/mcl/aggregates.cl new file mode 100644 index 0000000..c788d2f --- /dev/null +++ b/src/mcl/aggregates.cl @@ -0,0 +1,132 @@ +;;;; -*- 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) + ) + +|# + diff --git a/src/mcl/functions.cl b/src/mcl/functions.cl new file mode 100644 index 0000000..35bca59 --- /dev/null +++ b/src/mcl/functions.cl @@ -0,0 +1,69 @@ +;;;; -*- 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)))) + + diff --git a/src/mcl/libraries.cl b/src/mcl/libraries.cl new file mode 100644 index 0000000..7d6dbf2 --- /dev/null +++ b/src/mcl/libraries.cl @@ -0,0 +1,36 @@ +;;;; -*- 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))) diff --git a/src/mcl/objects.cl b/src/mcl/objects.cl new file mode 100644 index 0000000..9e025b4 --- /dev/null +++ b/src/mcl/objects.cl @@ -0,0 +1,112 @@ +;;;; -*- 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)) diff --git a/src/mcl/package.cl b/src/mcl/package.cl new file mode 100644 index 0000000..c56bfbd --- /dev/null +++ b/src/mcl/package.cl @@ -0,0 +1,71 @@ +;;;; -*- 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 + )) diff --git a/src/mcl/primitives.cl b/src/mcl/primitives.cl new file mode 100644 index 0000000..57f3b17 --- /dev/null +++ b/src/mcl/primitives.cl @@ -0,0 +1,84 @@ +;;;; -*- 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)))) + + + + + + diff --git a/src/mcl/strings.cl b/src/mcl/strings.cl new file mode 100644 index 0000000..5e680e2 --- /dev/null +++ b/src/mcl/strings.cl @@ -0,0 +1,197 @@ +;;;; -*- 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)) + ) + +|# + + + + + -- 2.34.1