changeset 7: |
05527b920c97 |
parent: |
32ed719c5189
|
child: |
61482ce290f9 |
author: |
ellis <ellis@rwest.io> |
date: |
Mon, 16 Oct 2023 23:11:19 -0400 |
permissions: |
-rw-r--r-- |
description: |
asd cleanups |
1 ;;; std/alien.lisp --- foreign alien friends 5 ;; FFI in Lisp is somewhat different than FFI in other host langs. As 6 ;; such, we usually refer to our Lispy FFI interfaces inline with the 7 ;; CMUCL terminology: alien interfaces. 9 ;; ref: https://www.sbcl.org/manual/#Foreign-Function-Interface for details 11 ;; sb-alien is a high-level interface which automatically converts C 12 ;; memory pointers to lisp objects and back, but this can be slow for 13 ;; large or complex objects. 15 ;; The lower-level interface is based on System Area Pointers (or 16 ;; SAPs), which provide untyped access to foreign memory. 18 ;; Objects which can't be automatically converted into Lisp values are 19 ;; represented by objects of type ALIEN-VALUE. 22 (uiop:define-package :std/alien 24 (:use :sb-vm :sb-ext :sb-c :std/base) 25 (:use-reexport :sb-alien) 29 :foreign-int-to-integer :foreign-int-to-bool :bool-to-foreign-int 31 :u1 :u2 :u3 :u4 :u8 :u16 :u24 :u32 :u64 :u128 32 :i2 :i3 :i4 :i8 :i16 :i24 :i32 :i64 :i128 33 :f16 :f24 :f32 :f64 :f128)) 37 ;; (reexport-from :sb-vm 39 ;; '(:with-pinned-objects :with-pinned-object-iterator :with-code-pages-pinned 40 ;; :sanctify-for-execution)) 42 (defun copy-c-string (src dest &aux (index 0)) 43 (loop (let ((b (sb-sys:sap-ref-8 src index))) 45 (setf (fill-pointer dest) index) 47 (setf (char dest index) (code-char b)) 50 (defun clone-strings (list) 51 (with-alien ((x (* (* char)) 52 (make-alien (* char) (length list)))) 54 (labels ((populate (list index function) 56 (let ((array (sb-ext:string-to-octets (car list) :null-terminate t))) 57 (sb-sys:with-pinned-objects (array) 58 (setf (deref x index) (sap-alien (sb-sys:vector-sap array) (* char))) 59 (populate (cdr list) (1+ index) function))) 63 (loop for i below (length list) 64 do (print (cast (deref x i) c-string)))))) 67 (defun foreign-int-to-integer (buffer size) 68 "Check SIZE of int BUFFER. return BUFFER." 69 (assert (= size (sb-alien:alien-size sb-alien:int :bytes))) 72 (defun foreign-int-to-bool (x size) 73 (if (zerop (foreign-int-to-integer x size)) 77 (defun bool-to-foreign-int (val) 81 (defmacro defbytes (&body bitsets) 82 "For each cons-cell in BITSETS, define a new CAR-byte type for each 84 `(loop for set in ',bitsets 89 ((eq 'signed-byte ty) "I") 90 ((eq 'unsigned-byte ty) "U") 92 (t (subseq (symbol-name ty) 0 1)))) 98 `(deftype ,(symbolicate pfx (format 'nil "~a" x)) () 104 (unsigned-byte 1 2 3 4 8 16 24 32 64 128) 105 (signed-byte 2 3 4 8 16 24 32 64 128) 106 (float 16 24 32 64 128))