Coverage report: /home/luis/src/cffi/src/foreign-vars.lisp
Kind | Covered | All | % |
expression | 53 | 56 | 94.6 |
branch | 3 | 4 | 75.0 |
Key
Not instrumented
Executed
Not executed
Both branches taken
One branch taken
Neither branch taken
1
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
3
;;; foreign-vars.lisp --- High-level interface to foreign globals.
5
;;; Copyright (C) 2005-2007, Luis Oliveira <loliveira(@)common-lisp.net>
7
;;; Permission is hereby granted, free of charge, to any person
8
;;; obtaining a copy of this software and associated documentation
9
;;; files (the "Software"), to deal in the Software without
10
;;; restriction, including without limitation the rights to use, copy,
11
;;; modify, merge, publish, distribute, sublicense, and/or sell copies
12
;;; of the Software, and to permit persons to whom the Software is
13
;;; furnished to do so, subject to the following conditions:
15
;;; The above copyright notice and this permission notice shall be
16
;;; included in all copies or substantial portions of the Software.
18
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
19
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
20
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
21
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
22
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
23
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
24
;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
25
;;; DEALINGS IN THE SOFTWARE.
30
;;;# Accessing Foreign Globals
32
;;; Called by FOREIGN-OPTIONS in functions.lisp.
33
(defun parse-defcvar-options (options)
34
(destructuring-bind (&key (library :default) read-only) options
35
(list :library library :read-only read-only)))
37
(defun get-var-pointer (symbol)
38
"Return a pointer to the foreign global variable relative to SYMBOL."
39
(foreign-symbol-pointer (get symbol 'foreign-var-name)
40
:library (get symbol 'foreign-var-library)))
42
;;; Note: this will lookup not only variables but also functions.
43
(defun foreign-symbol-pointer (name &key (library :default))
44
(%foreign-symbol-pointer
45
name (if (eq library :default)
47
(foreign-library-handle
48
(get-foreign-library library)))))
50
(defun fs-pointer-or-lose (foreign-name library)
51
"Like foreign-symbol-ptr but throws an error instead of
52
returning nil when foreign-name is not found."
53
(or (foreign-symbol-pointer foreign-name :library library)
54
(error "Trying to access undefined foreign variable ~S." foreign-name)))
56
(defmacro defcvar (name-and-options type &optional documentation)
57
"Define a foreign global variable."
58
(declare (ignore documentation))
59
(multiple-value-bind (lisp-name foreign-name options)
60
(parse-name-and-options name-and-options t)
61
(let ((fn (symbolicate '#:%var-accessor- lisp-name))
62
(read-only (getf options :read-only))
63
(library (getf options :library)))
64
;; We can't really setf an aggregate type.
65
(when (aggregatep (parse-type type))
68
;; Save foreign-name and library for posterior access by
70
(setf (get ',lisp-name 'foreign-var-name) ,foreign-name)
71
(setf (get ',lisp-name 'foreign-var-library) ',library)
74
(mem-ref (fs-pointer-or-lose ,foreign-name ',library) ',type))
76
(defun (setf ,fn) (value)
77
,(if read-only '(declare (ignore value)) (values))
79
`(error ,(format nil "Trying to modify read-only foreign var: ~A."
81
`(setf (mem-ref (fs-pointer-or-lose ,foreign-name ',library)
84
;; While most Lisps already expand DEFINE-SYMBOL-MACRO to an
85
;; EVAL-WHEN form like this, that is not required by the
86
;; standard so we do it ourselves.
87
(eval-when (:compile-toplevel :load-toplevel :execute)
88
(define-symbol-macro ,lisp-name (,fn)))))))