├── doc ├── manual │ ├── virgil-manual.pdf │ ├── virgil-manual.dvi.gz │ ├── virgil-manual.ps.gz │ ├── virgil-manual.txt.gz │ ├── virgil-manual.html.gz │ ├── virgil-manual.info.tar.gz │ ├── virgil-manual.texi.tar.gz │ ├── virgil-manual.html_node.tar.gz │ ├── html_node │ │ ├── Const-Types.html │ │ ├── Proxy-Types.html │ │ ├── Symbols-Re_002dExported-from-CFFI.html │ │ ├── Tutorial.html │ │ ├── Functions.html │ │ ├── Structures-and-Unions.html │ │ ├── Arrays-and-Sequences.html │ │ ├── Glossary.html │ │ ├── Strictly-Aligned-Types.html │ │ ├── Filtered-Types.html │ │ ├── Built_002din-Primitives.html │ │ ├── Strings.html │ │ ├── References.html │ │ ├── Enumerations.html │ │ ├── Aggregate-Types.html │ │ ├── Immediate-Types.html │ │ ├── Defining-and-Parsing-Type-Specifiers.html │ │ ├── Primitive-Types.html │ │ ├── Translators.html │ │ ├── Translators-and-Translatable-Types.html │ │ ├── Built_002din-Types.html │ │ ├── Introduction.html │ │ ├── Installation-and-Prerequisites.html │ │ └── User_002dlevel-API.html │ └── index.html ├── Makefile ├── style.css └── gendocs_template ├── README ├── .gitignore ├── TODO ├── COPYRIGHT ├── test └── package.lisp ├── virgil-test.asd ├── src ├── features.lisp ├── proxy.lisp ├── const.lisp ├── package.lisp ├── aligned.lisp ├── filtered.lisp ├── enums.lisp └── primitives.lisp └── virgil.asd /doc/manual/virgil-manual.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Lovesan/virgil/HEAD/doc/manual/virgil-manual.pdf -------------------------------------------------------------------------------- /doc/manual/virgil-manual.dvi.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Lovesan/virgil/HEAD/doc/manual/virgil-manual.dvi.gz -------------------------------------------------------------------------------- /doc/manual/virgil-manual.ps.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Lovesan/virgil/HEAD/doc/manual/virgil-manual.ps.gz -------------------------------------------------------------------------------- /doc/manual/virgil-manual.txt.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Lovesan/virgil/HEAD/doc/manual/virgil-manual.txt.gz -------------------------------------------------------------------------------- /doc/manual/virgil-manual.html.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Lovesan/virgil/HEAD/doc/manual/virgil-manual.html.gz -------------------------------------------------------------------------------- /doc/manual/virgil-manual.info.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Lovesan/virgil/HEAD/doc/manual/virgil-manual.info.tar.gz -------------------------------------------------------------------------------- /doc/manual/virgil-manual.texi.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Lovesan/virgil/HEAD/doc/manual/virgil-manual.texi.tar.gz -------------------------------------------------------------------------------- /doc/manual/virgil-manual.html_node.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Lovesan/virgil/HEAD/doc/manual/virgil-manual.html_node.tar.gz -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | A lisper's guide to the lower levels. 2 | 3 | Virgil is an extensible and high level foreign function interface(FFI), 4 | built on top of CFFI, and oriented towards marshalling lisp data 5 | into raw memory and back. 6 | It currently supports x86 and x86-64 platforms. 7 | 8 | ..More docs upcoming 9 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.fasl 2 | *.dx32fsl 3 | *.dx64fsl 4 | *.lx32fsl 5 | *.lx64fsl 6 | *.x86f 7 | *.wx64fsl 8 | doc/virgil-manual.aux 9 | doc/virgil-manual.cp 10 | doc/virgil-manual.fn 11 | doc/virgil-manual.info 12 | doc/virgil-manual.ky 13 | doc/virgil-manual.log 14 | doc/virgil-manual.pg 15 | doc/virgil-manual.toc 16 | doc/virgil-manual.tp 17 | doc/virgil-manual.vr 18 | -------------------------------------------------------------------------------- /doc/Makefile: -------------------------------------------------------------------------------- 1 | all: manual 2 | 3 | manual: virgil-manual.texinfo style.css 4 | sh gendocs.sh -o manual --html "--css-include=style.css" virgil-manual "Virgil User Manual" 5 | 6 | clean: 7 | find . \( -name "*.temp" -o -name "*.info" -o -name "*.aux" -o -name "*.cp" -o -name "*.fn" -o -name "*.fns" -o -name "*.ky" -o -name "*.log" -o -name "*.pg" -o -name "*.toc" -o -name "*.tp" -o -name "*.vr" -o -name "*.dvi" -o -name "*.cps" -o -name "*.vrs" \) -exec rm {} \; 8 | rm -rf manual 9 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | EXTERNAL VARIABLES 2 | As in CFFI. And, maybe, local variables too. 3 | 4 | BITFIELDS 5 | Uhm... Ok, but who uses bitfields, anyway? 6 | 7 | BY-VALUE PASSAGE OF AGGREGATE TYPE FUNCTION PARAMETERS 8 | Well, this is obvious that most CL implementations do not allow 9 | aggregate types(structs etc.) to be passed by value. However, we can 10 | simulate this by converting values of fixed size into raw bytes 11 | and then passing that bytes as parameters. Not sure what to do with 12 | alignment stuff in this case. 13 | 14 | EXAMPLES 15 | Some examples of library features. 16 | 17 | TESTS 18 | A couple of tests would be nice. 19 | 20 | DOCUMENTATION 21 | No comments. 22 | -------------------------------------------------------------------------------- /COPYRIGHT: -------------------------------------------------------------------------------- 1 | Copyright (C) 2010-2012, Dmitry Ignatiev 2 | 3 | Permission is hereby granted, free of charge, to any person 4 | obtaining a copy of this software and associated documentation 5 | files (the "Software"), to deal in the Software without 6 | restriction, including without limitation the rights to use, copy, 7 | modify, merge, publish, distribute, sublicense, and/or sell copies 8 | of the Software, and to permit persons to whom the Software is 9 | furnished to do so, subject to the following conditions: 10 | 11 | The above copyright notice and this permission notice shall be 12 | included in all copies or substantial portions of the Software. 13 | 14 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 15 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 16 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 17 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 18 | HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 19 | WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 21 | DEALINGS IN THE SOFTWARE. 22 | -------------------------------------------------------------------------------- /test/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | 3 | ;;; Copyright (C) 2010-2012, Dmitry Ignatiev 4 | 5 | ;;; Permission is hereby granted, free of charge, to any person 6 | ;;; obtaining a copy of this software and associated documentation 7 | ;;; files (the "Software"), to deal in the Software without 8 | ;;; restriction, including without limitation the rights to use, copy, 9 | ;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;; of the Software, and to permit persons to whom the Software is 11 | ;;; furnished to do so, subject to the following conditions: 12 | 13 | ;;; The above copyright notice and this permission notice shall be 14 | ;;; included in all copies or substantial portions of the Software. 15 | 16 | ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;; DEALINGS IN THE SOFTWARE. 24 | 25 | (in-package #:cl-user) 26 | 27 | (defpackage #:virgil-test 28 | (:use #:cl #:virgil) 29 | (:export #:run-tests)) 30 | -------------------------------------------------------------------------------- /virgil-test.asd: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | 3 | ;;; Copyright (C) 2010-2012, Dmitry Ignatiev 4 | 5 | ;;; Permission is hereby granted, free of charge, to any person 6 | ;;; obtaining a copy of this software and associated documentation 7 | ;;; files (the "Software"), to deal in the Software without 8 | ;;; restriction, including without limitation the rights to use, copy, 9 | ;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;; of the Software, and to permit persons to whom the Software is 11 | ;;; furnished to do so, subject to the following conditions: 12 | 13 | ;;; The above copyright notice and this permission notice shall be 14 | ;;; included in all copies or substantial portions of the Software. 15 | 16 | ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;; DEALINGS IN THE SOFTWARE. 24 | 25 | (defsystem #:virgil-test 26 | :description "Virgil tests" 27 | :depends-on (#:virgil) 28 | :components ((:module "test" 29 | :serial t 30 | :components ((:file "package") 31 | (:file "tests") 32 | )))) 33 | 34 | (defmethod operation-done-p ((op test-op) 35 | (c (eql (find-system :virgil-test)))) 36 | nil) 37 | 38 | (defmethod perform ((op test-op) 39 | (c (eql (find-system :virgil-test)))) 40 | (funcall (intern (string '#:run-tests) '#:virgil-test))) 41 | 42 | ;; vim: ft=lisp et 43 | -------------------------------------------------------------------------------- /src/features.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | 3 | ;;; Copyright (C) 2010-2012, Dmitry Ignatiev 4 | 5 | ;;; Permission is hereby granted, free of charge, to any person 6 | ;;; obtaining a copy of this software and associated documentation 7 | ;;; files (the "Software"), to deal in the Software without 8 | ;;; restriction, including without limitation the rights to use, copy, 9 | ;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;; of the Software, and to permit persons to whom the Software is 11 | ;;; furnished to do so, subject to the following conditions: 12 | 13 | ;;; The above copyright notice and this permission notice shall be 14 | ;;; included in all copies or substantial portions of the Software. 15 | 16 | ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;; DEALINGS IN THE SOFTWARE. 24 | 25 | (in-package #:virgil) 26 | 27 | #-(or x86 x86-64) 28 | (error "Unsupported platform") 29 | 30 | (pushnew :virgil *features*) 31 | 32 | ;; see http://tkpapp.blogspot.com/2010/05/upgraded-array-element-types-and-pinned.html 33 | ;; Virgil uses babel's with-simple-vector and cffi's with-pointer-to-vector-data 34 | #+(or sbcl cmu ecl openmcl lispworks allegro cormanlisp) 35 | (pushnew :virgil.shareable-arrays *features*) 36 | 37 | #+(or sbcl cmu ecl openmcl lispworks allegro cormanlisp) 38 | (pushnew :virgil.shareable-arrays.float *features*) 39 | 40 | #+(or sbcl cmu ecl openmcl lispworks allegro cormanlisp) 41 | (pushnew :virgil.shareable-arrays.double *features*) 42 | 43 | #+(or sbcl cmu ecl openmcl lispworks allegro cormanlisp) 44 | (pushnew :virgil.shareable-arrays.int8 *features*) 45 | 46 | #+(or sbcl cmu ecl openmcl lispworks allegro cormanlisp) 47 | (pushnew :virgil.shareable-arrays.int16 *features*) 48 | 49 | #+(or sbcl cmu openmcl lispworks allegro) 50 | (pushnew :virgil.shareable-arrays.int32 *features*) 51 | 52 | #+(and x86-64 (or sbcl cmu ecl openmcl lispworks allegro)) 53 | (pushnew :virgil.shareable-arrays.int64 *features*) 54 | -------------------------------------------------------------------------------- /virgil.asd: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | 3 | ;;; Copyright (C) 2010-2012, Dmitry Ignatiev 4 | 5 | ;;; Permission is hereby granted, free of charge, to any person 6 | ;;; obtaining a copy of this software and associated documentation 7 | ;;; files (the "Software"), to deal in the Software without 8 | ;;; restriction, including without limitation the rights to use, copy, 9 | ;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;; of the Software, and to permit persons to whom the Software is 11 | ;;; furnished to do so, subject to the following conditions: 12 | 13 | ;;; The above copyright notice and this permission notice shall be 14 | ;;; included in all copies or substantial portions of the Software. 15 | 16 | ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;; DEALINGS IN THE SOFTWARE. 24 | 25 | (asdf:defsystem #:virgil 26 | :version "0.8.2" 27 | :description "Virgil, a lisper's guide to the lower levels" 28 | :author "Dmitry Ignatiev " 29 | :maintainer "Dmitry Ignatiev " 30 | :licence "MIT" 31 | :depends-on (#:trivial-features #:cffi #:alexandria #:babel) 32 | :components 33 | ((:module "src" 34 | :serial t 35 | :components 36 | ((:file "package") 37 | (:file "features") 38 | (:file "base") 39 | (:file "proxy") 40 | (:file "typedefs") 41 | (:file "primitives") 42 | (:file "pointers") 43 | (:file "references") 44 | (:file "arrays") 45 | (:file "strings") 46 | (:file "enums") 47 | (:file "structures") 48 | (:file "functions") 49 | (:file "aligned") 50 | (:file "filtered") 51 | (:file "const"))))) 52 | 53 | (defmethod asdf:operation-done-p ((op asdf:test-op) 54 | (c (eql (asdf:find-system :virgil)))) 55 | nil) 56 | 57 | (defmethod asdf:perform ((op asdf:test-op) 58 | (c (eql (asdf:find-system :virgil)))) 59 | (asdf:load-system :virgil-test) 60 | (asdf:test-system :virgil-test)) 61 | 62 | ;; vim: ft=lisp et 63 | -------------------------------------------------------------------------------- /doc/style.css: -------------------------------------------------------------------------------- 1 | body {font-family: century schoolbook, serif; 2 | line-height: 1.3; 3 | padding-left: 5em; padding-right: 1em; 4 | padding-bottom: 1em; max-width: 60em;} 5 | table {border-collapse: collapse} 6 | span.roman { font-family: century schoolbook, serif; font-weight: normal; } 7 | h1, h2, h3, h4, h5, h6 {font-family: Helvetica, sans-serif} 8 | h4 { margin-top: 2.5em; } 9 | dfn {font-family: inherit; font-variant: italic; font-weight: bolder } 10 | kbd {font-family: monospace; text-decoration: underline} 11 | /*var {font-family: Helvetica, sans-serif; font-variant: slanted}*/ 12 | var {font-variant: slanted;} 13 | td {padding-right: 1em; padding-left: 1em} 14 | sub {font-size: smaller} 15 | .node {padding: 0; margin: 0} 16 | 17 | .lisp { font-family: monospace; 18 | background-color: #F4F4F4; border: 1px solid #AAA; 19 | padding-top: 0.5em; padding-bottom: 0.5em; } 20 | 21 | /* coloring */ 22 | 23 | .lisp-bg { background-color: #F4F4F4 ; color: black; } 24 | .lisp-bg:hover { background-color: #F4F4F4 ; color: black; } 25 | 26 | .symbol { font-weight: bold; color: #770055; background-color : transparent; border: 0px; margin: 0px;} 27 | a.symbol:link { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } 28 | a.symbol:active { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } 29 | a.symbol:visited { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } 30 | a.symbol:hover { font-weight: bold; color : #229955; background-color : transparent; text-decoration: none; border: 0px; margin: 0px; } 31 | .special { font-weight: bold; color: #FF5000; background-color: inherit; } 32 | .keyword { font-weight: bold; color: #770000; background-color: inherit; } 33 | .comment { font-weight: normal; color: #007777; background-color: inherit; } 34 | .string { font-weight: bold; color: #777777; background-color: inherit; } 35 | .character { font-weight: bold; color: #0055AA; background-color: inherit; } 36 | .syntaxerror { font-weight: bold; color: #FF0000; background-color: inherit; } 37 | span.paren1 { font-weight: bold; color: #777777; } 38 | span.paren1:hover { color: #777777; background-color: #BAFFFF; } 39 | span.paren2 { color: #777777; } 40 | span.paren2:hover { color: #777777; background-color: #FFCACA; } 41 | span.paren3 { color: #777777; } 42 | span.paren3:hover { color: #777777; background-color: #FFFFBA; } 43 | span.paren4 { color: #777777; } 44 | span.paren4:hover { color: #777777; background-color: #CACAFF; } 45 | span.paren5 { color: #777777; } 46 | span.paren5:hover { color: #777777; background-color: #CAFFCA; } 47 | span.paren6 { color: #777777; } 48 | span.paren6:hover { color: #777777; background-color: #FFBAFF; } 49 | -------------------------------------------------------------------------------- /src/proxy.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | 3 | ;;; Copyright (C) 2010-2012, Dmitry Ignatiev 4 | 5 | ;;; Permission is hereby granted, free of charge, to any person 6 | ;;; obtaining a copy of this software and associated documentation 7 | ;;; files (the "Software"), to deal in the Software without 8 | ;;; restriction, including without limitation the rights to use, copy, 9 | ;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;; of the Software, and to permit persons to whom the Software is 11 | ;;; furnished to do so, subject to the following conditions: 12 | 13 | ;;; The above copyright notice and this permission notice shall be 14 | ;;; included in all copies or substantial portions of the Software. 15 | 16 | ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;; DEALINGS IN THE SOFTWARE 24 | 25 | (in-package #:virgil) 26 | 27 | (defclass proxy-type (translatable-type) 28 | ((proxied-type 29 | :initform (error "Supply proxied type to proxy type") 30 | :initarg :type 31 | :accessor proxied-type))) 32 | 33 | (defun proxy-type-p (type) 34 | (typep type 'proxy-type)) 35 | 36 | (defmethod base-type ((type proxy-type)) 37 | (base-type (proxied-type type))) 38 | 39 | (defmethod compute-alignment ((type proxy-type)) 40 | (compute-alignment (proxied-type type))) 41 | 42 | (defmethod lisp-type ((type proxy-type)) 43 | (lisp-type (proxied-type type))) 44 | 45 | (defmethod prototype ((type proxy-type)) 46 | (prototype (proxied-type type))) 47 | 48 | (defmethod expand-prototype ((type proxy-type)) 49 | (expand-prototype (proxied-type type))) 50 | 51 | (defmethod compute-size (value (type proxy-type)) 52 | (compute-size value (proxied-type type))) 53 | 54 | (defmethod expand-compute-size (value (type proxy-type)) 55 | (expand-compute-size value (proxied-type type))) 56 | 57 | (defmethod compute-fixed-size ((type proxy-type)) 58 | (compute-fixed-size (proxied-type type))) 59 | 60 | (defmethod compute-slot-offset (slot-name (type proxy-type)) 61 | (compute-slot-offset slot-name (proxied-type type))) 62 | 63 | (defmethod expand-compute-slot-offset (slot-name (type proxy-type)) 64 | (expand-compute-slot-offset slot-name (proxied-type type))) 65 | 66 | (defmethod convert-value (value (type proxy-type)) 67 | (convert-value value (proxied-type type))) 68 | 69 | (defmethod translate-value (value (type proxy-type)) 70 | (translate-value value (proxied-type type))) 71 | 72 | (defmethod read-value (value output (type proxy-type)) 73 | (read-value value output (proxied-type type))) 74 | 75 | (defmethod write-value (value pointer (type proxy-type)) 76 | (write-value value pointer (proxied-type type))) 77 | 78 | (defmethod allocate-value (value (type proxy-type)) 79 | (allocate-value value (proxied-type type))) 80 | 81 | (defmethod clean-value (pointer value (type proxy-type)) 82 | (clean-value pointer value (proxied-type type))) 83 | 84 | (defmethod free-value (pointer (type proxy-type)) 85 | (free-value pointer (proxied-type type))) 86 | 87 | (defmethod expand-convert-value (value (type proxy-type)) 88 | (expand-convert-value value (proxied-type type))) 89 | 90 | (defmethod expand-translate-value (value (type proxy-type)) 91 | (expand-translate-value value (proxied-type type))) 92 | 93 | (defmethod expand-read-value (value output (type proxy-type)) 94 | (expand-read-value value output (proxied-type type))) 95 | 96 | (defmethod expand-write-value (value pointer (type proxy-type)) 97 | (expand-write-value value pointer (proxied-type type))) 98 | 99 | (defmethod expand-allocate-value (value (type proxy-type)) 100 | (expand-allocate-value value (proxied-type type))) 101 | 102 | (defmethod expand-clean-value (pointer value (type proxy-type)) 103 | (expand-clean-value pointer value (proxied-type type))) 104 | 105 | (defmethod expand-free-value (pointer (type proxy-type)) 106 | (expand-free-value pointer (proxied-type type))) 107 | 108 | (defmethod expand-dynamic-extent (var value-var body (type proxy-type)) 109 | (expand-dynamic-extent var value-var body (proxied-type type))) 110 | 111 | (defmethod expand-callback-dynamic-extent (var value body (type proxy-type)) 112 | (expand-callback-dynamic-extent var value body (proxied-type type))) 113 | 114 | (defmethod expand-reference-dynamic-extent 115 | (var size-var value-var body mode (type proxy-type)) 116 | (expand-reference-dynamic-extent 117 | var size-var value-var body mode (proxied-type type))) 118 | -------------------------------------------------------------------------------- /src/const.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | 3 | ;;; Copyright (C) 2010-2012, Dmitry Ignatiev 4 | 5 | ;;; Permission is hereby granted, free of charge, to any person 6 | ;;; obtaining a copy of this software and associated documentation 7 | ;;; files (the "Software"), to deal in the Software without 8 | ;;; restriction, including without limitation the rights to use, copy, 9 | ;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;; of the Software, and to permit persons to whom the Software is 11 | ;;; furnished to do so, subject to the following conditions: 12 | 13 | ;;; The above copyright notice and this permission notice shall be 14 | ;;; included in all copies or substantial portions of the Software. 15 | 16 | ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;; DEALINGS IN THE SOFTWARE. 24 | 25 | (in-package #:virgil) 26 | 27 | (defvar *eq-constants* (make-hash-table :test #'eq)) 28 | (defvar *eql-constants* (make-hash-table :test #'eql)) 29 | (defvar *equal-constants* (make-hash-table :test #'equal)) 30 | (defvar *equalp-constants* (make-hash-table :test #'equalp)) 31 | 32 | (define-proxy-type const-type () 33 | ((mode :initarg :mode 34 | :initform 'equal 35 | :reader const-type-mode)) 36 | (:allocator (value type) 37 | (let* ((ctype (proxied-type type)) 38 | (mode (const-type-mode type)) 39 | (pointer (ecase mode 40 | (eq (gethash value *eq-constants*)) 41 | (eql (gethash value *eql-constants*)) 42 | (equal (gethash value *equal-constants*)) 43 | (equalp (gethash value *equalp-constants*))))) 44 | (unless pointer 45 | (setf pointer (allocate-value value ctype)) 46 | (write-value value pointer ctype) 47 | (setf (gethash value (ecase mode 48 | (eq *eq-constants*) 49 | (eql *eql-constants*) 50 | (equal *equal-constants*) 51 | (equalp *equalp-constants*))) 52 | pointer)) 53 | pointer)) 54 | (:allocator-expansion (value type) 55 | (let* ((ctype (proxied-type type)) 56 | (mode (const-type-mode type)) 57 | (hash (ecase mode 58 | (eq '*eq-constants*) 59 | (eql '*eql-constants*) 60 | (equal '*equal-constants*) 61 | (equalp '*equalp-constants*)))) 62 | (once-only (value) 63 | (with-gensyms (pointer) 64 | `(or (gethash ,value ,hash) 65 | (setf (gethash ,value ,hash) 66 | (let ((,pointer ,(expand-allocate-value 67 | value 68 | ctype))) 69 | (declare (type pointer ,pointer)) 70 | ,(expand-write-value value pointer ctype) 71 | ,pointer))))))) 72 | (:deallocator (pointer type) nil) 73 | (:deallocator-expansion (pointer type) nil) 74 | (:cleaner (value pointer type) nil) 75 | (:cleaner-expansion (value pointer type) nil) 76 | (:reference-dynamic-extent-expansion 77 | (var size-var value-var body mode type) 78 | `(let ((,var ,(expand-allocate-value value-var type)) 79 | (,size-var ,(expand-compute-size value-var type))) 80 | (declare (type pointer ,var) 81 | (type size-t ,size-var) 82 | (ignorable ,size-var)) 83 | ,(ecase mode 84 | (:in `(locally ,@body)) 85 | ((:inout :out) (error "Trying to modify value of const type, do you?")))))) 86 | 87 | (define-immediate-type const-immediate-type (const-type) 88 | ()) 89 | 90 | (define-type-parser const (type &optional (comparator 'equal)) 91 | (check-type comparator (member eq eql equal equalp)) 92 | (let ((type (parse-typespec type))) 93 | (make-instance (if (immediate-type-p type) 94 | 'const-immediate-type 95 | 'const-type) 96 | :mode comparator 97 | :type type))) 98 | 99 | (defmethod unparse-type ((type const-type)) 100 | `(const ,(unparse-type (proxied-type type)) 101 | ,(const-type-mode type))) 102 | 103 | (defun clear-const-cache () 104 | (loop :for hash :in (list *eq-constants* 105 | *eql-constants* 106 | *equal-constants* 107 | *equalp-constants*) 108 | :do (maphash (lambda (k v) (declare (ignore k)) (raw-free v)) hash) 109 | (clrhash hash))) 110 | -------------------------------------------------------------------------------- /src/package.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | 3 | ;;; Copyright (C) 2010-2012, Dmitry Ignatiev 4 | 5 | ;;; Permission is hereby granted, free of charge, to any person 6 | ;;; obtaining a copy of this software and associated documentation 7 | ;;; files (the "Software"), to deal in the Software without 8 | ;;; restriction, including without limitation the rights to use, copy, 9 | ;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;; of the Software, and to permit persons to whom the Software is 11 | ;;; furnished to do so, subject to the following conditions: 12 | 13 | ;;; The above copyright notice and this permission notice shall be 14 | ;;; included in all copies or substantial portions of the Software. 15 | 16 | ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;; DEALINGS IN THE SOFTWARE. 24 | 25 | (in-package :cl-user) 26 | 27 | (defpackage #:virgil 28 | (:use #:cl #:cffi #:alexandria #:babel #:babel-encodings) 29 | (:export 30 | ;;typespec stuff 31 | #:parse-typespec 32 | #:unparse-type 33 | 34 | ;;core generics: 35 | #:base-type 36 | #:lisp-type 37 | #:prototype 38 | #:expand-prototype 39 | #:compute-size 40 | #:expand-compute-size 41 | #:compute-fixed-size 42 | #:compute-alignment 43 | #:compute-slot-offset 44 | #:expand-compute-slot-offset 45 | #:translate-value 46 | #:convert-value 47 | #:read-value 48 | #:write-value 49 | #:clean-value 50 | #:allocate-value 51 | #:free-value 52 | #:expand-translate-value 53 | #:expand-convert-value 54 | #:expand-read-value 55 | #:expand-write-value 56 | #:expand-clean-value 57 | #:expand-allocate-value 58 | #:expand-free-value 59 | #:expand-dynamic-extent 60 | #:expand-reference-dynamic-extent 61 | #:expand-callback-dynamic-extent 62 | 63 | ;;user-level analogues 64 | #:sizeof 65 | #:alignof 66 | #:offsetof 67 | #:convert 68 | #:translate 69 | #:alloc 70 | #:free 71 | #:clean 72 | #:clean-and-free 73 | 74 | ;;proxy type stuff 75 | #:proxied-type 76 | 77 | ;;define new types with this 78 | #:define-type-parser 79 | #:defalias 80 | #:define-primitive-type 81 | #:define-immediate-type 82 | #:define-translatable-type 83 | #:define-proxy-type 84 | 85 | ;;type predicates 86 | #:translatable-type-p 87 | #:primitive-type-p 88 | #:immediate-type-p 89 | #:proxy-type-p 90 | 91 | ;;primitive types 92 | #:char-t 93 | #:uchar-t 94 | #:wchar-t 95 | #:sbyte 96 | #:ubyte 97 | #:byte 98 | #:short 99 | #:ushort 100 | #:int 101 | #:uint 102 | #:long 103 | #:ulong 104 | #:llong 105 | #:ullong 106 | #:int-ptr 107 | #:uint-ptr 108 | #:int8 109 | #:uint8 110 | #:int16 111 | #:uint16 112 | #:int32 113 | #:uint32 114 | #:int64 115 | #:uint64 116 | #:size-t 117 | #:ssize-t 118 | #:ptrdiff-t 119 | #:single 120 | #:float 121 | #:single-float 122 | #:double 123 | #:double-float 124 | #:bool 125 | #:boolean 126 | #:char 127 | #:wchar 128 | 129 | ;;void stuff 130 | #:void 131 | #:voidp 132 | 133 | ;;pointer and reference stuff 134 | #:raw-alloc 135 | #:raw-free 136 | #:with-raw-pointer 137 | #:with-raw-pointers 138 | #:pointer 139 | #:* 140 | #:& 141 | #:&& 142 | #:&p 143 | #:&= 144 | #:&+ 145 | #:&- 146 | #:&? 147 | #:&0 148 | #:deref 149 | #:with-reference 150 | #:with-references 151 | #:with-pointer 152 | #:with-pointers 153 | #:with-value 154 | #:with-values 155 | #:enable-circular-references 156 | #:disable-circular-references 157 | #:clear-circular-reference-cache 158 | #:with-circular-references 159 | #:without-circular-references 160 | 161 | ;;sequence and array stuff 162 | #:sequence 163 | #:~ 164 | #:array 165 | #:simple-array 166 | 167 | ;;string stuff 168 | #:string 169 | #:cstring-size 170 | #:read-cstring 171 | #:write-cstring 172 | #:allocate-cstring 173 | 174 | ;;enum stuff 175 | #:enum 176 | #:define-enum 177 | 178 | ;;struct stuff 179 | #:struct 180 | #:offsetof 181 | #:define-struct 182 | #:union 183 | #:define-union 184 | 185 | ;;functions and so on 186 | #:external-pointer-call 187 | #:external-function-call 188 | #:translate-name 189 | #:define-external-function 190 | #:define-callback 191 | 192 | ;;aligned type 193 | #:aligned 194 | 195 | ;;filtered type 196 | #:filtered 197 | 198 | ;;const type 199 | #:const 200 | #:clear-const-cache 201 | 202 | ;;also export CFFI's stuff 203 | #:callback 204 | #:get-callback 205 | #:define-foreign-library 206 | #:load-foreign-library 207 | #:close-foreign-library 208 | #:use-foreign-library 209 | #:list-foreign-libraries 210 | #:reload-foreign-libraries 211 | #:load-foreign-library-error 212 | #:*foreign-library-directories* 213 | #:*darwin-framework-directories* 214 | )) 215 | -------------------------------------------------------------------------------- /doc/manual/html_node/Const-Types.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Const Types - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 35 | 36 | 95 | 96 | 97 |
98 | 99 |

