ff-interface

[Mark Nahabedian <naha@RIVERSIDE.SCRC.Symbolics.COM>]

    Date: Fri, 7 May 1993 10:39 EDT
    From: bill@cambridge.apple.com (Bill St. Clair)

    [...]

    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)))

Shouldn't this have an extra entry so you can write a null pointer at
the end?

	     (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))))))
    |#