cffi-clasp.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP (HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/ (DIR) Log (DIR) Files (DIR) Refs (DIR) Tags (DIR) README (DIR) LICENSE --- cffi-clasp.lisp (6322B) --- 1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- 2 ;;; 3 ;;; cffi-clasp.lisp --- CFFI-SYS implementation for Clasp. 4 ;;; 5 ;;; Copyright (C) 2017 Frank Goenninger <frank.goenninger@goenninger.net> 6 ;;; 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: 14 ;;; 15 ;;; The above copyright notice and this permission notice shall be 16 ;;; included in all copies or substantial portions of the Software. 17 ;;; 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. 26 ;;; 27 28 ;;;# Administrivia 29 30 (defpackage #:cffi-sys 31 (:use #:common-lisp #:alexandria) 32 (:export 33 #:canonicalize-symbol-name-case 34 #:foreign-pointer 35 #:pointerp 36 #:pointer-eq 37 #:%foreign-alloc 38 #:foreign-free 39 #:with-foreign-pointer 40 #:null-pointer 41 #:null-pointer-p 42 #:inc-pointer 43 #:make-pointer 44 #:pointer-address 45 #:%mem-ref 46 #:%mem-set 47 #:%foreign-funcall 48 #:%foreign-funcall-pointer 49 #:%foreign-type-alignment 50 #:%foreign-type-size 51 #:%load-foreign-library 52 #:%close-foreign-library 53 #:native-namestring 54 #:make-shareable-byte-vector 55 #:with-pointer-to-vector-data 56 #:%defcallback 57 #:%callback 58 #:%foreign-symbol-pointer)) 59 60 (in-package #:cffi-sys) 61 62 ;;;# Mis-features 63 64 (pushnew 'flat-namespace cl:*features*) 65 66 ;;;# Symbol Case 67 68 (defun canonicalize-symbol-name-case (name) 69 (declare (string name)) 70 (string-upcase name)) 71 72 ;;;# Allocation 73 74 (defun %foreign-alloc (size) 75 "Allocate SIZE bytes of foreign-addressable memory." 76 (clasp-ffi:%foreign-alloc size)) 77 78 (defun foreign-free (ptr) 79 "Free a pointer PTR allocated by FOREIGN-ALLOC." 80 (clasp-ffi:%foreign-free ptr)) 81 82 (defmacro with-foreign-pointer ((var size &optional size-var) &body body) 83 "Bind VAR to SIZE bytes of foreign memory during BODY. The 84 pointer in VAR is invalid beyond the dynamic extent of BODY, and 85 may be stack-allocated if supported by the implementation. If 86 SIZE-VAR is supplied, it will be bound to SIZE during BODY." 87 (unless size-var 88 (setf size-var (gensym "SIZE"))) 89 `(let* ((,size-var ,size) 90 (,var (%foreign-alloc ,size-var))) 91 (unwind-protect 92 (progn ,@body) 93 (foreign-free ,var)))) 94 95 ;;;# Misc. Pointer Operations 96 97 (deftype foreign-pointer () 98 'clasp-ffi:foreign-data) 99 100 (defun null-pointer-p (ptr) 101 "Test if PTR is a null pointer." 102 (clasp-ffi:%null-pointer-p ptr)) 103 104 (defun null-pointer () 105 "Construct and return a null pointer." 106 (clasp-ffi:%make-nullpointer)) 107 108 (defun make-pointer (address) 109 "Return a pointer pointing to ADDRESS." 110 (clasp-ffi:%make-pointer address)) 111 112 (defun inc-pointer (ptr offset) 113 "Return a pointer OFFSET bytes past PTR." 114 (clasp-ffi:%inc-pointer ptr offset)) 115 116 (defun pointer-address (ptr) 117 "Return the address pointed to by PTR." 118 (clasp-ffi:%foreign-data-address ptr)) 119 120 (defun pointerp (ptr) 121 "Return true if PTR is a foreign pointer." 122 (typep ptr 'clasp-ffi:foreign-data)) 123 124 (defun pointer-eq (ptr1 ptr2) 125 "Return true if PTR1 and PTR2 point to the same address." 126 (check-type ptr1 clasp-ffi:foreign-data) 127 (check-type ptr2 clasp-ffi:foreign-data) 128 (eql (pointer-address ptr1) (pointer-address ptr2))) 129 130 131 ;;;# Shareable Vectors 132 ;;; 133 ;;; This interface is very experimental. WITH-POINTER-TO-VECTOR-DATA 134 ;;; should be defined to perform a copy-in/copy-out if the Lisp 135 ;;; implementation can't do this. 136 137 (defun make-shareable-byte-vector (size) 138 "Create a Lisp vector of SIZE bytes that can passed to 139 WITH-POINTER-TO-VECTOR-DATA." 140 (make-array size :element-type '(unsigned-byte 8))) 141 142 ;; frgo, 2016-07-02: TODO: Implemenent! 143 ;; (defmacro with-pointer-to-vector-data ((ptr-var vector) &body body) 144 ;; "Bind PTR-VAR to a foreign pointer to the data in VECTOR." 145 ;; `(let ((,ptr-var (si:make-foreign-data-from-array ,vector))) 146 ;; ,@body)) 147 148 (defun %foreign-type-size (type-keyword) 149 "Return the size in bytes of a foreign type." 150 (clasp-ffi:%foreign-type-size type-keyword)) 151 152 (defun %foreign-type-alignment (type-keyword) 153 "Return the alignment in bytes of a foreign type." 154 (clasp-ffi:%foreign-type-alignment type-keyword)) 155 156 ;;;# Dereferencing 157 158 (defun %mem-ref (ptr type &optional (offset 0)) 159 "Dereference an object of TYPE at OFFSET bytes from PTR." 160 (clasp-ffi:%mem-ref ptr type offset)) 161 162 (defun %mem-set (value ptr type &optional (offset 0)) 163 "Set an object of TYPE at OFFSET bytes from PTR." 164 (clasp-ffi:%mem-set ptr type value offset)) 165 166 (defmacro %foreign-funcall (name args &key library convention) 167 "Call a foreign function." 168 (declare (ignore library convention)) 169 `(clasp-ffi:%foreign-funcall ,name ,@args)) 170 171 (defmacro %foreign-funcall-pointer (ptr args &key convention) 172 "Funcall a pointer to a foreign function." 173 (declare (ignore convention)) 174 `(clasp-ffi:%foreign-funcall-pointer ,ptr ,@args)) 175 176 ;;;# Foreign Libraries 177 178 (defun %load-foreign-library (name path) 179 "Load a foreign library." 180 (clasp-ffi:%load-foreign-library name path)) 181 182 (defun %close-foreign-library (handle) 183 "Close a foreign library." 184 (clasp-ffi:%close-foreign-library handle)) 185 186 (defun %foreign-symbol-pointer (name library) 187 "Returns a pointer to a foreign symbol NAME." 188 (clasp-ffi:%foreign-symbol-pointer name library)) 189 190 (defun native-namestring (pathname) 191 (namestring pathname)) 192 193 ;;;# Callbacks 194 195 (defmacro %defcallback (name rettype arg-names arg-types body 196 &key convention) 197 `(clasp-ffi:%defcallback (,name ,@(when convention `(:convention ,convention))) 198 ,rettype ,arg-names ,arg-types ,body)) 199 200 (defun %callback (name) 201 (clasp-ffi:%get-callback name))