100 | Previous: Filtered Types, 101 | Up: Built-in Types 102 |

103 |
104 | 105 |

6.9 Const Types

106 | 107 |

TODO 108 | 109 | 110 | 111 | -------------------------------------------------------------------------------- /doc/manual/html_node/Proxy-Types.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Proxy Types - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 35 | 36 | 95 | 96 | 97 |

98 | 99 |

100 | Previous: Aggregate Types, 101 | Up: Translators and Translatable Types 102 |

103 |
104 | 105 |

5.6 Proxy Types

106 | 107 |

TODO 108 | 109 | 110 | 111 | -------------------------------------------------------------------------------- /doc/manual/html_node/Symbols-Re_002dExported-from-CFFI.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Symbols Re-Exported from CFFI - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 35 | 36 | 95 | 96 | 97 |

98 | 99 | 100 |

101 | Next: , 102 | Previous: Functions, 103 | Up: Top 104 |

105 |
106 | 107 |

8 Symbols Re-Exported from CFFI

108 | 109 |

TODO 110 | 111 | 112 | 113 | -------------------------------------------------------------------------------- /doc/manual/html_node/Tutorial.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Tutorial - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 35 | 36 | 95 | 96 | 97 |

98 | 99 |

100 | Next: , 101 | Previous: Installation and Prerequisites, 102 | Up: Top 103 |

