Tmux etc
This commit is contained in:
Ian Keane
parent
276853ba84
commit
1cb167b597
361 changed files with 77302 additions and 4 deletions
|
|
@ -0,0 +1,78 @@
|
|||
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
|
||||
;;;
|
||||
;;; examples.lisp --- Simple test examples of CFFI.
|
||||
;;;
|
||||
;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
|
||||
;;;
|
||||
;;; Permission is hereby granted, free of charge, to any person
|
||||
;;; obtaining a copy of this software and associated documentation
|
||||
;;; files (the "Software"), to deal in the Software without
|
||||
;;; restriction, including without limitation the rights to use, copy,
|
||||
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
|
||||
;;; of the Software, and to permit persons to whom the Software is
|
||||
;;; furnished to do so, subject to the following conditions:
|
||||
;;;
|
||||
;;; The above copyright notice and this permission notice shall be
|
||||
;;; included in all copies or substantial portions of the Software.
|
||||
;;;
|
||||
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
|
||||
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
|
||||
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
|
||||
;;; DEALINGS IN THE SOFTWARE.
|
||||
;;;
|
||||
|
||||
(defpackage #:cffi-examples
|
||||
(:use #:cl #:cffi)
|
||||
(:export
|
||||
#:run-examples
|
||||
#:sqrtf
|
||||
#:getenv))
|
||||
|
||||
(in-package #:cffi-examples)
|
||||
|
||||
;; A simple libc function.
|
||||
(defcfun "sqrtf" :float
|
||||
(n :float))
|
||||
|
||||
;; This definition uses the STRING type translator to automatically
|
||||
;; convert Lisp strings to foreign strings and vice versa.
|
||||
(defcfun "getenv" :string
|
||||
(name :string))
|
||||
|
||||
;; Calling a varargs function.
|
||||
(defun sprintf-test ()
|
||||
"Test calling a varargs function."
|
||||
(with-foreign-pointer-as-string ((buf buf-size) 255)
|
||||
(foreign-funcall
|
||||
"snprintf" :pointer buf :int buf-size
|
||||
:string "%d %f #x%x!" :int 666
|
||||
:double (coerce pi 'double-float)
|
||||
:unsigned-int #xcafebabe
|
||||
:void)))
|
||||
|
||||
;; Defining an emerated type.
|
||||
(defcenum test-enum
|
||||
(:invalid 0)
|
||||
(:positive 1)
|
||||
(:negative -1))
|
||||
|
||||
;; Use the absolute value function to test keyword/enum translation.
|
||||
(defcfun ("abs" c-abs) test-enum
|
||||
(n test-enum))
|
||||
|
||||
(defun cffi-version ()
|
||||
(asdf:component-version (asdf:find-system 'cffi)))
|
||||
|
||||
(defun run-examples ()
|
||||
(format t "~&;;; CFFI version ~A on ~A ~A:~%"
|
||||
(cffi-version) (lisp-implementation-type)
|
||||
(lisp-implementation-version))
|
||||
(format t "~&;; shell: ~A~%" (getenv "SHELL"))
|
||||
(format t "~&;; sprintf test: ~A~%" (sprintf-test))
|
||||
(format t "~&;; (c-abs :positive): ~A~%" (c-abs :positive))
|
||||
(format t "~&;; (c-abs :negative): ~A~%" (c-abs :negative))
|
||||
(force-output))
|
||||
|
|
@ -0,0 +1,51 @@
|
|||
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
|
||||
;;;
|
||||
;;; gethostname.lisp --- A simple CFFI example.
|
||||
;;;
|
||||
;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
|
||||
;;;
|
||||
;;; Permission is hereby granted, free of charge, to any person
|
||||
;;; obtaining a copy of this software and associated documentation
|
||||
;;; files (the "Software"), to deal in the Software without
|
||||
;;; restriction, including without limitation the rights to use, copy,
|
||||
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
|
||||
;;; of the Software, and to permit persons to whom the Software is
|
||||
;;; furnished to do so, subject to the following conditions:
|
||||
;;;
|
||||
;;; The above copyright notice and this permission notice shall be
|
||||
;;; included in all copies or substantial portions of the Software.
|
||||
;;;
|
||||
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
|
||||
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
|
||||
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
|
||||
;;; DEALINGS IN THE SOFTWARE.
|
||||
;;;
|
||||
|
||||
;;;# CFFI Example: gethostname binding
|
||||
;;;
|
||||
;;; This is a very simple CFFI example that illustrates calling a C
|
||||
;;; function that fills in a user-supplied string buffer.
|
||||
|
||||
(defpackage #:cffi-example-gethostname
|
||||
(:use #:common-lisp #:cffi)
|
||||
(:export #:gethostname))
|
||||
|
||||
(in-package #:cffi-example-gethostname)
|
||||
|
||||
;;; Define the Lisp function %GETHOSTNAME to call the C 'gethostname'
|
||||
;;; function, which will fill BUF with up to BUFSIZE characters of the
|
||||
;;; system's hostname.
|
||||
(defcfun ("gethostname" %gethostname) :int
|
||||
(buf :pointer)
|
||||
(bufsize :int))
|
||||
|
||||
;;; Define a Lispy interface to 'gethostname'. The utility macro
|
||||
;;; WITH-FOREIGN-POINTER-AS-STRING is used to allocate a temporary
|
||||
;;; buffer and return it as a Lisp string.
|
||||
(defun gethostname ()
|
||||
(with-foreign-pointer-as-string ((buf bufsize) 255)
|
||||
(%gethostname buf bufsize)))
|
||||
|
|
@ -0,0 +1,93 @@
|
|||
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
|
||||
;;;
|
||||
;;; gettimeofday.lisp --- Example CFFI binding to gettimeofday(2)
|
||||
;;;
|
||||
;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
|
||||
;;;
|
||||
;;; Permission is hereby granted, free of charge, to any person
|
||||
;;; obtaining a copy of this software and associated documentation
|
||||
;;; files (the "Software"), to deal in the Software without
|
||||
;;; restriction, including without limitation the rights to use, copy,
|
||||
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
|
||||
;;; of the Software, and to permit persons to whom the Software is
|
||||
;;; furnished to do so, subject to the following conditions:
|
||||
;;;
|
||||
;;; The above copyright notice and this permission notice shall be
|
||||
;;; included in all copies or substantial portions of the Software.
|
||||
;;;
|
||||
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
|
||||
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
|
||||
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
|
||||
;;; DEALINGS IN THE SOFTWARE.
|
||||
;;;
|
||||
|
||||
;;;# CFFI Example: gettimeofday binding
|
||||
;;;
|
||||
;;; This example illustrates the use of foreign structures, typedefs,
|
||||
;;; and using type translators to do checking of input and output
|
||||
;;; arguments to a foreign function.
|
||||
|
||||
(defpackage #:cffi-example-gettimeofday
|
||||
(:use #:common-lisp #:cffi)
|
||||
(:export #:gettimeofday))
|
||||
|
||||
(in-package #:cffi-example-gettimeofday)
|
||||
|
||||
;;; Define the TIMEVAL structure used by 'gettimeofday'. This assumes
|
||||
;;; that 'time_t' is a 'long' --- it would be nice if CFFI could
|
||||
;;; provide a proper :TIME-T type to help make this portable.
|
||||
(defcstruct timeval
|
||||
(tv-sec :long)
|
||||
(tv-usec :long))
|
||||
|
||||
;;; A NULL-POINTER is a foreign :POINTER that must always be NULL.
|
||||
;;; Both a NULL pointer and NIL are legal values---any others will
|
||||
;;; result in a runtime error.
|
||||
(define-foreign-type null-pointer-type ()
|
||||
()
|
||||
(:actual-type :pointer)
|
||||
(:simple-parser null-pointer))
|
||||
|
||||
;;; This type translator is used to ensure that a NULL-POINTER has a
|
||||
;;; null value. It also converts NIL to a null pointer.
|
||||
(defmethod translate-to-foreign (value (type null-pointer-type))
|
||||
(cond
|
||||
((null value) (null-pointer))
|
||||
((null-pointer-p value) value)
|
||||
(t (error "~A is not a null pointer." value))))
|
||||
|
||||
;;; The SYSCALL-RESULT type is an integer type used for the return
|
||||
;;; value of C functions that return -1 and set errno on errors.
|
||||
;;; Someday when CFFI has a portable interface for dealing with
|
||||
;;; 'errno', this error reporting can be more useful.
|
||||
(define-foreign-type syscall-result-type ()
|
||||
()
|
||||
(:actual-type :int)
|
||||
(:simple-parser syscall-result))
|
||||
|
||||
;;; Type translator to check a SYSCALL-RESULT and signal a Lisp error
|
||||
;;; if the value is negative.
|
||||
(defmethod translate-from-foreign (value (type syscall-result-type))
|
||||
(if (minusp value)
|
||||
(error "System call failed with return value ~D." value)
|
||||
value))
|
||||
|
||||
;;; Define the Lisp function %GETTIMEOFDAY to call the C function
|
||||
;;; 'gettimeofday', passing a pointer to the TIMEVAL structure to fill
|
||||
;;; in. The TZP parameter is deprecated and should be NULL --- we can
|
||||
;;; enforce this by using our NULL-POINTER type defined above.
|
||||
(defcfun ("gettimeofday" %gettimeofday) syscall-result
|
||||
(tp :pointer)
|
||||
(tzp null-pointer))
|
||||
|
||||
;;; Define a Lispy interface to 'gettimeofday' that returns the
|
||||
;;; seconds and microseconds as multiple values.
|
||||
(defun gettimeofday ()
|
||||
(with-foreign-object (tv 'timeval)
|
||||
(%gettimeofday tv nil)
|
||||
(with-foreign-slots ((tv-sec tv-usec) tv timeval)
|
||||
(values tv-sec tv-usec))))
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
(in-package #:cffi-example)
|
||||
|
||||
(define "a0(x)" "+x+x")
|
||||
(define "a1(x)" "a0(+x+x)")
|
||||
(define "a2(x)" "a1(+x+x)")
|
||||
(define "a3(x)" "a2(+x+x)")
|
||||
(define "a4(x)" "a3(+x+x)")
|
||||
(define "a5(x)" "a4(+x+x)")
|
||||
|
||||
(define "A0" "a0(1)")
|
||||
(define "A1" "a1(1)")
|
||||
(define "A2" "a2(1)")
|
||||
(define "A3" "a3(1)")
|
||||
(define "A4" "a4(1)")
|
||||
|
||||
(constant (+a0+ "A0"))
|
||||
(constant (+a1+ "A1"))
|
||||
(constant (+a2+ "A2"))
|
||||
(constant (+a3+ "A3"))
|
||||
(constant (+a4+ "A4"))
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
(in-package #:cffi-example)
|
||||
|
||||
(defcfun "puts" :int
|
||||
"Put a string to standard output, return non-negative length output, or EOF"
|
||||
(string :string))
|
||||
|
||||
(defun check-groveller ()
|
||||
(assert (equal (list +a0+ +a1+ +a2+ +a3+ +a4+) '(2 4 8 16 32)))
|
||||
(assert (equal (bn 1) 32)))
|
||||
|
||||
(defun entry-point ()
|
||||
(when uiop:*command-line-arguments*
|
||||
(uiop:format! t "Arguments: ~A~%" (uiop:escape-command uiop:*command-line-arguments*)))
|
||||
(puts "hello, world!")
|
||||
(check-groveller)
|
||||
(uiop:finish-outputs)
|
||||
(uiop:quit 0))
|
||||
|
|
@ -0,0 +1,76 @@
|
|||
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
|
||||
;;;
|
||||
;;; mapping.lisp --- An example for mapping Lisp objects to ints.
|
||||
;;;
|
||||
;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
|
||||
;;;
|
||||
;;; Permission is hereby granted, free of charge, to any person
|
||||
;;; obtaining a copy of this software and associated documentation
|
||||
;;; files (the "Software"), to deal in the Software without
|
||||
;;; restriction, including without limitation the rights to use, copy,
|
||||
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
|
||||
;;; of the Software, and to permit persons to whom the Software is
|
||||
;;; furnished to do so, subject to the following conditions:
|
||||
;;;
|
||||
;;; The above copyright notice and this permission notice shall be
|
||||
;;; included in all copies or substantial portions of the Software.
|
||||
;;;
|
||||
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
|
||||
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
|
||||
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
|
||||
;;; DEALINGS IN THE SOFTWARE.
|
||||
;;;
|
||||
|
||||
;;; This is an example on how to tackle the problem of passing Lisp
|
||||
;;; object identifiers to foreign code. It is not a great example,
|
||||
;;; but might be useful nevertheless.
|
||||
;;;
|
||||
;;; Requires trivial-garbage: <http://cliki.net/trivial-garbage>
|
||||
|
||||
(defpackage #:cffi-mapping-test
|
||||
(:use #:common-lisp #:cffi #:trivial-garbage)
|
||||
(:export #:run))
|
||||
|
||||
(in-package #:cffi-mapping-test)
|
||||
|
||||
(define-foreign-type lisp-object-type ()
|
||||
((weakp :initarg :weakp))
|
||||
(:actual-type :unsigned-int))
|
||||
|
||||
(define-parse-method lisp-object (&key weak-mapping)
|
||||
(make-instance 'lisp-object-type :weakp weak-mapping))
|
||||
|
||||
(defvar *regular-hashtable* (make-hash-table))
|
||||
(defvar *weak-hashtable* (make-weak-hash-table :weakness :value))
|
||||
(defvar *regular-counter* 0)
|
||||
(defvar *weak-counter* 0)
|
||||
|
||||
(defun increment-counter (value)
|
||||
(mod (1+ value) (expt 2 (* 8 (foreign-type-size :unsigned-int)))))
|
||||
|
||||
(define-modify-macro incf-counter () increment-counter)
|
||||
|
||||
(defmethod translate-to-foreign (value (type lisp-object-type))
|
||||
(with-slots (weakp) type
|
||||
(let ((id (if weakp
|
||||
(incf-counter *weak-counter*)
|
||||
(incf-counter *regular-counter*)))
|
||||
(ht (if weakp *weak-hashtable* *regular-hashtable*)))
|
||||
(setf (gethash id ht) value)
|
||||
id)))
|
||||
|
||||
(defmethod translate-from-foreign (int (type lisp-object-type))
|
||||
(with-slots (weakp) type
|
||||
(gethash int (if weakp *weak-hashtable* *regular-hashtable*))))
|
||||
|
||||
;;;; Silly example.
|
||||
|
||||
(defctype weak-mapping (lisp-object :weak-mapping t))
|
||||
|
||||
;;; (run) => #<FUNCTION (LAMBDA (X)) {11AB46F5}>
|
||||
(defun run ()
|
||||
(foreign-funcall "abs" weak-mapping (lambda (x) x) weak-mapping))
|
||||
|
|
@ -0,0 +1,30 @@
|
|||
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
|
||||
;;;
|
||||
;;; package.lisp --- CFFI-EXAMPLES package definition.
|
||||
;;;
|
||||
;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
|
||||
;;;
|
||||
;;; Permission is hereby granted, free of charge, to any person
|
||||
;;; obtaining a copy of this software and associated documentation
|
||||
;;; files (the "Software"), to deal in the Software without
|
||||
;;; restriction, including without limitation the rights to use, copy,
|
||||
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
|
||||
;;; of the Software, and to permit persons to whom the Software is
|
||||
;;; furnished to do so, subject to the following conditions:
|
||||
;;;
|
||||
;;; The above copyright notice and this permission notice shall be
|
||||
;;; included in all copies or substantial portions of the Software.
|
||||
;;;
|
||||
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
|
||||
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
|
||||
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
|
||||
;;; DEALINGS IN THE SOFTWARE.
|
||||
;;;
|
||||
|
||||
(defpackage #:cffi-example
|
||||
(:use #:cl #:cffi #:cffi-sys)
|
||||
(:export #:check-groveller #:entry-point))
|
||||
|
|
@ -0,0 +1,39 @@
|
|||
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
|
||||
;;;
|
||||
;;; run-examples.lisp --- Simple script to run the examples.
|
||||
;;;
|
||||
;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
|
||||
;;;
|
||||
;;; Permission is hereby granted, free of charge, to any person
|
||||
;;; obtaining a copy of this software and associated documentation
|
||||
;;; files (the "Software"), to deal in the Software without
|
||||
;;; restriction, including without limitation the rights to use, copy,
|
||||
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
|
||||
;;; of the Software, and to permit persons to whom the Software is
|
||||
;;; furnished to do so, subject to the following conditions:
|
||||
;;;
|
||||
;;; The above copyright notice and this permission notice shall be
|
||||
;;; included in all copies or substantial portions of the Software.
|
||||
;;;
|
||||
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
|
||||
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
|
||||
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
|
||||
;;; DEALINGS IN THE SOFTWARE.
|
||||
;;;
|
||||
|
||||
(setf *load-verbose* nil *compile-verbose* nil)
|
||||
|
||||
#-asdf
|
||||
(ignore-errors (require "asdf"))
|
||||
#-asdf
|
||||
(load "~/common-lisp/asdf/build/asdf.lisp")
|
||||
|
||||
(asdf:load-system 'cffi-examples :verbose nil)
|
||||
(cffi-examples:run-examples)
|
||||
(force-output)
|
||||
|
||||
(quit)
|
||||
|
|
@ -0,0 +1,88 @@
|
|||
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
|
||||
;;;
|
||||
;;; translator-test.lisp --- Testing type translators.
|
||||
;;;
|
||||
;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
|
||||
;;;
|
||||
;;; Permission is hereby granted, free of charge, to any person
|
||||
;;; obtaining a copy of this software and associated documentation
|
||||
;;; files (the "Software"), to deal in the Software without
|
||||
;;; restriction, including without limitation the rights to use, copy,
|
||||
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
|
||||
;;; of the Software, and to permit persons to whom the Software is
|
||||
;;; furnished to do so, subject to the following conditions:
|
||||
;;;
|
||||
;;; The above copyright notice and this permission notice shall be
|
||||
;;; included in all copies or substantial portions of the Software.
|
||||
;;;
|
||||
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
||||
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
|
||||
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
||||
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
|
||||
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
|
||||
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
|
||||
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
|
||||
;;; DEALINGS IN THE SOFTWARE.
|
||||
;;;
|
||||
|
||||
(defpackage #:cffi-translator-test
|
||||
(:use #:common-lisp #:cffi))
|
||||
|
||||
(in-package #:cffi-translator-test)
|
||||
|
||||
;;;# Verbose Pointer Translator
|
||||
;;;
|
||||
;;; This is a silly type translator that doesn't actually do any
|
||||
;;; translating, but it prints out a debug message when the pointer is
|
||||
;;; converted to/from its foreign representation.
|
||||
|
||||
(define-foreign-type verbose-pointer-type ()
|
||||
()
|
||||
(:actual-type :pointer))
|
||||
|
||||
(defmethod translate-to-foreign (value (type verbose-pointer-type))
|
||||
(format *debug-io* "~&;; to foreign: VERBOSE-POINTER: ~S~%" value)
|
||||
value)
|
||||
|
||||
(defmethod translate-from-foreign (value (type verbose-pointer-type))
|
||||
(format *debug-io* "~&;; from foreign: VERBOSE-POINTER: ~S~%" value)
|
||||
value)
|
||||
|
||||
;;;# Verbose String Translator
|
||||
;;;
|
||||
;;; A VERBOSE-STRING extends VERBOSE-POINTER and converts Lisp strings
|
||||
;;; C strings. If things are working properly, both type translators
|
||||
;;; should be called when converting a Lisp string to/from a C string.
|
||||
;;;
|
||||
;;; The translators should be called most-specific-first when
|
||||
;;; translating to C, and most-specific-last when translating from C.
|
||||
|
||||
(define-foreign-type verbose-string-type (verbose-pointer-type)
|
||||
()
|
||||
(:simple-parser verbose-string))
|
||||
|
||||
(defmethod translate-to-foreign ((s string) (type verbose-string-type))
|
||||
(let ((value (foreign-string-alloc s)))
|
||||
(format *debug-io* "~&;; to foreign: VERBOSE-STRING: ~S -> ~S~%" s value)
|
||||
(values (call-next-method value type) t)))
|
||||
|
||||
(defmethod translate-to-foreign (value (type verbose-string-type))
|
||||
(if (pointerp value)
|
||||
(progn
|
||||
(format *debug-io* "~&;; to foreign: VERBOSE-STRING: ~S -> ~:*~S~%" value)
|
||||
(values (call-next-method) nil))
|
||||
(error "Cannot convert ~S to a foreign string: it is not a Lisp ~
|
||||
string or pointer." value)))
|
||||
|
||||
(defmethod translate-from-foreign (ptr (type verbose-string-type))
|
||||
(let ((value (foreign-string-to-lisp (call-next-method))))
|
||||
(format *debug-io* "~&;; from foreign: VERBOSE-STRING: ~S -> ~S~%" ptr value)
|
||||
value))
|
||||
|
||||
(defmethod free-translated-object (ptr (type verbose-string-type) free-p)
|
||||
(when free-p
|
||||
(format *debug-io* "~&;; freeing VERBOSE-STRING: ~S~%" ptr)
|
||||
(foreign-string-free ptr)))
|
||||
|
||||
(defun test-verbose-string ()
|
||||
(foreign-funcall "getenv" verbose-string "SHELL" verbose-string))
|
||||
|
|
@ -0,0 +1,20 @@
|
|||
(in-package #:cffi-example)
|
||||
|
||||
(defwrapper* "b0" :long ((x :long)) "return x;")
|
||||
(defwrapper* "b1" :long ((x :long)) "return x;")
|
||||
(defwrapper* "b2" :long ((x :long)) "return x;")
|
||||
(defwrapper* "b3" :long ((x :long)) "return x;")
|
||||
(defwrapper* "b4" :long ((x :long)) "return x;")
|
||||
|
||||
(define "b0_cffi_wrap(x)"
|
||||
"b0_cffi_wrap(b1_cffi_wrap(b2_cffi_wrap(b3_cffi_wrap(b4_cffi_wrap(+x+x)))))")
|
||||
(define "b1_cffi_wrap(x)"
|
||||
"b0_cffi_wrap(b1_cffi_wrap(b2_cffi_wrap(b3_cffi_wrap(b4_cffi_wrap(+x+x)))))")
|
||||
(define "b2_cffi_wrap(x)"
|
||||
"b0_cffi_wrap(b1_cffi_wrap(b2_cffi_wrap(b3_cffi_wrap(b4_cffi_wrap(+x+x)))))")
|
||||
;;(define "b3_cffi_wrap(x)"
|
||||
;; "b0_cffi_wrap(b1_cffi_wrap(b2_cffi_wrap(b3_cffi_wrap(b4_cffi_wrap(+x+x)))))")
|
||||
;;(define "b4_cffi_wrap(x)"
|
||||
;; "b0_cffi_wrap(b1_cffi_wrap(b2_cffi_wrap(b3_cffi_wrap(b4_cffi_wrap(+x+x)))))")
|
||||
|
||||
(defwrapper* "bn" :long ((x :long)) "return b0_cffi_wrap(x);")
|
||||
Loading…
Add table
Add a link
Reference in a new issue