ff-interface

[bill@cambridge.apple.com (Bill St. Clair)]

At  6:02 PM 5/6/93 -0400, Steve Strassmann wrote:
> >To: info-mcl@ministry.cambridge.apple.com
> >From: jmartin@kuhub.cc.ukans.edu
> >Newsgroups: comp.lang.lisp.mcl
> >Subject: ff-interface
> >Date: 6 May 93 15:31:57 CST
> >Organization: University of Kansas Academic Computing Services
> >
> >I am trying to load MathLink (compiled C library) into the ff-interface of
> >MCL.  All of the C functions expect 2 parameters, an integer giving the length
> >of the second parameter, which is "an array of strings".  I cannot decipher
> >how to construct an an array of strings in LISP and then pass it to the C
> >function.  Does anybody have any idea what data types to use.  It seems that
> >C is expecting a pointer to the beginning of a contiguous set of strings, but
> >I don't know enough to construct this set in LISP, get a pointer to it and
> >then pass it to the C function.
> >
> >
>I'll take a wild guess here, but maybe something like this would work.
>In this example, you create an array of 3 strings to pass to MathLink:
>
>(let ((null-string (string #\null)))
>    (with-cstrs ((c-string-array (concatenate 'string
>                                       "this is a string" null-string
>                                       "another string" null-string
>                                       "yet another string" null-string)))
>      (your-mathlink-function 3 c-string-array)))

I don't think that's right. Here's some code that creates the data
structure that I think your C code is expecting. You'd declare this
array of strings as "**char" in C.

-----------------------------------------------------------------------------

; make-cstring-list.lisp
;
; function to convert a list of strings into a C array
; of C strings. Allocates storage from the Mac Heap, so
; you need to remember to deallocate it (or use the with-cstring-list
; macro below)

(defun make-cstring-list (string-list)
  (unless (every 'stringp string-list)
    (error "Not a list of strings: ~s" string-list))
  (let* ((length (length string-list))
         (res (#_NewPtr (* 4 length)))
         (tail string-list)
         (offset 0))
    (declare (fixnum length))
    (dotimes (i length)
      (let* ((string (pop tail)))
        (with-macptrs ((cstr (#_NewPtr (1+ (length string)))))
          (ccl::%cstr-pointer string cstr)
          (setf (%get-ptr res offset) cstr)
          (incf offset 4))))
    (values res length)))

(defun cstring-list-length (cstring-list)
  (unless (zone-pointerp cstring-list)
    (error "~s is not a zone pointer"))
  (require-type
   (/  (pointer-size cstring-list) 4)
   'fixnum))

(defun free-cstring-list (cstring-list &optional length)
  (unless (zone-pointerp cstring-list)
    (error "~s is not a zone pointer"))
  (unless length
    (setq length (cstring-list-length cstring-list)))
  (dotimes (i length)
    (#_DisposePtr (%get-ptr cstring-list (* 4 i))))
  (#_DIsposePtr cstring-list)
  nil)

(defmacro with-cstring-list ((cstring-list string-list &optional length)
                             &body body)
  `(multiple-value-bind (,cstring-list ,@(when length (list length)))
                        (make-cstring-list ,string-list)
     (unwind-protect
       (progn ,@body)
       (free-cstring-list ,cstring-list))))

#|
(with-cstring-list (cs '("one" "two" "three" "four") length)
  (dotimes (i length)
    (print (%get-cstring (%get-ptr cs (* 4 i))))))
|#