104 |
105 | 106 |

3 Tutorial

107 | 108 |

TODO 109 | 110 | 111 | 112 | -------------------------------------------------------------------------------- /doc/manual/html_node/Functions.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Functions - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 35 | 36 | 95 | 96 | 97 |

98 | 99 |

100 | Next: , 101 | Previous: Built-in Types, 102 | Up: Top 103 |

104 |
105 | 106 |

7 Functions

107 | 108 |

TODO 109 | 110 | 111 | 112 | -------------------------------------------------------------------------------- /doc/manual/html_node/Structures-and-Unions.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Structures and Unions - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 36 | 37 | 96 | 97 | 98 |

99 | 100 |

101 | Next: , 102 | Previous: Enumerations, 103 | Up: Built-in Types 104 |

105 |
106 | 107 |

6.5 Structures and Unions

108 | 109 |

TODO 110 | 111 | 112 | 113 | -------------------------------------------------------------------------------- /doc/manual/html_node/Arrays-and-Sequences.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Arrays and Sequences - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 36 | 37 | 96 | 97 | 98 |

99 | 100 |

101 | Next: , 102 | Previous: References, 103 | Up: Built-in Types 104 |

105 |
106 | 107 |

6.3 Arrays and Sequences

108 | 109 |

TODO 110 | 111 | 112 | 113 | -------------------------------------------------------------------------------- /doc/manual/html_node/Glossary.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Glossary - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 35 | 36 | 95 | 96 | 97 |

