Commit f79d5e68 authored by Kenny Tilton's avatar Kenny Tilton
Browse files

No comment

parent 110c1a93

definers.lisp

+11 −5
Original line number Diff line number Diff line
@@ -20,7 +20,7 @@ 
;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS 

;;; IN THE SOFTWARE.



;; $Header: /project/cells/cvsroot/cell-cultures/hello-c/definers.lisp,v 1.1 2004/12/14 03:58:48 ktilton Exp $

;; $Header: /project/cello/cvsroot/hello-c/definers.lisp,v 1.1 2005/05/23 23:51:57 ktilton Exp $



(in-package :hello-c)
@@ -39,11 +39,17 @@ 
  #-lispworks ff-ptr

  #+lispworks (fli:pointer-address ff-ptr))



;;;(defun make-ff-pointer (n)

;;;  #-lispworks

;;;  n

;;;  #+lispworks

;;;  (fli:make-pointer :address n :pointer-type '(:pointer :void)))



(defun make-ff-pointer (n)

  #-lispworks

  n

  #+lispworks

  (fli:make-pointer :address n :pointer-type '(:pointer :void)))

  #+allegro   (ff:make-foreign-pointer :address n :type '(* void))

  #+lispworks (fli:make-pointer :address n :pointer-type  '(:pointer :void))

  #-(or lispworks allegro) n

  )



(defmacro defun-ffx (rtn module$ name$ (&rest type-args) &body post-processing)

  (let* ((lisp-fn (lisp-fn name$))

hello-c.lpr

+1 −1
Original line number Diff line number Diff line 
;; -*- lisp-version: "7.0 [Windows] (May 6, 2005 8:25)"; cg: "1.54.2.17"; -*-

;; -*- lisp-version: "7.0 [Windows] (Jun 10, 2005 13:34)"; cg: "1.54.2.17"; -*-



(in-package :cg-user)

primitives.lisp

+23 −23
Original line number Diff line number Diff line
@@ -7,7 +7,7 @@ 
;;;; Programmer:    Kevin M. Rosenberg

;;;; Date Started:  Feb 2002

;;;;

;;;; $Id: primitives.lisp,v 1.1 2004/12/14 03:58:48 ktilton Exp $

;;;; $Id: primitives.lisp,v 1.1 2005/05/23 23:51:57 ktilton Exp $

;;;;

;;;; This file, part of hello-c, is Copyright (c) 2002 by Kevin M. Rosenberg

;;;;

strings.lisp

+18 −15
Original line number Diff line number Diff line
@@ -7,7 +7,7 @@ 
;;;; Programmer:    Kevin M. Rosenberg

;;;; Date Started:  Feb 2002

;;;;

;;;; $Id: strings.lisp,v 1.1 2004/12/14 03:58:49 ktilton Exp $

;;;; $Id: strings.lisp,v 1.1 2005/05/23 23:51:57 ktilton Exp $

;;;;

;;;; This file, part of hic, is Copyright (c) 2002 by Kevin M. Rosenberg

;;;;
@@ -68,21 +68,24 @@ that LW/CMU automatically converts strings from c-calls." 
     (dispose-ptr ,obj))

  )



(defmacro with-cstring ((cstring lisp-string) &body body)

(defmacro with-cstring ((cstring lisp$-form) &body body)

  #+(or cmu sbcl scl lispworks)

  `(let ((,cstring ,lisp-string)) ,@body) 

  `(let ((,cstring ,lisp$-form)) ,@body)

  #+allegro

  (let ((acl-native (gensym)))

    `(excl:with-native-string (,acl-native ,lisp-string)

       (let ((,cstring (if ,lisp-string ,acl-native 0)))

    `(excl:with-native-string (,acl-native ,lisp$-form)

       (let ((,cstring ,(if lisp$-form acl-native 0)))

         ,@body)))

  #+mcl

  `(if (stringp ,lisp-string)

     (ccl:with-cstrs ((,cstring ,lisp-string))

       ,@body)

     (let ((,cstring +null-cstring-pointer+))

       ,@body))

  )

  (let ((lisp$ (gensym)))

    `(let ((,lisp$ (let ((,lisp$ ,lisp$-form))

                     (typecase ,lisp$

                       (null +null-cstring-pointer+)

                       (string ,lisp$)

                       (t (error "with-cstring asked to handle non-string ~a" ,lisp$))))))

       (ccl:with-cstrs ((,cstring ,lisp$))

         ,@body))))





(defmacro with-cstrings (bindings &rest body)

  (if bindings