Coverage report: /home/luis/src/cffi/src/enum.lisp
Kind | Covered | All | % |
expression | 96 | 141 | 68.1 |
branch | 10 | 30 | 33.3 |
Key
Not instrumented
Executed
Not executed
Both branches taken
One branch taken
Neither branch taken
1
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
3
;;; enum.lisp --- Defining foreign constants as Lisp keywords.
5
;;; Copyright (C) 2005-2006, James Bielman <jamesjb@jamesjb.com>
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
;;;# Foreign Constants as Lisp Keywords
32
;;; This module defines the DEFCENUM macro, which provides an
33
;;; interface for defining a type and associating a set of integer
34
;;; constants with keyword symbols for that type.
36
;;; The keywords are automatically translated to the appropriate
37
;;; constant for the type by a type translator when passed as
38
;;; arguments or a return value to a foreign function.
40
(defclass foreign-enum (foreign-typedef enhanced-foreign-type)
42
:initform (make-hash-table :test 'eq)
43
:reader keyword-values)
45
:initform (make-hash-table)
46
:reader value-keywords))
47
(:documentation "Describes a foreign enumerated type."))
49
(defun make-foreign-enum (type-name base-type values)
50
"Makes a new instance of the foreign-enum class."
51
(let ((type (make-instance 'foreign-enum :name type-name
52
:actual-type (parse-type base-type)))
55
(destructuring-bind (keyword &optional (value default-value))
57
(check-type keyword keyword)
58
(check-type value integer)
59
(if (gethash keyword (keyword-values type))
60
(error "A foreign enum cannot contain duplicate keywords: ~S."
62
(setf (gethash keyword (keyword-values type)) value))
63
;; This completely arbitrary behaviour: we keep the last we
64
;; value->keyword mapping. I suppose the opposite would be just as
65
;; good (keeping the first). Returning a list with all the keywords
66
;; might be a solution too? Suggestions welcome. --luis
67
(setf (gethash value (value-keywords type)) keyword)
68
(setq default-value (1+ value))))
71
(defmacro defcenum (name-and-options &body enum-list)
72
"Define an foreign enumerated type."
73
(discard-docstring enum-list)
74
(destructuring-bind (name &optional (base-type :int))
75
(ensure-list name-and-options)
76
`(eval-when (:compile-toplevel :load-toplevel :execute)
78
',name (make-foreign-enum ',name ',base-type ',enum-list)))))
80
;;; These [four] functions could be good canditates for compiler macros
81
;;; when the value or keyword is constant. I am not going to bother
82
;;; until someone has a serious performance need to do so though. --jamesjb
83
(defun %foreign-enum-value (type keyword &key errorp)
84
(check-type keyword keyword)
85
(or (gethash keyword (keyword-values type))
87
(error "~S is not defined as a keyword for enum type ~S."
90
(defun foreign-enum-value (type keyword &key (errorp t))
91
"Convert a KEYWORD into an integer according to the enum TYPE."
92
(let ((type-obj (parse-type type)))
93
(if (not (typep type-obj 'foreign-enum))
94
(error "~S is not a foreign enum type." type)
95
(%foreign-enum-value type-obj keyword :errorp errorp))))
97
(defun %foreign-enum-keyword (type value &key errorp)
98
(check-type value integer)
99
(or (gethash value (value-keywords type))
101
(error "~S is not defined as a value for enum type ~S."
104
(defun foreign-enum-keyword (type value &key (errorp t))
105
"Convert an integer VALUE into a keyword according to the enum TYPE."
106
(let ((type-obj (parse-type type)))
107
(if (not (typep type-obj 'foreign-enum))
108
(error "~S is not a foreign enum type." type)
109
(%foreign-enum-keyword type-obj value :errorp errorp))))
111
(defmethod translate-to-foreign (value (type foreign-enum))
113
(%foreign-enum-value type value :errorp t)
116
(defmethod translate-from-foreign (value (type foreign-enum))
117
(%foreign-enum-keyword type value :errorp t))
119
;;;# Foreign Bitfields as Lisp keywords
121
;;; DEFBITFIELD is an abstraction similar to the one provided by DEFCENUM.
122
;;; With some changes to DEFCENUM, this could certainly be implemented on
125
(defclass foreign-bitfield (foreign-typedef enhanced-foreign-type)
127
:initform (make-hash-table :test 'eq)
128
:reader symbol-values)
130
:initform (make-hash-table)
131
:reader value-symbols))
132
(:documentation "Describes a foreign bitfield type."))
134
(defun make-foreign-bitfield (type-name base-type values)
135
"Makes a new instance of the foreign-bitfield class."
136
(let ((type (make-instance 'foreign-bitfield :name type-name
137
:actual-type (parse-type base-type)))
139
(dolist (pair values)
140
;; bit-floor rule: find the greatest single-bit int used so far,
141
;; and store its left-shift
142
(destructuring-bind (symbol &optional
143
(value (prog1 bit-floor
144
(setf bit-floor (ash bit-floor 1)))
147
(check-type symbol symbol)
149
(check-type value integer)
150
(when (and (>= value bit-floor) (single-bit-p value))
151
(setf bit-floor (ash value 1))))
152
(if (gethash symbol (symbol-values type))
153
(error "A foreign bitfield cannot contain duplicate symbols: ~S."
155
(setf (gethash symbol (symbol-values type)) value))
156
(push symbol (gethash value (value-symbols type)))))
159
(defmacro defbitfield (name-and-options &body masks)
160
"Define an foreign enumerated type."
161
(discard-docstring masks)
162
(destructuring-bind (name &optional (base-type :int))
163
(ensure-list name-and-options)
164
`(eval-when (:compile-toplevel :load-toplevel :execute)
166
',name (make-foreign-bitfield ',name ',base-type ',masks)))))
168
(defun %foreign-bitfield-value (type symbols)
169
(reduce #'logior symbols
170
:key (lambda (symbol)
171
(check-type symbol symbol)
172
(or (gethash symbol (symbol-values type))
173
(error "~S is not a valid symbol for bitfield type ~S."
176
(defun foreign-bitfield-value (type symbols)
177
"Convert a list of symbols into an integer according to the TYPE bitfield."
178
(let ((type-obj (parse-type type)))
179
(if (not (typep type-obj 'foreign-bitfield))
180
(error "~S is not a foreign bitfield type." type)
181
(%foreign-bitfield-value type-obj symbols))))
183
(defun %foreign-bitfield-symbols (type value)
184
(check-type value integer)
185
(loop for mask being the hash-keys in (value-symbols type)
186
using (hash-value symbols)
187
when (= (logand value mask) mask)
190
(defun foreign-bitfield-symbols (type value)
191
"Convert an integer VALUE into a list of matching symbols according to
193
(let ((type-obj (parse-type type)))
194
(if (not (typep type-obj 'foreign-bitfield))
195
(error "~S is not a foreign bitfield type." type)
196
(%foreign-bitfield-symbols type-obj value))))
198
(defmethod translate-to-foreign (value (type foreign-bitfield))
201
(%foreign-bitfield-value type (ensure-list value))))
203
(defmethod translate-from-foreign (value (type foreign-bitfield))
204
(%foreign-bitfield-symbols type value))