98 | 99 |

100 | Next: , 101 | Previous: Symbols Re-Exported from CFFI, 102 | Up: Top 103 |

104 |
105 | 106 |

Appendix A Glossary

107 | 108 |

TODO 109 | 110 | 111 | 112 | -------------------------------------------------------------------------------- /doc/manual/html_node/Strictly-Aligned-Types.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Strictly Aligned Types - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 36 | 37 | 96 | 97 | 98 |

99 | 100 |

101 | Next: , 102 | Previous: Strings, 103 | Up: Built-in Types 104 |

105 |
106 | 107 |

6.7 Strictly Aligned Types

108 | 109 |

TODO 110 | 111 | 112 | 113 | -------------------------------------------------------------------------------- /doc/manual/html_node/Filtered-Types.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Filtered Types - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 36 | 37 | 96 | 97 | 98 |

99 | 100 |

101 | Next: , 102 | Previous: Strictly Aligned Types, 103 | Up: Built-in Types 104 |

105 |
106 | 107 |

6.8 Filtered Types

108 | 109 |

TODO 110 | 111 | 112 | 113 | -------------------------------------------------------------------------------- /doc/manual/html_node/Built_002din-Primitives.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Built-in Primitives - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 36 | 37 | 96 | 97 | 98 |

99 | 100 | 101 |

102 | Next: , 103 | Previous: Built-in Types, 104 | Up: Built-in Types 105 |

106 |
107 | 108 |

6.1 Built-in Primitives

109 | 110 |

TODO 111 | 112 | 113 | 114 | -------------------------------------------------------------------------------- /doc/manual/html_node/Strings.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Strings - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 36 | 37 | 96 | 97 | 98 |

99 | 100 |

101 | Next: , 102 | Previous: Structures and Unions, 103 | Up: Built-in Types 104 |

105 |
106 | 107 |

6.6 Strings

108 | 109 |

TODO 110 | 111 | 112 | 113 | -------------------------------------------------------------------------------- /doc/manual/html_node/References.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | References - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 36 | 37 | 96 | 97 | 98 |

99 | 100 |

101 | Next: , 102 | Previous: Built-in Primitives, 103 | Up: Built-in Types 104 |

105 |
106 | 107 |

6.2 References

108 | 109 |

TODO 110 | 111 | 112 | 113 | -------------------------------------------------------------------------------- /doc/manual/html_node/Enumerations.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Enumerations - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 36 | 37 | 96 | 97 | 98 |

99 | 100 |

101 | Next: , 102 | Previous: Arrays and Sequences, 103 | Up: Built-in Types 104 |

105 |
106 | 107 |

6.4 Enumerations

108 | 109 |

TODO 110 | 111 | 112 | 113 | -------------------------------------------------------------------------------- /doc/manual/html_node/Aggregate-Types.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Aggregate Types - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 36 | 37 | 96 | 97 | 98 |

99 | 100 |

101 | Next: , 102 | Previous: Immediate Types, 103 | Up: Translators and Translatable Types 104 |

105 |
106 | 107 |

5.5 Aggregate Types

108 | 109 |

TODO 110 | 111 | 112 | 113 | -------------------------------------------------------------------------------- /doc/manual/html_node/Immediate-Types.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Immediate Types - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 36 | 37 | 96 | 97 | 98 |

99 | 100 |

101 | Next: , 102 | Previous: Primitive Types, 103 | Up: Translators and Translatable Types 104 |

105 |
106 | 107 |

5.4 Immediate Types

108 | 109 |

TODO 110 | 111 | 112 | 113 | -------------------------------------------------------------------------------- /doc/manual/html_node/Defining-and-Parsing-Type-Specifiers.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Defining and Parsing Type Specifiers - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 36 | 37 | 96 | 97 | 98 |

99 | 100 |

101 | Next: , 102 | Previous: Translators, 103 | Up: Translators and Translatable Types 104 |

105 |
106 | 107 |

5.2 Defining and Parsing Type Specifiers

108 | 109 |

TODO 110 | 111 | 112 | 113 | -------------------------------------------------------------------------------- /doc/manual/html_node/Primitive-Types.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Primitive Types - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 36 | 37 | 96 | 97 | 98 |

99 | 100 |

101 | Next: , 102 | Previous: Defining and Parsing Type Specifiers, 103 | Up: Translators and Translatable Types 104 |

105 |
106 | 107 |

5.3 Primitive Types

108 | 109 |

