/
wrap.lisp
87 lines (79 loc) · 4.07 KB
/
wrap.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
(in-package #:grovel-locally)
(defun read-wrapper-spec (input-file)
(with-open-file (in input-file :direction :input)
(loop :for form = (read in nil nil) :while form :collect form)))
(defun generate-c-lib-file (input-data c-file)
(let ((cffi-grovel::*lisp-forms* nil))
(ensure-directory-pathname (pathname-directory-pathname c-file))
(with-open-file (cffi-grovel::out c-file :direction :output
:if-exists :supersede)
(cffi-grovel::write-string cffi-grovel::*header* cffi-grovel::out)
(loop :for form :in input-data
:do (cffi-grovel::process-wrapper-form cffi-grovel::out form)))
(values c-file (nreverse cffi-grovel::*lisp-forms*))))
(defun generate-bindings-file* (lib-soname lisp-forms output-defaults
system sys-local-lib-name)
(with-standard-io-syntax
(let ((lisp-file (cffi-grovel::tmp-lisp-file-name output-defaults))
(*print-readably* nil)
(*print-escape* t))
(with-open-file (out lisp-file :direction :output :if-exists :supersede)
(format out ";;;; This file was automatically generated by cffi-grovel.~%~
;;;; Do not edit by hand.~%")
(let ((*package* (find-package '#:cl))
(named-library-name
(let ((*package* (find-package :keyword))
(*read-eval* nil))
(read-from-string lib-soname)))
(search-file `(asdf:system-relative-pathname
,(component-name system)
,(pathname-directory-pathname
sys-local-lib-name))))
(pprint `(progn
(cffi:define-foreign-library
(,named-library-name
:type :grovel-wrapper
:search-path ,search-file)
(t ,(namestring
(cffi-grovel::make-so-file-name lib-soname))))
(cffi:use-foreign-library ,named-library-name))
out)
(fresh-line out))
(dolist (form lisp-forms)
(print form out))
(terpri out))
lisp-file)))
(defun process-wrapper-file* (system spec-file dest-lisp-file dest-lib-file
c-file o-file lib-soname sys-local-lib-name)
(with-standard-io-syntax
(multiple-value-bind (input-data) (read-wrapper-spec spec-file)
(let* ((*local-includes* nil))
(unless (process-from-cache-p system dest-lisp-file dest-lib-file)
(process-wrapper-file-from-scratch system input-data dest-lisp-file
lib-soname dest-lib-file c-file
o-file sys-local-lib-name))
(values dest-lisp-file dest-lib-file)))))
(defun process-wrapper-file-from-scratch (system input-data dest-lisp-file
lib-soname lib-file c-file o-file
sys-local-lib-name)
;;
(multiple-value-bind (c-file lisp-forms)
(generate-c-lib-file input-data c-file)
(let ((inputs (list (cffi-grovel::cc-include-grovel-argument) c-file)))
(when *local-includes*
(push (copy-local-includes-to-cache c-file) inputs))
(cffi-grovel::cc-compile o-file inputs))
(cffi-grovel::link-shared-library lib-file (list o-file))
(let ((tmp-file (generate-bindings-file* lib-soname lisp-forms
dest-lisp-file system
sys-local-lib-name)))
(unwind-protect (alexandria:copy-file tmp-file dest-lisp-file
:if-to-exists :supersede)
(delete-file tmp-file))
nil)))
;;------------------------------------------------------------
(defun process-from-cache-p (system cached-lisp-file cached-lib-file)
(and cached-lib-file
cached-lisp-file
(uiop:file-exists-p (system-relative-pathname system cached-lib-file))
(uiop:file-exists-p (system-relative-pathname system cached-lisp-file))))