changeset 695: | 2bad47888dbf |
parent: | 5f88b237ce29 |
author: | Richard Westhaver <ellis@rwest.io> |
date: | Fri, 04 Oct 2024 16:14:44 -0400 |
permissions: | -rw-r--r-- |
description: | add static-vector |
96 | 1 | ;;; alien.lisp --- foreign alien friends |
5 | 2 | |
263
b7183bfd7107
add doc/readme.txt, more doc upgrades
Richard Westhaver <ellis@rwest.io>
parents:
238
diff
changeset
|
3 | ;; |
b7183bfd7107
add doc/readme.txt, more doc upgrades
Richard Westhaver <ellis@rwest.io>
parents:
238
diff
changeset
|
4 | |
5 | 5 | ;;; Commentary: |
6 | ||
7 | ;; FFI in Lisp is somewhat different than FFI in other host langs. As |
|
8 | ;; such, we usually refer to our Lispy FFI interfaces inline with the |
|
9 | ;; CMUCL terminology: alien interfaces. |
|
10 | ||
11 | ;; ref: https://www.sbcl.org/manual/#Foreign-Function-Interface for details |
|
12 | ||
13 | ;; sb-alien is a high-level interface which automatically converts C |
|
14 | ;; memory pointers to lisp objects and back, but this can be slow for |
|
15 | ;; large or complex objects. |
|
16 | ||
17 | ;; The lower-level interface is based on System Area Pointers (or |
|
18 | ;; SAPs), which provide untyped access to foreign memory. |
|
19 | ||
20 | ;; Objects which can't be automatically converted into Lisp values are |
|
21 | ;; represented by objects of type ALIEN-VALUE. |
|
22 | ||
23 | ;;; Code: |
|
291 | 24 | (in-package :std/alien) |
600
93ea0386a0c8
fix alien package-lock violation
Richard Westhaver <ellis@rwest.io>
parents:
476
diff
changeset
|
25 | ;; (shadowing-import |
93ea0386a0c8
fix alien package-lock violation
Richard Westhaver <ellis@rwest.io>
parents:
476
diff
changeset
|
26 | ;; '(sb-unix::syscall sb-unix::syscall* sb-unix::int-syscall |
93ea0386a0c8
fix alien package-lock violation
Richard Westhaver <ellis@rwest.io>
parents:
476
diff
changeset
|
27 | ;; sb-unix::with-restarted-syscall sb-unix::void-syscall) :std) |
222 | 28 | |
5 | 29 | ;; (reexport-from :sb-vm |
96 | 30 | ;; :include |
31 | ;; '(:with-pinned-objects :with-pinned-object-iterator :with-code-pages-pinned |
|
32 | ;; :sanctify-for-execution)) |
|
5 | 33 | |
365
49c3f3d11432
bug fixes and more tweaks for test macros
Richard Westhaver <ellis@rwest.io>
parents:
362
diff
changeset
|
34 | (defun shared-object-name (name &optional path) |
233
a47790d0e1bb
ublk, simple-cli opts, stealth mixins
Richard Westhaver <ellis@rwest.io>
parents:
224
diff
changeset
|
35 | "Return a filename with the correct extension for a shared library." |
365
49c3f3d11432
bug fixes and more tweaks for test macros
Richard Westhaver <ellis@rwest.io>
parents:
362
diff
changeset
|
36 | (let ((name #+darwin (format nil "lib~a.dylib" name) |
49c3f3d11432
bug fixes and more tweaks for test macros
Richard Westhaver <ellis@rwest.io>
parents:
362
diff
changeset
|
37 | #-darwin (format nil "lib~a.so" name))) |
49c3f3d11432
bug fixes and more tweaks for test macros
Richard Westhaver <ellis@rwest.io>
parents:
362
diff
changeset
|
38 | (if path |
49c3f3d11432
bug fixes and more tweaks for test macros
Richard Westhaver <ellis@rwest.io>
parents:
362
diff
changeset
|
39 | (merge-pathnames name path) |
49c3f3d11432
bug fixes and more tweaks for test macros
Richard Westhaver <ellis@rwest.io>
parents:
362
diff
changeset
|
40 | (pathname name)))) |
149 | 41 | |
222 | 42 | (defun list-all-shared-objects () |
43 | sb-alien::*shared-objects*) |
|
44 | ||
238 | 45 | (defmacro define-alien-loader (name &optional export (root "/usr/local/lib/") path) |
149 | 46 | "Define a default loader function named load-NAME which calls |
47 | SB-ALIEN:LOAD-SHARED-OBJECT." |
|
217
17c05cd3e549
going nuklear, cfg obj, general fixes, introduction of x.lisp
Richard Westhaver <ellis@rwest.io>
parents:
208
diff
changeset
|
48 | (let* ((fname (sb-int:symbolicate (format nil "~@:(load-~a~)" name)))) |
149 | 49 | `(prog1 |
50 | (defun ,fname (&optional save) |
|
238 | 51 | (prog1 (sb-alien:load-shared-object (shared-object-name ',(or path name) ,root) :dont-save (not save)) |
217
17c05cd3e549
going nuklear, cfg obj, general fixes, introduction of x.lisp
Richard Westhaver <ellis@rwest.io>
parents:
208
diff
changeset
|
52 | (pushnew ,(sb-int:keywordicate (string-upcase name)) *features*))) |
149 | 53 | ,@(when export (list `(export '(,fname))))))) |
54 | |
|
362
b1f78dffbcdd
rustls work, fixed https bugs
Richard Westhaver <ellis@rwest.io>
parents:
291
diff
changeset
|
55 | (defmacro define-opaque (ty &optional no-export foreign-type) |
110
cae8da4b1415
rocksdb macrofication, fixes for RDB (C Strings will be the death of me), removed PWN - quicklisp package conflict, smh.
ellis <ellis@rwest.io>
parents:
96
diff
changeset
|
56 | `(prog1 |
695 | 57 | (eval-when (:compile-toplevel :load-toplevel :execute) |
58 | (define-alien-type ,ty (struct ,(or foreign-type (symbolicate ty '-t))))) |
|
110
cae8da4b1415
rocksdb macrofication, fixes for RDB (C Strings will be the death of me), removed PWN - quicklisp package conflict, smh.
ellis <ellis@rwest.io>
parents:
96
diff
changeset
|
59 | ,(unless no-export `(export '(,ty))))) |
88 | 60 | |
82 | 61 | (defun setfa (place from) |
62 | (loop for x across from |
|
63 | for i from 0 below (length from) |
|
64 | do (setf (deref place i) x))) |
|
65 | ||
5 | 66 | (defun copy-c-string (src dest &aux (index 0)) |
238 | 67 | (declare (type sb-int:index index)) |
5 | 68 | (loop (let ((b (sb-sys:sap-ref-8 src index))) |
69 | (when (= b 0) |
|
70 | (setf (fill-pointer dest) index) |
|
71 | (return)) |
|
72 | (setf (char dest index) (code-char b)) |
|
73 | (incf index)))) |
|
74 | ||
75 | (defun clone-strings (list) |
|
680
5f88b237ce29
added skc, fixed alien c-string functions, upgrades and fixes for rocksdb/rdb
Richard Westhaver <ellis@rwest.io>
parents:
678
diff
changeset
|
76 | (let ((len (length list))) |
5f88b237ce29
added skc, fixed alien c-string functions, upgrades and fixes for rocksdb/rdb
Richard Westhaver <ellis@rwest.io>
parents:
678
diff
changeset
|
77 | (with-alien ((x (* (* char)) (make-alien (* char) len))) |
5f88b237ce29
added skc, fixed alien c-string functions, upgrades and fixes for rocksdb/rdb
Richard Westhaver <ellis@rwest.io>
parents:
678
diff
changeset
|
78 | (labels ((populate (list index) |
5f88b237ce29
added skc, fixed alien c-string functions, upgrades and fixes for rocksdb/rdb
Richard Westhaver <ellis@rwest.io>
parents:
678
diff
changeset
|
79 | (declare (type sb-int:index index)) |
5f88b237ce29
added skc, fixed alien c-string functions, upgrades and fixes for rocksdb/rdb
Richard Westhaver <ellis@rwest.io>
parents:
678
diff
changeset
|
80 | (if list |
5f88b237ce29
added skc, fixed alien c-string functions, upgrades and fixes for rocksdb/rdb
Richard Westhaver <ellis@rwest.io>
parents:
678
diff
changeset
|
81 | (let ((array (sb-ext:string-to-octets (car list) :null-terminate t))) |
5f88b237ce29
added skc, fixed alien c-string functions, upgrades and fixes for rocksdb/rdb
Richard Westhaver <ellis@rwest.io>
parents:
678
diff
changeset
|
82 | (sb-sys:with-pinned-objects (array) |
5f88b237ce29
added skc, fixed alien c-string functions, upgrades and fixes for rocksdb/rdb
Richard Westhaver <ellis@rwest.io>
parents:
678
diff
changeset
|
83 | (setf (deref x index) (sap-alien (sb-sys:vector-sap array) (* char))) |
5f88b237ce29
added skc, fixed alien c-string functions, upgrades and fixes for rocksdb/rdb
Richard Westhaver <ellis@rwest.io>
parents:
678
diff
changeset
|
84 | (populate (cdr list) (1+ index)))) |
5f88b237ce29
added skc, fixed alien c-string functions, upgrades and fixes for rocksdb/rdb
Richard Westhaver <ellis@rwest.io>
parents:
678
diff
changeset
|
85 | x))) |
5f88b237ce29
added skc, fixed alien c-string functions, upgrades and fixes for rocksdb/rdb
Richard Westhaver <ellis@rwest.io>
parents:
678
diff
changeset
|
86 | (cast (populate list 0) (* c-string)))))) |
5 | 87 | |
222 | 88 | (defun c-strings-to-string-list (c-strings) |
89 | (declare (type (alien (* c-string)) c-strings)) |
|
90 | (let ((reversed-result nil)) |
|
91 | (dotimes (i most-positive-fixnum) |
|
238 | 92 | (declare (type sb-int:index i)) |
222 | 93 | (let ((c-string (deref c-strings i))) |
94 | (if c-string |
|
95 | (push c-string reversed-result) |
|
96 | (return (nreverse reversed-result))))))) |
|
97 | ||
658
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
98 | (defun clone-octets-to-alien (lispa alien) |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
99 | (declare (optimize (speed 3)) |
678
2b7d5a8d63ac
alien octets fix, workin with org-graph-db
Richard Westhaver <ellis@rwest.io>
parents:
658
diff
changeset
|
100 | ((vector (unsigned-byte 8)) lispa)) |
658
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
101 | ;; (setf aliena (cast aliena (array (unsigned 8)))) |
657 | 102 | (loop for i from 0 below (length lispa) |
658
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
103 | do (setf (deref alien i) |
657 | 104 | (aref lispa i))) |
658
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
105 | alien) |
47 | 106 | |
658
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
107 | (defun octets-to-alien (lispa) |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
108 | (let ((a (make-alien (unsigned 8) (length lispa)))) |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
109 | (clone-octets-to-alien lispa a))) |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
110 | |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
111 | ;; TODO 2024-09-19: maybe want to return values, second being the length? |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
112 | (defun octets-to-alien-array (lispa) |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
113 | (cast (octets-to-alien lispa) (array (unsigned 8)))) |
657 | 114 | |
115 | (defun clone-octets-from-alien (aliena lispa &optional len) |
|
116 | (declare (optimize (speed 3)) |
|
678
2b7d5a8d63ac
alien octets fix, workin with org-graph-db
Richard Westhaver <ellis@rwest.io>
parents:
658
diff
changeset
|
117 | (vector lispa)) |
657 | 118 | (unless len (setf len (length lispa))) |
119 | (loop for i from 0 below len |
|
120 | do (setf (aref lispa i) |
|
121 | (deref aliena i))) |
|
122 | lispa) |
|
47 | 123 | |
5 | 124 | (defun foreign-int-to-integer (buffer size) |
125 | "Check SIZE of int BUFFER. return BUFFER." |
|
126 | (assert (= size (sb-alien:alien-size sb-alien:int :bytes))) |
|
127 | buffer) |
|
128 | ||
129 | (defun foreign-int-to-bool (x size) |
|
130 | (if (zerop (foreign-int-to-integer x size)) |
|
131 | nil |
|
132 | t)) |
|
133 | ||
134 | (defun bool-to-foreign-int (val) |
|
135 | (if val 1 0)) |
|
224 | 136 | |
469
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
137 | (define-condition invalid-enum-variant (simple-error) ()) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
138 | (define-condition invalid-enum-value (simple-error) ()) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
139 | |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
140 | (defun invalid-enum-variant (var enum) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
141 | (error 'invalid-enum-variant |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
142 | :format-control "~A is not a variant of enum ~A" |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
143 | :format-arguments (list var enum))) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
144 | |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
145 | (defun invalid-enum-value (var enum) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
146 | (error 'invalid-enum-value |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
147 | :format-control "~A is not a value associated with a variant of enum ~A" |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
148 | :format-arguments (list var enum))) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
149 | |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
150 | (defmacro define-alien-enum ((name type &key (test 'eql) (default :error)) &rest forms) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
151 | "Define a pseudo-enum type, used to work-around difficulties working with |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
152 | SB-ALIEN, groveller, typedef enums, etc. |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
153 | |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
154 | NAME specified the name of the alien-type and keyword-based lookup |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
155 | function. Additionally a NAME* reverse-lookup function is provided. |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
156 | |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
157 | Two hash-tables are defined in the environment of the accessor functions |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
158 | containing the variants. These are technically exposed anaphors |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
159 | %lisp-enum-table and %lisp-enum-table*." |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
160 | (setf forms (loop for (k . v) on forms by #'cddr |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
161 | collect (cons k v))) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
162 | (with-gensyms (val) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
163 | (let ((%lisp-enum-table (make-hash-table :test test :size (length forms))) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
164 | (%lisp-enum-table* (make-hash-table :test 'equal :size (length forms)))) ; TODO: may want this to be EQL, |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
165 | ; taking strings for now. |
476 | 166 | (mapc (lambda (x) (setf (gethash (car x) %lisp-enum-table) (eval (cadr x)))) forms) |
167 | (mapc (lambda (x) (setf (gethash (eval (cadr x)) %lisp-enum-table*) (car x))) forms) |
|
469
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
168 | `(progn |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
169 | (define-alien-type ,name ,type) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
170 | (defun ,name (,val) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
171 | ,(format nil "Given a keyword naming a variant of ~A, return the associated value." name) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
172 | (let ((found (gethash ,val ,%lisp-enum-table ,default))) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
173 | ,@(when (eql default :error) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
174 | `((when (eql found :error) (invalid-enum-variant ,val ',name)))) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
175 | found)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
176 | (defun ,(symbolicate name '*) (,val) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
177 | ,(format nil "Given a ~A, check that it is equal to one of the variants of ~A and return |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
178 | it. This function returns a second value which indicates the name of the |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
179 | variant associated with this value." type name) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
180 | (std:when-let ((found (gethash ,val ,%lisp-enum-table* |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
181 | ,default))) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
182 | ,@(when (eql default :error) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
183 | `((when (eql found :error) (invalid-enum-value ,val ',name)))) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
184 | (values ,val found))))))) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
365
diff
changeset
|
185 | |
658
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
186 | ;; from CFFI |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
187 | (defmacro with-alien-slots (vars struct &body body) |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
188 | "Create local symbol macros for each var in VARS to reference |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
189 | foreign slots in STRUCT. Similar to WITH-SLOTS. |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
190 | Each var can be of the form: |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
191 | name name bound to slot of same name |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
192 | (* name) name bound to pointer to slot of same name |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
193 | (name slot-name) name bound to slot-name |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
194 | (name :pointer slot-name) name bound to pointer to slot-name" |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
195 | `(symbol-macrolet |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
196 | ,(loop for var in vars |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
197 | collect |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
198 | (if (listp var) |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
199 | (let ((p1 (first var)) (p2 (second var)) (p3 (third var))) |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
200 | (if (eq (sb-int:keywordicate p1) :*) |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
201 | `(,p2 (addr (slot ,struct ',p2))) |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
202 | (if (eq (sb-int:keywordicate p2) :*) |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
203 | `(,p1 (addr (slot ,struct ',p3))) |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
204 | `(,p1 (slot ,struct ',p2))))) |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
205 | `(,var (slot ,struct ',var)))) |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
206 | ,@body)) |
804b5ee20a46
zstd completed (besides zdict), working on readline
Richard Westhaver <ellis@rwest.io>
parents:
657
diff
changeset
|
207 | |
224 | 208 | (defun num-cpus () |
209 | "Return the number of CPU threads online." |
|
210 | (alien-funcall (extern-alien "sysconf" (function int int)) sb-unix:sc-nprocessors-onln)) |
|
277
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
263
diff
changeset
|
211 | |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
263
diff
changeset
|
212 | (defvar *cpus* (num-cpus)) |
10faf95f90dd
stream and basic type upgrades. fixed some bugs and improved csv parsing
Richard Westhaver <ellis@rwest.io>
parents:
263
diff
changeset
|
213 | |
238 | 214 | ;;; C Standard |
215 | ||
216 | ;; types |
|
217 | (define-alien-type loff-t long-long) |
|
218 | ||
219 | (define-alien-routine memset void (ptr (* t)) (constant int) (size size-t)) |
|
695 | 220 | (define-alien-routine memcpy void (dst (* t)) (src (* t)) (size size-t)) |
221 | (define-alien-routine posix-memalign int (box (* t)) (alignment size-t) (size size-t)) |