TODO 110 | 111 | 112 | 113 | -------------------------------------------------------------------------------- /doc/manual/html_node/Translators.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Translators - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 36 | 37 | 96 | 97 | 98 |

99 | 100 |

101 | Next: , 102 | Previous: Translators and Translatable Types, 103 | Up: Translators and Translatable Types 104 |

105 |
106 | 107 |

5.1 Translators

108 | 109 |

TODO 110 | 111 | 112 | 113 | -------------------------------------------------------------------------------- /src/aligned.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | 3 | ;;; Copyright (C) 2010-2012, Dmitry Ignatiev 4 | 5 | ;;; Permission is hereby granted, free of charge, to any person 6 | ;;; obtaining a copy of this software and associated documentation 7 | ;;; files (the "Software"), to deal in the Software without 8 | ;;; restriction, including without limitation the rights to use, copy, 9 | ;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;; of the Software, and to permit persons to whom the Software is 11 | ;;; furnished to do so, subject to the following conditions: 12 | 13 | ;;; The above copyright notice and this permission notice shall be 14 | ;;; included in all copies or substantial portions of the Software. 15 | 16 | ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;; DEALINGS IN THE SOFTWARE 24 | 25 | (in-package #:virgil) 26 | 27 | (defun align-exp2-p (align) 28 | (zerop (logand align (1- align)))) 29 | 30 | (define-proxy-type aligned-type () 31 | ((align :initform 1 32 | :initarg :align 33 | :accessor aligned-type-align)) 34 | (:align (type) 35 | (aligned-type-align type)) 36 | (:allocator (value type) 37 | (let* ((size (compute-size value (proxied-type type))) 38 | (align (aligned-type-align type)) 39 | (padding (+ (sizeof '*) (1- align))) 40 | (pointer (raw-alloc (+ padding size))) 41 | (aligned-pointer (if (align-exp2-p align) 42 | (logand (&& (&+ pointer (+ (sizeof '*) (1- align)))) 43 | (lognot (1- align))) 44 | (& (align-offset 45 | (&& (&+ pointer (sizeof '*))) 46 | align))))) 47 | (setf (deref aligned-pointer '* (- (sizeof '*))) 48 | pointer) 49 | aligned-pointer)) 50 | (:allocator-expansion (value-form type) 51 | (with-gensyms (value size pointer aligned-pointer) 52 | (let* ((atype (proxied-type type)) 53 | (align (aligned-type-align type)) 54 | (padding (+ (sizeof '*) (1- align)))) 55 | `(let* ((,value (the ,(lisp-type atype) ,value-form)) 56 | (,size (the size-t ,(expand-compute-size value atype))) 57 | (,pointer (raw-alloc (+ ,padding ,size))) 58 | (,aligned-pointer ,(if (align-exp2-p align) 59 | `(& (logand 60 | (the size-t (&& (&+ ,pointer ,(+ (sizeof '*) 61 | (1- align))))) 62 | ,(lognot (1- align)))) 63 | `(& (align-offset 64 | (&& (&+ ,pointer ,(sizeof '*))) 65 | ,align))))) 66 | (declare (ignorable ,value) 67 | (type pointer ,pointer ,aligned-pointer)) 68 | (setf (deref ,aligned-pointer '* (- ,(sizeof '*))) 69 | ,pointer) 70 | ,aligned-pointer)))) 71 | (:deallocator (pointer type) 72 | (raw-free (deref pointer '* (- (sizeof '*))))) 73 | (:deallocator-expansion (pointer-form type) 74 | `(raw-free (deref ,pointer-form '* (- ,(sizeof '*))))) 75 | (:reference-dynamic-extent-expansion (var size-var value-var body mode type) 76 | (let* ((atype (proxied-type type)) 77 | (align (aligned-type-align type))) 78 | (with-gensyms (pointer-var) 79 | `(with-raw-pointer (,pointer-var 80 | ,(eval-if-constantp 81 | `(+ ,(1- align) 82 | ,(expand-compute-size 83 | value-var 84 | atype))) 85 | ,size-var) 86 | (let* ((,pointer-var ,(if (align-exp2-p align) 87 | `(& (logand 88 | (the size-t (&& (&+ ,pointer-var ,(1- align)))) 89 | ,(lognot (1- align)))) 90 | `(& (align-offset 91 | (&& ,pointer-var) 92 | ,align)))) 93 | (,var ,pointer-var)) 94 | (declare (type pointer ,pointer-var ,var) 95 | (type ,(lisp-type atype) ,value-var)) 96 | (%unwind-protect 97 | ,(ecase mode 98 | (:in `(progn ,(expand-write-value value-var pointer-var atype) 99 | nil 100 | ,@body)) 101 | (:out `(prog1 (progn ,@body) 102 | (setf ,value-var 103 | ,(expand-read-value pointer-var value-var atype)))) 104 | (:inout `(prog1 (progn 105 | ,(expand-write-value value-var pointer-var atype) 106 | nil 107 | ,@body) 108 | (setf ,value-var 109 | ,(expand-read-value pointer-var value-var atype))))) 110 | ,(expand-clean-value pointer-var value-var atype)))))))) 111 | 112 | (define-immediate-type aligned-immediate-type (aligned-type) 113 | ()) 114 | 115 | (define-type-parser aligned (align aligned-type) 116 | (check-type align non-negative-fixnum) 117 | (let ((type (parse-typespec aligned-type))) 118 | (make-instance (if (immediate-type-p type) 119 | 'aligned-immediate-type 120 | 'aligned-type) 121 | :type type 122 | :align align))) 123 | 124 | (defmethod unparse-type ((type aligned-type)) 125 | `(aligned ,(aligned-type-align type) 126 | ,(unparse-type (proxied-type type)))) 127 | -------------------------------------------------------------------------------- /doc/manual/html_node/Translators-and-Translatable-Types.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Translators and Translatable Types - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 35 | 36 | 95 | 96 | 97 |

98 | 99 |

100 | Next: , 101 | Previous: User-level API, 102 | Up: Top 103 |

104 |
105 | 106 |

5 Translators and Translatable Types

107 | 108 |

TODO 109 | 110 |

118 | 119 | 120 | 121 | -------------------------------------------------------------------------------- /doc/manual/html_node/Built_002din-Types.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Built-in Types - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 35 | 36 | 95 | 96 | 97 |
98 | 99 | 100 |

101 | Next: , 102 | Previous: Translators and Translatable Types, 103 | Up: Top 104 |

105 |
106 | 107 |

6 Built-in Types

108 | 109 |

TODO 110 | 111 |

122 | 123 | 124 | 125 | -------------------------------------------------------------------------------- /doc/manual/index.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 13 | 14 | 15 | 16 | Virgil User Manual 17 | 18 | 19 | 20 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | 171 | 172 | 173 |

Virgil User Manual

174 | 175 | 176 |
last updated May 17, 2012
177 | 178 | 188 | 189 |
190 | 191 |

This document is available in the following formats:

192 | 193 | 219 | 220 |

(This page was generated by the gendocs.sh 221 | script.)

222 | 223 |
224 |

225 | Return to Virgil's home page. 226 |

227 | 228 | 239 | 240 |

241 | Copyright (C) 2010-2011, Dmitry Ignatiev <lovesan.ru at gmail.com> 242 | 247 |

248 | 249 |

250 | Updated: May 17, 2012 251 | 252 | 253 | 254 |

255 |
256 | 257 | 258 | 259 | -------------------------------------------------------------------------------- /doc/gendocs_template: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 13 | 14 | 15 | 16 | %%TITLE%% 17 | 18 | 19 | 20 | 163 | 164 | 165 | 166 | 167 | 168 | 169 | 170 | 171 | 172 | 173 |

%%TITLE%%

174 | 175 | 176 |
last updated %%DATE%%
177 | 178 | 188 | 189 |
190 | 191 |

This document is available in the following formats:

192 | 193 | 219 | 220 |

(This page was generated by the %%SCRIPTNAME%% 221 | script.)

222 | 223 |
224 |

225 | Return to Virgil's home page. 226 |

227 | 228 | 239 | 240 |

241 | Copyright (C) 2010-2011, Dmitry Ignatiev <lovesan.ru at gmail.com> 242 | 247 |

248 | 249 |

250 | Updated: %%DATE%% 251 | 252 | 253 | 254 |

255 |
256 | 257 | 258 | 259 | -------------------------------------------------------------------------------- /src/filtered.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | 3 | ;;; Copyright (C) 2010-2012, Dmitry Ignatiev 4 | 5 | ;;; Permission is hereby granted, free of charge, to any person 6 | ;;; obtaining a copy of this software and associated documentation 7 | ;;; files (the "Software"), to deal in the Software without 8 | ;;; restriction, including without limitation the rights to use, copy, 9 | ;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;; of the Software, and to permit persons to whom the Software is 11 | ;;; furnished to do so, subject to the following conditions: 12 | 13 | ;;; The above copyright notice and this permission notice shall be 14 | ;;; included in all copies or substantial portions of the Software. 15 | 16 | ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;; DEALINGS IN THE SOFTWARE 24 | 25 | (in-package #:virgil) 26 | 27 | (define-proxy-type filtered-type () 28 | ((predicate :initform 'identity 29 | :reader filtered-type-predicate 30 | :initarg :predicate) 31 | (handler :initform 'identity 32 | :reader filtered-type-handler 33 | :initarg :handler)) 34 | (:writer (value pointer type) 35 | (write-value 36 | (if (funcall (fdefinition (filtered-type-predicate type)) value) 37 | value 38 | (funcall (fdefinition (filtered-type-handler type)) value)) 39 | pointer 40 | (proxied-type type))) 41 | (:writer-expansion (value-form pointer-form type) 42 | (with-gensyms (value pointer) 43 | `(let ((,value (the ,(lisp-type type) ,value-form)) 44 | (,pointer (the pointer ,pointer-form))) 45 | (if (funcall #',(filtered-type-predicate type) ,value) 46 | ,(expand-write-value 47 | value 48 | pointer 49 | (proxied-type type)) 50 | (let ((,value (funcall #',(filtered-type-handler type) ,value))) 51 | (declare (type ,(lisp-type type) ,value)) 52 | ,(expand-write-value 53 | value 54 | pointer 55 | (proxied-type type))))))) 56 | (:reader (pointer out type) 57 | (let ((value (read-value pointer out (proxied-type type)))) 58 | (if (funcall (fdefinition (filtered-type-predicate type)) value) 59 | value 60 | (funcall (fdefinition (filtered-type-handler type)) value)))) 61 | (:reader-expansion (pointer-form out-form type) 62 | (with-gensyms (value) 63 | `(let ((,value ,(expand-read-value pointer-form out-form (proxied-type type)))) 64 | (declare (type ,(lisp-type type) ,value)) 65 | (if (funcall #',(filtered-type-predicate type) ,value) 66 | ,value 67 | (funcall #',(filtered-type-handler type) ,value))))) 68 | (:reference-dynamic-extent-expansion 69 | (var size-var value-var body mode type) 70 | (with-gensyms (value) 71 | (ecase mode 72 | (:in `(let ((,value ,value-var)) 73 | (declare (type ,(lisp-type type) ,value)) 74 | (unless (funcall #',(filtered-type-predicate type) ,value) 75 | (setf ,value (funcall #',(filtered-type-handler type) 76 | ,value))) 77 | ,(expand-reference-dynamic-extent 78 | var size-var value body mode (proxied-type type)))) 79 | (:out `(let ((,value ,value-var)) 80 | (declare (type ,(lisp-type type) ,value)) 81 | (prog1 82 | ,(expand-reference-dynamic-extent 83 | var size-var value body mode (proxied-type type)) 84 | (if (funcall #',(filtered-type-predicate type) ,value) 85 | (setf ,value (funcall #',(filtered-type-handler type) 86 | ,value))) 87 | (setf ,value-var ,value)))) 88 | (:inout `(let ((,value ,value-var)) 89 | (declare (type ,(lisp-type type) ,value)) 90 | (unless (funcall #',(filtered-type-predicate type) ,value) 91 | (setf ,value (funcall #',(filtered-type-handler type) 92 | ,value))) 93 | (prog1 94 | ,(expand-reference-dynamic-extent 95 | var size-var value body mode (proxied-type type)) 96 | (unless (funcall #',(filtered-type-predicate type) ,value) 97 | (setf ,value (funcall #',(filtered-type-handler type) 98 | ,value))) 99 | (setf ,value-var ,value)))))))) 100 | 101 | (define-immediate-type filtered-immediate-type (filtered-type) 102 | () 103 | (:converter (value type) 104 | (convert-value 105 | (if (funcall (fdefinition (filtered-type-predicate type)) value) 106 | value 107 | (funcall (fdefinition (filtered-type-handler type)) value)) 108 | (proxied-type type))) 109 | (:converter-expansion (value-form type) 110 | (with-gensyms (value) 111 | `(let ((,value (the ,(lisp-type type) ,value-form))) 112 | (if (funcall #',(filtered-type-predicate type) ,value) 113 | ,(expand-convert-value 114 | value 115 | (proxied-type type)) 116 | (let ((,value (funcall #',(filtered-type-handler type) ,value))) 117 | (declare (type ,(lisp-type type) ,value)) 118 | ,(expand-convert-value 119 | value 120 | (proxied-type type))))))) 121 | (:translator (value type) 122 | (let ((value (translate-value value (proxied-type type)))) 123 | (if (funcall (fdefinition (filtered-type-predicate type)) value) 124 | value 125 | (funcall (fdefinition (filtered-type-handler type)) value)))) 126 | (:translator-expansion (value-form type) 127 | (with-gensyms (value) 128 | `(let ((,value ,(expand-translate-value value-form (proxied-type type)))) 129 | (declare (type ,(lisp-type type) ,value)) 130 | (if (funcall #',(filtered-type-predicate type) ,value) 131 | ,value 132 | (funcall #',(filtered-type-handler type) ,value)))))) 133 | 134 | (define-type-parser filtered (type &optional (predicate 'identity) 135 | (handler 'identity)) 136 | (assert (valid-function-name-p predicate) 137 | (predicate)) 138 | (assert (valid-function-name-p handler) 139 | (handler)) 140 | (let ((type (parse-typespec type))) 141 | (make-instance (if (immediate-type-p type) 142 | 'filtered-immediate-type 143 | 'filtered-type) 144 | :type type 145 | :predicate predicate 146 | :handler handler))) 147 | 148 | (defmethod unparse-type ((type filtered-type)) 149 | `(filtered ,(unparse-type (proxied-type type)) 150 | ,(filtered-type-predicate type) 151 | ,(filtered-type-handler type))) 152 | -------------------------------------------------------------------------------- /doc/manual/html_node/Introduction.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Introduction - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 35 | 36 | 95 | 96 | 97 |
98 | 99 |

100 | Next: , 101 | Previous: Top, 102 | Up: Top 103 |

104 |
105 | 106 |

1 Introduction

107 | 108 |

Virgil is an extensible and high-level foreign function interface(FFI) 109 | built on top of CFFI and oriented towards marshaling lisp data 110 | into raw unmanaged memory and back. 111 | 112 |

Why the name `Virgil'? Well, have you read Dante's `Divine Comedy'? :) 113 | 114 |

Rationale

115 | 116 |

Why another FFI? CFFI seems perfect in terms of portability, 117 | but it exposes quite a low-level interface. CFFI is oriented towards 118 | manipulating foreign memory, and forces us to write `C-style' code in Lisp. 119 | Remember the old joke - "You can write FORTRAN in any language"? 120 | Using modern FFIs you can also write `C' in any language - but should you? 121 | 122 |

Virgil, as opposed to CFFI, is oriented towards marshaling. 123 | This means, Virgil does its best to free the programmer from 124 | messing up with pointers and the like, and allows to communicate 125 | with `native' code using Lisp data structures. 126 | 127 |

Thus, the main difference between CFFI and Virgil is that Virgil provides 128 | convenient semantics for marshaling aggregate data types and strives to 129 | establish a one-to-one mapping between lisp types and foreign ones. 130 | 131 |

Nevertheless, Virgil's interface is actually a bit similiar 132 | to that of CFFI, so you can easily start using it if you are familiar 133 | with the latter. 134 | 135 |

136 | Implementor's note: Virgil is not a kind of a replacement for CFFI, but instead a kind of a DSL on 137 | top of it. 138 |
139 | 140 | 141 | 142 | -------------------------------------------------------------------------------- /doc/manual/html_node/Installation-and-Prerequisites.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | Installation and Prerequisites - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 35 | 36 | 95 | 96 | 97 |
98 | 99 |

100 | Next: , 101 | Previous: Introduction, 102 | Up: Top 103 |

104 |
105 | 106 |

2 Installation and Prerequisites

107 | 108 |

Sources are available on github: 109 |

112 | 113 |

You can obtain them either using git, or by downloading latest zipball: 114 |

117 | 118 |

Virgil depends on CFFI, alexandria, babel and trivial-features. 119 | Note that CFFI itself depends on the other three libraries. 120 | 121 |

You can obtain all of them from their home pages: 122 |

128 | but i recommend to use Zach Bean's 129 | quicklisp - (ql:quickload :cffi) 130 | 131 |

Note that at the moment Virgil only supports x86 and x86-64 platforms. 132 | 1 133 | 134 |

135 |
136 |

Footnotes

[1] Mainly because of alignment conventions and because i am planning to add `by-value' passage of aggregate function parameters

137 | 138 |
139 | 140 | 141 | 142 | -------------------------------------------------------------------------------- /doc/manual/html_node/User_002dlevel-API.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | User-level API - Virgil User Manual 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 35 | 36 | 95 | 96 | 97 |
98 | 99 | 100 |

101 | Next: , 102 | Previous: Tutorial, 103 | Up: Top 104 |

105 |
106 | 107 |

4 User-level API

108 | 109 |

At the user level, marshaling engine utilizes 110 | a concept of type specifier, or typespec for short. 111 | A typespec is an s-expression denoting some marshling rules to 112 | be applied to some `foreign' value, such as a pointer, to translate it into lisp, 113 | or to some lisp value to convert it to foreign one. 114 | 115 |

Virgil's type specifiers are somewhat similiar to Common Lisp 116 | type specifiers, in the sense that they are represented 117 | either by a symbol denoting a type name or by a list, 118 | whose first elment is such a symbol. 119 | 120 |

Virgil exposes a deftype-like macro 121 | for establishing aliases for typespecs: 122 | 123 |

124 | 125 |

126 | — Macro: defalias name lambda-list &body body ⇒ name
127 |
128 |
name
A symbol. 129 |
lambda-list
A function lambda-list. 130 |
body
List of forms to be executed, preceded by an optional list of declarations. 131 |
132 |

133 | 134 |

Example

135 | 136 | 
  (defalias float4 (&optional (float-type 'single-float))
137 |     `(simple-array ,float-type (4)))
138 |
139 |
140 | Implementor's note: You must not define recursive types with defalias. Recursive 141 | types are supported only in structures. defalias, not unlike deftype, is 142 | unable to handle them - lisp system will crash or hang. 143 |
144 | 145 | 150 | 151 | 152 | 153 | -------------------------------------------------------------------------------- /src/enums.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | 3 | ;;; Copyright (C) 2010-2012, Dmitry Ignatiev 4 | 5 | ;;; Permission is hereby granted, free of charge, to any person 6 | ;;; obtaining a copy of this software and associated documentation 7 | ;;; files (the "Software"), to deal in the Software without 8 | ;;; restriction, including without limitation the rights to use, copy, 9 | ;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;; of the Software, and to permit persons to whom the Software is 11 | ;;; furnished to do so, subject to the following conditions: 12 | 13 | ;;; The above copyright notice and this permission notice shall be 14 | ;;; included in all copies or substantial portions of the Software. 15 | 16 | ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;; DEALINGS IN THE SOFTWARE. 24 | 25 | (in-package #:virgil) 26 | 27 | (defvar *enum-type-hash* (make-hash-table :test #'eq)) 28 | 29 | (define-immediate-type enum-type () 30 | ((keys->values :initarg :kv 31 | :initform '() 32 | :reader enum-type-kv) 33 | (values->keys :initarg :vk 34 | :initform '() 35 | :reader enum-type-vk) 36 | (base-type :initarg :base-type 37 | :initform (parse-typespec 'int) 38 | :reader base-type) 39 | (list :initarg :list 40 | :initform nil 41 | :reader enum-type-list-p)) 42 | (:prototype (type) 0) 43 | (:prototype-expansion (type) 0) 44 | (:lisp-type (type) 45 | `(or (member ,@(mapcar #'first (enum-type-kv type))) 46 | list 47 | ,(lisp-type (base-type type)))) 48 | (:converter (lisp-value type) 49 | (loop :with result = 0 50 | :with kv = (enum-type-kv type) 51 | :for key :in (ensure-list lisp-value) 52 | :do (setf result (logior result 53 | (if (integerp key) 54 | key 55 | (or (second (assoc key kv)) 56 | (error "~s is invalid keyword for enum type ~s" 57 | lisp-value (unparse-type type)))))) 58 | :finally (return result))) 59 | (:translator (raw-value type) 60 | (if (enum-type-list-p type) 61 | (loop :with list = '() 62 | :for vk :in (enum-type-vk type) 63 | :when (= (car vk) (logand raw-value (car vk))) 64 | :do (push (second vk) list) 65 | :finally (return (cons raw-value list))) 66 | (or (second (assoc raw-value (enum-type-vk type))) 67 | raw-value))) 68 | (:converter-expansion (lisp-value-form type) 69 | (if (constantp lisp-value-form) 70 | (convert-value (eval lisp-value-form) type) 71 | (with-gensyms (lisp-value result key) 72 | `(let ((,lisp-value ,lisp-value-form)) 73 | (declare (type ,(lisp-type type) ,lisp-value)) 74 | (let ((,result 0)) 75 | (declare (type ,(lisp-type (base-type type)) ,result)) 76 | (loop :for ,key :in (ensure-list ,lisp-value) 77 | :do (setf ,result 78 | (logior ,result 79 | (if (integerp ,key) 80 | ,key 81 | (ecase ,key 82 | ,@(enum-type-kv type) 83 | (T (error "~s is invalid keyword for enum type ~s" 84 | ,key 85 | ',(unparse-type type)))))))) 86 | ,result))))) 87 | (:translator-expansion (raw-value-form type) 88 | (if (constantp raw-value-form) 89 | (translate-value (eval raw-value-form) type) 90 | (with-gensyms (raw-value list) 91 | `(let ((,raw-value ,raw-value-form)) 92 | (declare (type ,(lisp-type (base-type type)) 93 | ,raw-value)) 94 | ,(if (enum-type-list-p type) 95 | `(let ((,list '())) 96 | (declare (type list ,list)) 97 | ,@(loop :for vk :in (enum-type-vk type) 98 | :collect (if (zerop (car vk)) 99 | `(push ',(second vk) ,list) 100 | `(when (= ,(car vk) 101 | (logand ,raw-value ,(car vk))) 102 | (push ',(second vk) ,list)))) 103 | (push ,raw-value ,list) 104 | ,list) 105 | `(case ,raw-value 106 | ,@(enum-type-vk type) 107 | (T ,raw-value))))))) 108 | (:cleaner (pointer value type) nil) 109 | (:cleaner-expansion (pointer value type) nil) 110 | (:allocator-expansion (value type) 111 | `(raw-alloc ,(compute-fixed-size type))) 112 | (:deallocator-expansion (pointer type) 113 | `(raw-free ,pointer))) 114 | 115 | (define-immediate-type named-enum-type (enum-type) 116 | ((name :initarg :name 117 | :initform nil 118 | :reader enum-type-name)) 119 | (:lisp-type (type) 120 | (enum-type-name type))) 121 | 122 | (defun parse-enum-list (enum-list) 123 | (loop :with kv = '() 124 | :with vk = '() 125 | :for x :in enum-list 126 | :for i :from 0 127 | :do (cond 128 | ((keywordp x) 129 | (push (list x i) kv) 130 | (push (list i x) vk)) 131 | ((consp x) 132 | (destructuring-bind 133 | (k v &rest rest) x 134 | (multiple-value-bind 135 | (v constantp) (eval-if-constantp v) 136 | (unless constantp 137 | (error "Enum value is not a constant: ~s" x)) 138 | (unless (integerp v) 139 | (error "Enum value is not an integer: ~s" x)) 140 | (unless (keywordp k) 141 | (error "Enum key is not a keyword: ~s" x)) 142 | (if (null rest) 143 | (progn (push (list k v) kv) 144 | (push (list v k) vk) 145 | (setf i v)) 146 | (error "Invalid enum value spec: ~s" x))))) 147 | (T (error "Invalid enum value spec: ~s" x))) 148 | :finally (return (values kv (remove-duplicates vk :key #'car :test #'=))))) 149 | 150 | (define-type-parser enum (options &rest enum-list) 151 | (destructuring-bind 152 | (&key (base-type 'int) list) options 153 | (multiple-value-bind 154 | (kv vk) (parse-enum-list enum-list) 155 | (make-instance 'enum-type 156 | :kv kv :vk vk 157 | :list (and list t) 158 | :base-type (parse-typespec base-type))))) 159 | 160 | (defmethod unparse-type ((type enum-type)) 161 | `(enum (:base-type ,(unparse-type (base-type type)) 162 | :list ,(enum-type-list-p type)) 163 | ,@(enum-type-kv type))) 164 | 165 | (defmethod unparse-type ((type named-enum-type)) 166 | (enum-type-name type)) 167 | 168 | (defmacro define-enum (name-and-options &rest enum-list) 169 | (check-type name-and-options (or symbol cons)) 170 | (let* ((name-and-options (ensure-list name-and-options)) 171 | (name (first name-and-options)) 172 | (options (rest name-and-options))) 173 | (assert (and (symbolp name) 174 | (not (constantp name)) 175 | (listp options)) 176 | (name options)) 177 | (destructuring-bind 178 | (&key (conc-name (intern (format nil "~a-" name))) 179 | (base-type 'int) 180 | list) 181 | (flatten-options options) 182 | (when (null conc-name) 183 | (setf conc-name "")) 184 | (multiple-value-bind 185 | (kv vk) (parse-enum-list enum-list) 186 | `(eval-when (:compile-toplevel :load-toplevel :execute) 187 | (setf (gethash ',name *enum-type-hash*) 188 | (make-instance 'named-enum-type 189 | :base-type (parse-typespec ',base-type) 190 | :name ',name 191 | :list ,(and list t) 192 | :kv ',kv 193 | :vk ',vk)) 194 | (define-type-parser ,name () 195 | (gethash ',name *enum-type-hash*)) 196 | ,@(loop :for (k v) :in kv 197 | :collect `(defconstant ,(intern (format nil "~a~a" conc-name k)) 198 | ,v)) 199 | (deftype ,name () 200 | '(or (member ,@(mapcar #'first kv)) 201 | list 202 | ,(lisp-type (parse-typespec base-type))))))))) 203 | -------------------------------------------------------------------------------- /src/primitives.lisp: -------------------------------------------------------------------------------- 1 | ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 | 3 | ;;; Copyright (C) 2010-2012, Dmitry Ignatiev 4 | 5 | ;;; Permission is hereby granted, free of charge, to any person 6 | ;;; obtaining a copy of this software and associated documentation 7 | ;;; files (the "Software"), to deal in the Software without 8 | ;;; restriction, including without limitation the rights to use, copy, 9 | ;;; modify, merge, publish, distribute, sublicense, and/or sell copies 10 | ;;; of the Software, and to permit persons to whom the Software is 11 | ;;; furnished to do so, subject to the following conditions: 12 | 13 | ;;; The above copyright notice and this permission notice shall be 14 | ;;; included in all copies or substantial portions of the Software. 15 | 16 | ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 19 | ;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 20 | ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 21 | ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 22 | ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER 23 | ;;; DEALINGS IN THE SOFTWARE. 24 | 25 | (in-package #:virgil) 26 | 27 | (define-primitive-type char-t 28 | (:cffi-type :char) 29 | (:lisp-type #.(%int-type :char))) 30 | 31 | (define-primitive-type uchar-t 32 | (:cffi-type :uchar) 33 | (:lisp-type #.(%int-type :uchar))) 34 | 35 | (define-primitive-type wchar-t 36 | (:cffi-type #+windows :uint16 37 | #-windows :uint32) 38 | (:lisp-type #.(%int-type #+windows :uint16 39 | #-windows :uint32))) 40 | 41 | (define-primitive-type short 42 | (:cffi-type :short) 43 | (:lisp-type #.(%int-type :short))) 44 | 45 | (define-primitive-type ushort 46 | (:cffi-type :ushort) 47 | (:lisp-type #.(%int-type :ushort))) 48 | 49 | (define-primitive-type int 50 | (:cffi-type :int) 51 | (:lisp-type #.(%int-type :int))) 52 | 53 | (define-primitive-type uint 54 | (:cffi-type :uint) 55 | (:lisp-type #.(%int-type :uint))) 56 | 57 | (define-primitive-type long 58 | (:cffi-type :long) 59 | (:lisp-type #+windows #.(%int-type :int32) 60 | #-windows #.(%int-type :long))) 61 | 62 | (define-primitive-type ulong 63 | (:cffi-type :ulong) 64 | (:lisp-type #+windows #.(%int-type :uint32) 65 | #-windows #.(%int-type :ulong))) 66 | 67 | (define-primitive-type llong 68 | (:cffi-type :llong) 69 | (:lisp-type #.(%int-type :llong))) 70 | 71 | (define-primitive-type ullong 72 | (:cffi-type :ullong) 73 | (:lisp-type #.(%int-type :ullong))) 74 | 75 | (define-primitive-type uint-ptr 76 | (:cffi-type #-x86-64 :uint32 77 | #+x86-64 :uint64) 78 | (:lisp-type #-x86-64 #.(%int-type :uint32) 79 | #+x86-64 #.(%int-type :uint64))) 80 | 81 | (define-primitive-type int-ptr 82 | (:cffi-type #-x86-64 :int32 83 | #+x86-64 :int64) 84 | (:lisp-type #-x86-64 #.(%int-type :int32) 85 | #+x86-64 #.(%int-type :int64))) 86 | 87 | (define-primitive-type single 88 | (:cffi-type :float) 89 | (:lisp-type single-float)) 90 | 91 | (defalias single-float () 'single) 92 | 93 | (define-primitive-type double 94 | (:cffi-type :double) 95 | (:lisp-type double-float)) 96 | 97 | (defalias double-float () 'double) 98 | 99 | (define-primitive-type bool 100 | (:cffi-type :boolean) 101 | (:lisp-type T) 102 | (:prototype nil)) 103 | 104 | (define-primitive-type int8 105 | (:cffi-type :int8) 106 | (:lisp-type #.(%int-type :int8))) 107 | (define-primitive-type uint8 108 | (:cffi-type :uint8) 109 | (:lisp-type #.(%int-type :uint8))) 110 | (define-primitive-type int16 111 | (:cffi-type :int16) 112 | (:lisp-type #.(%int-type :int16))) 113 | (define-primitive-type uint16 114 | (:cffi-type :uint16) 115 | (:lisp-type #.(%int-type :uint16))) 116 | (define-primitive-type int32 117 | (:cffi-type :int32) 118 | (:lisp-type #.(%int-type :int32))) 119 | (define-primitive-type uint32 120 | (:cffi-type :uint32) 121 | (:lisp-type #.(%int-type :uint32))) 122 | (define-primitive-type int64 123 | (:cffi-type :int64) 124 | (:lisp-type #.(%int-type :int64))) 125 | (define-primitive-type uint64 126 | (:cffi-type :uint64) 127 | (:lisp-type #.(%int-type :uint64))) 128 | 129 | (defalias size-t () 'uint-ptr) 130 | (deftype size-t () 'uint-ptr) 131 | (defalias ssize-t () 'int-ptr) 132 | (deftype ssize-t () 'int-ptr) 133 | 134 | (defalias ptrdiff-t () 'ssize-t) 135 | (deftype ptrdiff-t () 'ssize-t) 136 | 137 | (defalias sbyte () 'int8) 138 | (deftype sbyte () 'int8) 139 | (defalias ubyte () 'uint8) 140 | (deftype ubyte () 'uint8) 141 | (defalias byte () 'uint8) 142 | 143 | (defalias float () 'single) 144 | 145 | (define-immediate-type generic-char-type () 146 | () 147 | (:prototype (type) (code-char 0)) 148 | (:prototype-expansion (type) #.(code-char 0)) 149 | (:translator (raw-value type) 150 | (code-char raw-value)) 151 | (:converter (lisp-value type) 152 | (char-code lisp-value)) 153 | (:translator-expansion (raw-value-form type) 154 | `(code-char ,raw-value-form)) 155 | (:converter-expansion (lisp-value-form type) 156 | `(char-code ,lisp-value-form)) 157 | (:cleaner (pointer value type) nil) 158 | (:cleaner-expansion (pointer value type) nil) 159 | (:allocator-expansion (value type) 160 | `(raw-alloc ,(compute-fixed-size (base-type type)))) 161 | (:deallocator-expansion (pointer type) 162 | `(raw-free ,pointer))) 163 | 164 | (define-immediate-type char-type (generic-char-type) 165 | () 166 | (:base-type uchar-t) 167 | (:simple-parser char) 168 | (:lisp-type (type) 'base-char)) 169 | 170 | (define-immediate-type wchar-type (generic-char-type) 171 | () 172 | (:base-type wchar-t) 173 | (:simple-parser wchar) 174 | (:lisp-type (type) 'character)) 175 | 176 | (define-immediate-type boolean-type () 177 | ((base-type :initform (parse-typespec 'int) 178 | :initarg :base-type 179 | :reader base-type)) 180 | (:lisp-type (type) t) 181 | (:prototype (type) nil) 182 | (:prototype-expansion (type) nil) 183 | (:converter (lisp-value type) 184 | (if lisp-value 1 0)) 185 | (:converter-expansion (lisp-value-form type) 186 | `(if ,lisp-value-form 1 0)) 187 | (:translator (raw-value type) 188 | (/= 0 raw-value)) 189 | (:translator-expansion (raw-value-form type) 190 | `(/= 0 ,raw-value-form)) 191 | (:cleaner (pointer value type) nil) 192 | (:cleaner-expansion (pointer value type) nil) 193 | (:allocator-expansion (value type) 194 | `(raw-alloc ,(compute-fixed-size type))) 195 | (:deallocator-expansion (pointer type) 196 | `(raw-free ,pointer))) 197 | 198 | (define-type-parser boolean (&optional (base-type 'int)) 199 | (let ((base-type (parse-typespec base-type))) 200 | (assert (subtypep (lisp-type base-type) 'integer) 201 | (base-type) "Boolean type must be integral type") 202 | (make-instance 'boolean-type 203 | :base-type base-type))) 204 | 205 | (defmethod unparse-type ((type boolean-type)) 206 | `(boolean ,(unparse-type (base-type type)))) 207 | 208 | (defun error-void-operation () 209 | (error "Cannot operate on VOID type")) 210 | 211 | (deftype void () '(eql void)) 212 | (declaim (inline voidp)) 213 | (defun voidp (object) (eq object 'void)) 214 | (define-constant void 'void) 215 | 216 | (define-immediate-type void-type () 217 | () 218 | (:simple-parser void) 219 | (:lisp-type (type) T) 220 | (:prototype (type) void) 221 | (:prototype-expansion (type) 'void) 222 | (:converter (val type) void) 223 | (:converter-expansion (val type) 'void) 224 | (:translator (val type) void) 225 | (:translator-expansion (val type) 'void) 226 | (:cleaner (p v type) (error-void-operation)) 227 | (:cleaner-expansion (p v type) (error-void-operation)) 228 | (:allocator (value type) (error-void-operation)) 229 | (:deallocator (pointer type) (error-void-operation)) 230 | (:allocator-expansion (value type) (error-void-operation)) 231 | (:deallocator-expansion (pointer type) (error-void-operation)) 232 | (:dynamic-extent-expansion (var val body type) 233 | (error-void-operation))) 234 | 235 | (defmethod base-type ((type void-type)) 236 | (make-instance 'primitive-type 237 | :name :void 238 | :cffi-type :void 239 | :lisp-type 'void 240 | :prototype void)) 241 | 242 | (defmethod compute-fixed-size ((type void-type)) 243 | (error-void-operation)) 244 | (defmethod compute-size (val (type void-type)) 245 | (error-void-operation)) 246 | (defmethod expand-compute-size (var (type void-type)) 247 | (error-void-operation)) 248 | (defmethod compute-alignment ((type void-type)) 249 | (error-void-operation)) 250 | (defmethod read-value (ptr out (type void-type)) 251 | (error-void-operation)) 252 | (defmethod write-value (ptr out (type void-type)) 253 | (error-void-operation)) 254 | (defmethod expand-read-value (ptr out (type void-type)) 255 | (error-void-operation)) 256 | (defmethod expand-write-value (ptr out (type void-type)) 257 | (error-void-operation)) 258 | (defmethod expand-reference-dynamic-extent 259 | (var szvar valvar body mode (type void-type)) 260 | (error-void-operation)) 261 | (defmethod expand-callback-dynamic-extent 262 | (var value body (type void-type)) 263 | (error-void-operation)) 264 | --------------------------------------------------------------------------------