external/cffi.darcs/uffi-compat/uffi-compat.lisp

   1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; uffi-compat.lisp --- UFFI compatibility layer for CFFI.
   4 ;;;
   5 ;;; Copyright (C) 2005-2006, James Bielman  <jamesjb@jamesjb.com>
   6 ;;; Copyright (C) 2005-2007, Luis Oliveira  <loliveira@common-lisp.net>
   7 ;;;
   8 ;;; Permission is hereby granted, free of charge, to any person
   9 ;;; obtaining a copy of this software and associated documentation
  10 ;;; files (the "Software"), to deal in the Software without
  11 ;;; restriction, including without limitation the rights to use, copy,
  12 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
  13 ;;; of the Software, and to permit persons to whom the Software is
  14 ;;; furnished to do so, subject to the following conditions:
  15 ;;;
  16 ;;; The above copyright notice and this permission notice shall be
  17 ;;; included in all copies or substantial portions of the Software.
  18 ;;;
  19 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  20 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  21 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  22 ;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
  23 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
  24 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  25 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  26 ;;; DEALINGS IN THE SOFTWARE.
  27 ;;;
  28
  29 ;;; Code borrowed from UFFI is Copyright (c) Kevin M. Rosenberg.
  30
  31 (defpackage #:cffi-uffi-compat
  32   (:nicknames #:uffi) ;; is this a good idea?
  33   (:use #:cl)
  34   (:export
  35
  36    ;; immediate types
  37    #:def-constant
  38    #:def-foreign-type
  39    #:def-type
  40    #:null-char-p
  41
  42    ;; aggregate types
  43    #:def-enum
  44    #:def-struct
  45    #:get-slot-value
  46    #:get-slot-pointer
  47    #:def-array-pointer
  48    #:deref-array
  49    #:def-union
  50
  51    ;; objects
  52    #:allocate-foreign-object
  53    #:free-foreign-object
  54    #:with-foreign-object
  55    #:with-foreign-objects
  56    #:size-of-foreign-type
  57    #:pointer-address
  58    #:deref-pointer
  59    #:ensure-char-character
  60    #:ensure-char-integer
  61    #:ensure-char-storable
  62    #:null-pointer-p
  63    #:make-null-pointer
  64    #:make-pointer
  65    #:+null-cstring-pointer+
  66    #:char-array-to-pointer
  67    #:with-cast-pointer
  68    #:def-foreign-var
  69    #:convert-from-foreign-usb8
  70    #:def-pointer-var
  71
  72    ;; string functions
  73    #:convert-from-cstring
  74    #:convert-to-cstring
  75    #:free-cstring
  76    #:with-cstring
  77    #:with-cstrings
  78    #:convert-from-foreign-string
  79    #:convert-to-foreign-string
  80    #:allocate-foreign-string
  81    #:with-foreign-string
  82    #:with-foreign-strings
  83    #:foreign-string-length              ; not implemented
  84
  85    ;; function call
  86    #:def-function
  87
  88    ;; libraries
  89    #:find-foreign-library
  90    #:load-foreign-library
  91    #:default-foreign-library-type
  92    #:foreign-library-types
  93
  94    ;; os
  95    #:getenv
  96    #:run-shell-command
  97    ))
  98
  99 (in-package #:cffi-uffi-compat)
 100
 101 #+clisp
 102 (eval-when (:compile-toplevel :load-toplevel :execute)
 103   (when (equal (machine-type) "POWER MACINTOSH")
 104     (pushnew :ppc *features*)))
 105
 106 (defun convert-uffi-type (uffi-type)
 107   "Convert a UFFI primitive type to a CFFI type."
 108   ;; Many CFFI types are the same as UFFI.  This list handles the
 109   ;; exceptions only.
 110   (case uffi-type
 111     (:cstring :pointer)
 112     (:pointer-void :pointer)
 113     (:pointer-self :pointer)
 114     (:char '(uffi-char :char))
 115     (:unsigned-char '(uffi-char :unsigned-char))
 116     (:byte :char)
 117     (:unsigned-byte :unsigned-char)
 118     (t
 119      (if (listp uffi-type)
 120          (case (car uffi-type)
 121            ;; this is imho gross but it is what uffi does
 122            (quote (convert-uffi-type (second uffi-type)))
 123            (* :pointer)
 124            (:array `(uffi-array ,(convert-uffi-type (second uffi-type))
 125                                 ,(third uffi-type)))
 126            (:union (second uffi-type))
 127            (:struct (convert-uffi-type (second uffi-type)))
 128            (:struct-pointer :pointer))
 129          uffi-type))))
 130
 131 (cffi:define-foreign-type uffi-array-type ()
 132   ;; ELEMENT-TYPE should be /unparsed/, suitable for passing to mem-aref.
 133   ((element-type :initform (error "An element-type is required.")
 134                  :accessor element-type :initarg :element-type)
 135    (nelems :initform (error "nelems is required.")
 136            :accessor nelems :initarg :nelems))
 137   (:actual-type :pointer)
 138   (:documentation "UFFI's :array type."))
 139
 140 (cffi:define-parse-method uffi-array (element-type count)
 141   (make-instance 'uffi-array-type :element-type element-type
 142                  :nelems (or count 1)))
 143
 144 (defmethod cffi:foreign-type-size ((type uffi-array-type))
 145   (* (cffi:foreign-type-size (element-type type)) (nelems type)))
 146
 147 (defmethod cffi::aggregatep ((type uffi-array-type))
 148   t)
 149
 150 ;; UFFI's :(unsigned-)char
 151 (cffi:define-foreign-type uffi-char ()
 152   ())
 153
 154 (cffi:define-parse-method uffi-char (base-type)
 155   (make-instance 'uffi-char :actual-type base-type))
 156
 157 (defmethod cffi:translate-to-foreign ((value character) (type uffi-char))
 158   (char-code value))
 159
 160 (defmethod cffi:translate-from-foreign (obj (type uffi-char))
 161   (code-char obj))
 162
 163 (defmacro def-type (name type)
 164   "Define a Common Lisp type NAME for UFFI type TYPE."
 165   (declare (ignore type))
 166   `(deftype ,name () t))
 167
 168 (defmacro def-foreign-type (name type)
 169   "Define a new foreign type."
 170   `(cffi:defctype ,name ,(convert-uffi-type type)))
 171
 172 (defmacro def-constant (name value &key export)
 173   "Define a constant and conditionally export it."
 174   `(eval-when (:compile-toplevel :load-toplevel :execute)
 175      (defconstant ,name ,value)
 176      ,@(when export `((export ',name)))
 177      ',name))
 178
 179 (defmacro null-char-p (val)
 180   "Return true if character is null."
 181   `(zerop (char-code ,val)))
 182
 183 (defmacro def-enum (enum-name args &key (separator-string "#"))
 184   "Creates a constants for a C type enum list, symbols are
 185 created in the created in the current package. The symbol is the
 186 concatenation of the enum-name name, separator-string, and
 187 field-name"
 188   (let ((counter 0)
 189         (cmds nil)
 190         (constants nil))
 191     (declare (fixnum counter))
 192     (dolist (arg args)
 193       (let ((name (if (listp arg) (car arg) arg))
 194             (value (if (listp arg)
 195                        (prog1
 196                            (setq counter (cadr arg))
 197                          (incf counter))
 198                        (prog1
 199                            counter
 200                          (incf counter)))))
 201         (setq name (intern (concatenate 'string
 202                                         (symbol-name enum-name)
 203                                         separator-string
 204                                         (symbol-name name))))
 205         (push `(def-constant ,name ,value) constants)))
 206     (setf cmds (append '(progn) `((cffi:defctype ,enum-name :int))
 207                        (nreverse constants)))
 208     cmds))
 209
 210 (defmacro def-struct (name &body fields)
 211   "Define a C structure."
 212   `(cffi:defcstruct ,name
 213      ,@(loop for (name uffi-type) in fields
 214              for cffi-type = (convert-uffi-type uffi-type)
 215              collect (list name cffi-type))))
 216
 217 ;; TODO: figure out why the compiler macro is kicking in before
 218 ;; the setf expander.
 219 (defun %foreign-slot-value (obj type field)
 220   (cffi:foreign-slot-value obj type field))
 221
 222 (defun (setf %foreign-slot-value) (value obj type field)
 223   (setf (cffi:foreign-slot-value obj type field) value))
 224
 225 (defmacro get-slot-value (obj type field)
 226   "Access a slot value from a structure."
 227   `(%foreign-slot-value ,obj ,type ,field))
 228
 229 ;; UFFI uses a different function when accessing a slot whose
 230 ;; type is a pointer. We don't need that in CFFI so we use
 231 ;; foreign-slot-value too.
 232 (defmacro get-slot-pointer (obj type field)
 233   "Access a pointer slot value from a structure."
 234   `(cffi:foreign-slot-value ,obj ,type ,field))
 235
 236 (defmacro def-array-pointer (name type)
 237   "Define a foreign array type."
 238   `(cffi:defctype ,name (uffi-array ,(convert-uffi-type type) 1)))
 239
 240 (defmacro deref-array (array type position)
 241   "Dereference an array."
 242   `(cffi:mem-aref ,array
 243                   ,(if (constantp type)
 244                        `',(element-type (cffi::parse-type
 245                                          (convert-uffi-type (eval type))))
 246                        `(element-type (cffi::parse-type
 247                                        (convert-uffi-type ,type))))
 248                   ,position))
 249
 250 ;; UFFI's documentation on DEF-UNION is a bit scarce, I'm not sure
 251 ;; if DEFCUNION and DEF-UNION are strictly compatible.
 252 (defmacro def-union (name &body fields)
 253   "Define a foreign union type."
 254   `(cffi:defcunion ,name
 255      ,@(loop for (name uffi-type) in fields
 256              for cffi-type = (convert-uffi-type uffi-type)
 257              collect (list name cffi-type))))
 258
 259 (defmacro allocate-foreign-object (type &optional (size 1))
 260   "Allocate one or more instance of a foreign type."
 261   `(cffi:foreign-alloc ,(if (constantp type)
 262                             `',(convert-uffi-type (eval type))
 263                             `(convert-uffi-type ,type))
 264                        :count ,size))
 265
 266 (defmacro free-foreign-object (ptr)
 267   "Free a foreign object allocated by ALLOCATE-FOREIGN-OBJECT."
 268   `(cffi:foreign-free ,ptr))
 269
 270 (defmacro with-foreign-object ((var type) &body body)
 271   "Wrap the allocation of a foreign object around BODY."
 272   `(cffi:with-foreign-object (,var (convert-uffi-type ,type))
 273      ,@body))
 274
 275 ;; Taken from UFFI's src/objects.lisp
 276 (defmacro with-foreign-objects (bindings &rest body)
 277   (if bindings
 278       `(with-foreign-object ,(car bindings)
 279          (with-foreign-objects ,(cdr bindings)
 280            ,@body))
 281       `(progn ,@body)))
 282
 283 (defmacro size-of-foreign-type (type)
 284   "Return the size in bytes of a foreign type."
 285   `(cffi:foreign-type-size (convert-uffi-type ,type)))
 286
 287 (defmacro pointer-address (ptr)
 288   "Return the address of a pointer."
 289   `(cffi:pointer-address ,ptr))
 290
 291 (defmacro deref-pointer (ptr type)
 292   "Dereference a pointer."
 293   `(cffi:mem-ref ,ptr (convert-uffi-type ,type)))
 294
 295 (defsetf deref-pointer (ptr type) (value)
 296   `(setf (cffi:mem-ref ,ptr (convert-uffi-type ,type)) ,value))
 297
 298 (defmacro ensure-char-character (obj &environment env)
 299   "Convert OBJ to a character if it is an integer."
 300   (if (constantp obj env)
 301       (if (characterp obj) obj (code-char obj))
 302       (let ((obj-var (gensym)))
 303         `(let ((,obj-var ,obj))
 304            (if (characterp ,obj-var)
 305                ,obj-var
 306                (code-char ,obj-var))))))
 307
 308 (defmacro ensure-char-integer (obj &environment env)
 309   "Convert OBJ to an integer if it is a character."
 310   (if (constantp obj env)
 311       (let ((the-obj (eval obj)))
 312         (if (characterp the-obj) (char-code the-obj) the-obj))
 313       (let ((obj-var (gensym)))
 314         `(let ((,obj-var ,obj))
 315            (if (characterp ,obj-var)
 316                (char-code ,obj-var)
 317                ,obj-var)))))
 318
 319 (defmacro ensure-char-storable (obj)
 320   "Ensure OBJ is storable as a character."
 321   `(ensure-char-integer ,obj))
 322
 323 (defmacro make-null-pointer (type)
 324   "Create a NULL pointer."
 325   (declare (ignore type))
 326   `(cffi:null-pointer))
 327
 328 (defmacro make-pointer (address type)
 329   "Create a pointer to ADDRESS."
 330   (declare (ignore type))
 331   `(cffi:make-pointer ,address))
 332
 333 (defmacro null-pointer-p (ptr)
 334   "Return true if PTR is a null pointer."
 335   `(cffi:null-pointer-p ,ptr))
 336
 337 (defparameter +null-cstring-pointer+ (cffi:null-pointer)
 338   "A constant NULL string pointer.")
 339
 340 (defmacro char-array-to-pointer (obj)
 341   obj)
 342
 343 (defmacro with-cast-pointer ((var ptr type) &body body)
 344   "Cast a pointer, does nothing in CFFI."
 345   (declare (ignore type))
 346   `(let ((,var ,ptr))
 347      ,@body))
 348
 349 (defmacro def-foreign-var (name type module)
 350   "Define a symbol macro to access a foreign variable."
 351   (declare (ignore module))
 352   (flet ((lisp-name (name)
 353            (intern (cffi-sys:canonicalize-symbol-name-case
 354                     (substitute #\- #\_ name)))))
 355     `(cffi:defcvar ,(if (listp name)
 356                         name
 357                         (list name (lisp-name name)))
 358          ,(convert-uffi-type type))))
 359
 360 (defmacro def-pointer-var (name value &optional doc)
 361   #-openmcl `(defvar ,name ,value ,@(if doc (list doc)))
 362   #+openmcl `(ccl::defloadvar ,name ,value ,doc))
 363
 364 (defmacro convert-from-cstring (s)
 365   "Convert a cstring to a Lisp string."
 366   (let ((ret (gensym)))
 367     `(let ((,ret (cffi:foreign-string-to-lisp ,s)))
 368        (if (equal ,ret "")
 369            nil
 370            ,ret))))
 371
 372 (defmacro convert-to-cstring (obj)
 373   "Convert a Lisp string to a cstring."
 374   (let ((str (gensym)))
 375     `(let ((,str ,obj))
 376        (if (null ,str)
 377            (cffi:null-pointer)
 378            (cffi:foreign-string-alloc ,str)))))
 379
 380 (defmacro free-cstring (ptr)
 381   "Free a cstring."
 382   `(cffi:foreign-string-free ,ptr))
 383
 384 (defmacro with-cstring ((foreign-string lisp-string) &body body)
 385   "Binds a newly creating string."
 386   (let ((str (gensym)))
 387     `(let ((,str ,lisp-string))
 388        (if (null ,str)
 389            (let ((,foreign-string (cffi:null-pointer)))
 390              ,@body)
 391            (cffi:with-foreign-string (,foreign-string ,str)
 392              ,@body)))))
 393
 394 ;; Taken from UFFI's src/strings.lisp
 395 (defmacro with-cstrings (bindings &rest body)
 396   (if bindings
 397       `(with-cstring ,(car bindings)
 398          (with-cstrings ,(cdr bindings)
 399            ,@body))
 400       `(progn ,@body)))
 401
 402 (defmacro def-function (name args &key module (returning :void))
 403   "Define a foreign function."
 404   (declare (ignore module))
 405   `(cffi:defcfun ,name ,(convert-uffi-type returning)
 406      ,@(loop for (name type) in args
 407              collect `(,name ,(convert-uffi-type type)))))
 408
 409 ;;; Taken from UFFI's src/libraries.lisp
 410
 411 (defvar *loaded-libraries* nil
 412   "List of foreign libraries loaded. Used to prevent reloading a library")
 413
 414 (defun default-foreign-library-type ()
 415   "Returns string naming default library type for platform"
 416   #+(or win32 cygwin mswindows) "dll"
 417   #+(or macos macosx darwin ccl-5.0) "dylib"
 418   #-(or win32 cygwin mswindows macos macosx darwin ccl-5.0) "so")
 419
 420 (defun foreign-library-types ()
 421   "Returns list of string naming possible library types for platform,
 422 sorted by preference"
 423   #+(or win32 cygwin mswindows) '("dll" "lib" "so")
 424   #+(or macos macosx darwin ccl-5.0) '("dylib" "bundle")
 425   #-(or win32 cygwin mswindows macos macosx darwin ccl-5.0) '("so" "a" "o"))
 426
 427 (defun find-foreign-library (names directories &key types drive-letters)
 428   "Looks for a foreign library. directories can be a single
 429 string or a list of strings of candidate directories. Use default
 430 library type if type is not specified."
 431   (unless types
 432     (setq types (foreign-library-types)))
 433   (unless (listp types)
 434     (setq types (list types)))
 435   (unless (listp names)
 436     (setq names (list names)))
 437   (unless (listp directories)
 438     (setq directories (list directories)))
 439   #+(or win32 mswindows)
 440   (unless (listp drive-letters)
 441     (setq drive-letters (list drive-letters)))
 442   #-(or win32 mswindows)
 443   (setq drive-letters '(nil))
 444   (dolist (drive-letter drive-letters)
 445     (dolist (name names)
 446       (dolist (dir directories)
 447    (dolist (type types)
 448      (let ((path (make-pathname
 449              #+lispworks :host
 450              #+lispworks (when drive-letter drive-letter)
 451              #-lispworks :device
 452              #-lispworks (when drive-letter drive-letter)
 453              :name name
 454              :type type
 455              :directory
 456              (etypecase dir
 457           (pathname
 458            (pathname-directory dir))
 459           (list
 460            dir)
 461           (string
 462            (pathname-directory
 463             (parse-namestring dir)))))))
 464        (when (probe-file path)
 465          (return-from find-foreign-library path)))))))
 466   nil)
 467
 468 (defun convert-supporting-libraries-to-string (libs)
 469   (let (lib-load-list)
 470     (dolist (lib libs)
 471       (push (format nil "-l~A" lib) lib-load-list))
 472     (nreverse lib-load-list)))
 473
 474 (defun load-foreign-library (filename &key module supporting-libraries
 475                              force-load)
 476   #+(or allegro mcl sbcl clisp) (declare (ignore module supporting-libraries))
 477   #+(or cmu scl sbcl) (declare (ignore module))
 478
 479   (when (and filename (or (null (pathname-directory filename))
 480                           (probe-file filename)))
 481     (if (pathnamep filename) ;; ensure filename is a string to check if
 482    (setq filename (namestring filename))) ; already loaded
 483
 484     (if (and (not force-load)
 485         (find filename *loaded-libraries* :test #'string-equal))
 486         t ;; return T, but don't reload library
 487         (progn
 488           ;; FIXME: Hmm, what are these two for?
 489           #+cmu
 490           (let ((type (pathname-type (parse-namestring filename))))
 491             (if (string-equal type "so")
 492                 (sys::load-object-file filename)
 493                 (alien:load-foreign filename
 494                                     :libraries
 495                                     (convert-supporting-libraries-to-string
 496                                      supporting-libraries))))
 497           #+scl
 498           (let ((type (pathname-type (parse-namestring filename))))
 499             (if (string-equal type "so")
 500                 (sys::load-dynamic-object filename)
 501                 (alien:load-foreign filename
 502                                     :libraries
 503                                     (convert-supporting-libraries-to-string
 504                                      supporting-libraries))))
 505
 506           #-(or cmu scl)
 507           (cffi:load-foreign-library filename)
 508           (push filename *loaded-libraries*)
 509           t))))
 510
 511 ;; Taken from UFFI's src/os.lisp
 512 (defun getenv (var)
 513   "Return the value of the environment variable."
 514   #+allegro (sys::getenv (string var))
 515   #+clisp (sys::getenv (string var))
 516   #+(or cmu scl) (cdr (assoc (string var) ext:*environment-list* :test #'equalp
 517                              :key #'string))
 518   #+gcl (si:getenv (string var))
 519   #+lispworks (lw:environment-variable (string var))
 520   #+lucid (lcl:environment-variable (string var))
 521   #+mcl (ccl::getenv var)
 522   #+sbcl (sb-ext:posix-getenv var)
 523   #-(or allegro clisp cmu scl gcl lispworks lucid mcl sbcl)
 524   (error 'not-implemented :proc (list 'getenv var)))
 525
 526 ;; Taken from UFFI's src/os.lisp
 527 ;; modified from function ASDF -- Copyright Dan Barlow and Contributors
 528 (defun run-shell-command (control-string  &rest args &key output)
 529   "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
 530 synchronously execute the result using a Bourne-compatible shell, with
 531 output to *trace-output*.  Returns the shell's exit code."
 532   (unless output
 533     (setq output *trace-output*))
 534
 535   (let ((command (apply #'format nil control-string args)))
 536     #+sbcl
 537     (sb-impl::process-exit-code
 538      (sb-ext:run-program
 539       "/bin/sh"
 540       (list "-c" command)
 541       :input nil :output output))
 542
 543     #+(or cmu scl)
 544     (ext:process-exit-code
 545      (ext:run-program
 546       "/bin/sh"
 547       (list "-c" command)
 548       :input nil :output output))
 549
 550     #+allegro
 551     (excl:run-shell-command command :input nil :output output)
 552
 553     #+lispworks
 554     (system:call-system-showing-output
 555      command
 556      :shell-type "/bin/sh"
 557      :output-stream output)
 558
 559     #+clisp             ;XXX not exactly *trace-output*, I know
 560     (ext:run-shell-command  command :output :terminal :wait t)
 561
 562     #+openmcl
 563     (nth-value 1
 564            (ccl:external-process-status
 565         (ccl:run-program "/bin/sh" (list "-c" command)
 566                  :input nil :output output
 567                  :wait t)))
 568
 569     #-(or openmcl clisp lispworks allegro scl cmu sbcl)
 570     (error "RUN-SHELL-PROGRAM not implemented for this Lisp")
 571     ))
 572
 573 ;;; Some undocumented UFFI operators...
 574
 575 (defmacro convert-from-foreign-string (obj &key (length most-positive-fixnum)
 576                                        (locale :default)
 577                                        (null-terminated-p t))
 578   (declare (ignore locale))
 579   (let ((ret (gensym)))
 580     `(let ((,ret (cffi:foreign-string-to-lisp ,obj ,length ,null-terminated-p)))
 581        (if (equal ,ret "")
 582            nil
 583            ,ret))))
 584
 585 ;; What's the difference between this and convert-to-cstring?
 586 (defmacro convert-to-foreign-string (obj)
 587   (let ((str (gensym)))
 588     `(let ((,str ,obj))
 589        (if (null ,str)
 590            (cffi:null-pointer)
 591            (cffi:foreign-string-alloc ,str)))))
 592
 593 (defmacro allocate-foreign-string (size &key unsigned)
 594   (declare (ignore unsigned))
 595   `(cffi:foreign-alloc :char :count ,size))
 596
 597 ;; Ditto.
 598 (defmacro with-foreign-string ((foreign-string lisp-string) &body body)
 599   (let ((str (gensym)))
 600     `(let ((,str ,lisp-string))
 601        (if (null ,str)
 602            (let ((,foreign-string (cffi:null-pointer)))
 603              ,@body)
 604            (cffi:with-foreign-string (,foreign-string ,str)
 605              ,@body)))))
 606
 607 (defmacro with-foreign-strings (bindings &body body)
 608   `(with-foreign-string ,(car bindings)
 609     ,@(if (cdr bindings)
 610           `((with-foreign-strings ,(cdr bindings) ,@body))
 611           body)))
 612
 613 ;; This function returns a form? Where is this used in user-code?
 614 (defun foreign-string-length (foreign-string)
 615   (declare (ignore foreign-string))
 616   (error "FOREIGN-STRING-LENGTH not implemented."))
 617
 618 ;; This should be optimized.
 619 (defun convert-from-foreign-usb8 (s len)
 620   (let ((a (make-array len :element-type '(unsigned-byte 8))))
 621     (dotimes (i len a)
 622       (setf (aref a i) (cffi:mem-ref s :unsigned-char i)))))