Common Lisp CFFI: pointer to the pointer - pointers

I am trying to write the CFFI wrapper for Sundials CVODE library. SWIG was choking on Sundials headers since they are quite interconnected and SWIG couldn't find the right headers, so I did it by hand: a bit laborious but I've managed.
Now I'm trying to test if it works correctly. For now, just simply creating the "problem object" and deleting it. That is where the problem starts. So, the "problem object" is allocated via function
SUNDIALS_EXPORT void *CVodeCreate(int lmm, int iter);
For which I created the wrapper:
(cffi:defcfun "CVodeCreate" :pointer
(lmm :int)
(iter :int))
PS. SUNDIALS_EXPORT (at least on Unix's) is basically nothing.
Now, to destroy the object, Sundials uses its own function:
SUNDIALS_EXPORT void CVodeFree(void **cvode_mem);
So, I need to pass it the reference to the object created by CVodeCreate. In C, if my memory is not at fault, I would have done something like CVodeFree(&problem_object). In CL I've written this wrapper for the function:
(cffi:defcfun "CVodeFree" :void
(cvode-mem :pointer))
So, here COVDE-MEM is a pointer to a pointer. Question is how to get the pointer of the pointer in CL/CFFI? Here is the beginning of the code:
(defvar *p* (cvodecreate 1 2))
(PS. Don't worry about the numbers passed to CVODECREATE, they just tell which methods to use, still need to defined constants to make it more readable)
So *P* is something like
#.(SB-SYS:INT-SAP #X7FFFE0007060)
If I pass it directly to CVODEFREE, it ends up in error:
CL-USER> (cvodefree *p*)
; Evaluation aborted on #<SIMPLE-ERROR "bus error at #X~X" {1005EC9BD3}>.
I've tried passing (CFFI:POINTER-ADDRESS *P*) but it results in similar "bus error..." (not even sure if this function returns what I need). I've also tried to do (CFFI:MAKE-POINTER (CFFI:POINTER-ADDRESS *P*)), once again without any success.
This question suggests this approach:
(cffi:with-foreign-object (p :pointer)
(setf (cffi:mem-ref p :pointer) (cvodecreate 1 2))
(cvodefree p))
This works (at least it doesn't throw an error). I think I understand how it works: it creates (allocates the memory for) a pointer-to-a-pointer P, whose MEM-REF (or in C terms would be dereferencing *p) is filled by the result on CVODECREATE. Finally, I'm passing this pointer-to-a-pointer to CVODEFREE, which expects exactly this. Finally, the memory allocated for P is freed once the form finished. Is this the correct approach? And is it the only one I can take?

Yup, your approach looks right, here is a small test to show the concept that can be run straight from the repl.
(let* (;; a float
(v0 32s0)
;; a pointer to a float foreign memory
(p0 (cffi:foreign-alloc :float :initial-element v0)))
;; a new pointer
(cffi:with-foreign-object (p1 :pointer)
;; make the new pointer point to the first pointer
(setf (cffi:mem-aref p1 :pointer) p0)
;; dereferencing twice should give you the original number
(cffi:mem-aref (cffi:mem-aref p1 :pointer) :float)))
p.s. I'm sure you knew this by now, sorry it took so long to get you an answer. Hopefully this can help others

Related

Good example of when to muffle warnings?

This question is somewhat related to an earlier one on programmatically generating symbol macros. I'm using that function in a convenience macro that throws undefined variable warnings. This macro and function:
(defmacro define-data (d body &optional doc)
(if (and doc (not (stringp doc))) (error "Documentation is not a string"))
`(let* ((d-str (string ',d))
(old-package *package*)
(*package* (if (find-package d-str) ;exists?
(find-package d-str) ;yes, return it
(make-package d-str)))) ;no, make it
;; Should we have an eval-when (:compile-toplevel) here?
(defparameter ,d ,body ,doc)
(export ',d old-package)
(define-column-names ,d)))
(defun define-column-names (d)
(maphash #'(lambda (key index)
(eval `(cl:define-symbol-macro ,key (cl:aref (columns ,d) ,index))))
(ordered-keys-table (slot-value d 'ordered-keys))))
are intended to be like defparameter, but additionally set up a few niceties for the user by defining:
a package with the name of d
a parameter in the current package with the data that will be sucked in by body
symbol-macros in package d for access to the individual data vectors
If I use defparameter from the REPL, and then call define-column-names, all is well. However when using the macro I get:
; in: DEFINE-COLUMN-NAMES FOO
; (DEFINE-COLUMN-NAMES CL-USER::FOO)
;
; caught WARNING:
; undefined variable: CL-USER::FOO
I suspect that this is because the compiler has no way of knowing that FOO will actually be defined when define-symbol-macro is called. Everything works fine, but I don't want the warning to frighten users, so am thinking of suppressing it. I hate suppressing warnings though, so thought I'd come here for a second opinion.
EDIT: I've marked an answer correct because it does correctly answer the question as asked. For an answer to the problem see my comments.
My answer to the 'when to muffle warnings' question in the title is: if it's your own code then never, under any circumstances. If it is someone else's code, then rewrite it not to warn unless you can't.
As to solving the problem I haven't thought about this hard enough, but the problem is that you definitely want the defparameter to be at top-level so the compiler can see it, and it can't really be if it's inside a let. But you can raise it to toplevel trivially since it depends on nothing inside the let.
I am then pretty certain that you want the rest of the macro to happen at compile time, because you definitely want the symbol-macros available at compile-time. So an attempt at the first macro would be (note I've fixed the handling of the docstring: (defparameter foo 1 nil) is bad):
(defmacro define-data (d body &optional doc)
(when (and doc (not (stringp doc)))
(error "Documentation is not a string"))
`(progn
(defparameter ,d ,body ,#(if doc (list doc) '()))
(eval-when (:compile-toplevel :load-toplevel :execute)
(let* ((d-str (string ',d))
(old-package *package*)
(*package* (if (find-package d-str) ;exists?
(find-package d-str) ;yes, return it
(make-package d-str)))) ;no, make it
(export ',d old-package)
(define-column-names ,d)))))
As a side note: although I think the fact that programmatically defining symbol macros is hard because CL left that out for some reason, I think I'd personally use some other approach rather than this, because eval is just so horrid. That's just me however: if you want to do this you do need eval I think (it is very rare that this is true!).
I am not sure exactly how define-columns-names works so I replaced it with a stub function that returns d.
Note also that you can use check-type and should try not injecting symbols in generated code, this introduces potential variable capture that can be avoided with gensym.
As far as I know you cannot use eval-when as suggested by your comment (see Issue EVAL-WHEN-NON-TOP-LEVEL Writeup for details).
But I have no warning if I declare the symbol as being special around the call.
(defmacro define-data (d body &optional doc)
(check-type doc (or null string))
(check-type d symbol)
(let ((d-str (string d)))
(alexandria:with-gensyms (old-package)
`(let* ((,old-package *package*)
(*package* (if (find-package ,d-str) ;exists?
(find-package ,d-str) ;yes, return it
(make-package ,d-str)))) ;no, make it
(defparameter ,d ,body ,doc)
(export ',d ,old-package)
(locally (declare (special ,d))
(define-column-names ,d))))))
It is also a bit strange that you expand into a call to define-column-names, which in turns evaluated a form built at runtime. I think it might be possible to do all you want during macroexpansion time, but as said earlier what you are trying to do is a bit unclear to me. What I have in mind is to replace define-column-names by:
,#(expand-column-names-macros d)
... where expand-column-names-macros builds a list of define-symbol-macro forms.

Reading qualified symbols

I'm working on a code formatter for Lisp, which is using the reader to read code into S-expression format.
This works fine for plain symbols.
It doesn't work so well for qualified symbols. foo:bar is only readable if the package foo has been defined, but of course as far as the formatter is concerned, it has not, because unlike the compiler, the formatter is only reading the code, not executing it.
How can I tell the reader to either go ahead and automatically create a package foo on the fly, or failing that, don't sweat it, just read foo:bar, not as a symbol per se, but in some unambiguous format I can deal with as a special case?
I believe that you should not use the reader for that, because that is lossy (you lose comments, and anything that gets changed through reader macros, e. g. read-time-values, read-time references etc.).
But if you want, you can automatically create the package and maybe also export the symbol by handling the error, e. g. on SBCL:
(handler-bind ((sb-int:simple-reader-package-error
(lambda (e)
(let ((p (sb-int::package-error-package e)))
(ctypecase p
(string
(make-package p)
(invoke-restart 'retry))
(package
(export (intern (first (simple-condition-format-arguments e)) p) p)
(invoke-restart 'retry)))))))
(with-simple-restart (retry "Retry")
(read-from-string "foo:bar")))
This is a bit hacky, and we have no guarantee that the format of the condition stays like that.

Let, flet, macrolet : is there a way to do a "class-let"?

I have a macro which defines a class under certain rules, pseudo-code :
(defvar *all-my-classes* nil)
(defmacro my-macro (param)
`(if ,param
(progn
(defclass class-A () ...)
(push class-A *all-my-classes*))
(progn
(defclass class-B () ...)
(push class-B *all-my-classes*))))
I want to test the behaviour of the macro. Let is a convenient tool to mock variables. If I have an instance of *all-my-classes* running, I just have to do :
(let ((*all-my-classes* my-new-value)) ; generally `nil` for the test
(my-macro false))
But I would like to conserve the correspondance between *all-my-classes* and the classes defined. Since I want to test all the cases, let us suppose class-A is defined in the current environment, and i want to test if running (my-macro false) correctly defines class-B.
Since it is just a test, I would like the test to assert that class-B is currently defined, and that class-A is undefined in the current local environment; then when the test is over, class-B is undefined in the global environment, and class-A is still defined (without any alteration).
This way would be the best for my use :
(let ((*all-my-classes* nil))
(class-let ((class-A nil) ; or a way to map to a pre-defined
(class-B nil)) ; empty class temporarily.
(my-macro false)
(and
;; assert that the class is added to the list
(eql (length *all-my-classes*) 1)
;; assert that class-A is not defined
(null (find-class 'class-A))
;; assert that class-B is defined
(find-class 'class-B))))
I've searched to see if I can undefine a class, but it seems to be complex and implementation-dependent. And I want to preserve the current environment.
Restarting LISP each time for each tests is too long, and I would prefer a solution without having to load-unload packages for each tests (I don't know if it could work and if the classes will be garbage-collected when unloading the package...).
Thank you for your answers.
I do not think so.
The mechanism of how classes are stored is completely implementation defined, they just need to conform to the MOP (at least as far as it is mandated by the standard). However, the MOP does not prescribe anything that would make the classes registry dynamic. In fact, types and class names are specified to be part of the global environment (CLHS ch. 3.1.1.1), so it would be difficult for a conforming implementation to get dynamic here.
As you wrote, there is also no specified way to get rid of a class once defined.
As a rationale, I think that without this it would be very difficult to provide the kind of optimized runtime that the existing implementations have. Class lookup needs to be fast.
Now, to get to the meta question: what are you trying to do? Usually, while code is data, you should not confuse program logic with the programmed logic. What you propose looks like it might be intended to have code represent data. I'd advise to think about a clean separation and orthogonal representation.

Franz LISP to Common LISP conversion questions

I'm reviving an old LISP program from the early 1980s.
(It's the Nelson-Oppen simplifier, an early proof system.
This version was part of the Ford Pascal-F Verifier,
and was running in Franz LISP in 1982.) Here's
the entire program:
https://github.com/John-Nagle/pasv/tree/master/src/CPC4
I'm converting the code to run under clisp on Linux,
and need some advice. Most of the problems are with
macros.
HUNKSHELL
Hunkshell was a 1970s Stanford SAIL hack to support records with named fields in LISP. I think I've converted this OK; it seems to work.
https://github.com/John-Nagle/pasv/blob/master/src/CPC4/hunkshell.l
The original macro generated more macros as record update functions.
I'm generating defuns. Is there any reason to generate macros?
By the way, look at what I wrote for "CONCAT". Is there a better way
to do that?
DEFMAC
More old SAIL macros, to make macro definition easier before defmacro became part of the language.
https://github.com/John-Nagle/pasv/blob/master/src/CPC4/defmac.l
I've been struggling with "defunobj". Here's my CL version, partly converted:
; This macro works just like defun, except that both the value and the
; function-binding of the symbol being defined are set to the function
; being defined. Therefore, after (defunobj f ...), (f ...) calls the
; defined function, whereas f evaluates to the function itself.
;
(defmacro defunobj (fname args &rest b)
`(progn
(defun ,fname ,args ,b)
;;;;(declare (special ,fname)) ;;;; ***declare not allowed here
(setq ,fname (getd ',fname))))
If I made that declare a proclaim, would that work right?
And what replaces getd to get a function pointer?
SPECIAL
There are lots of (DECLARE (SPECIAL FOO)) declarations at top
level in this code. That's not allowed in CL. Is it
appropriate to use (PROCLAIM (SPECIAL FOO)) instead?
Concat
Essentially correct, but indentation is broken (like everywhere else - I suggest Emacs to fix it).
Also, you don't need the values there.
defunobj
I suggest defparameter instead
of setq. Generally speaking, before setting a variable (with, e.g., setq) one should establish it (with, e.g., let or defvar).
fdefinition is what
you are looking for instead of getd.
I also don't think you are using backquote right:
(defmacro defunobj (fname &body body)
`(progn
(defun ,fname ,#body)
(defparameter ,fname (fdefinition ',fname))))
Special
I think defvar and defparameter
are better than proclaim
special.
PS. Are you aware of the CR.se site?

Lisp, cffi, let and memory

I've build some toy C++ library to quickly create a Qt window from Lisp. I know that common-qt exists, I'm just trying to learn how to use cffi.
Right now, I have 4 binded functions :
create-application : create a QApplication and return a pointer
create-window : create a QMainWindow and return a poiner
show : show the window specified as argument
exec : Qt exec function
Here is a lisp code that work perfectly :
(defctype t-app :pointer)
(defctype t-window :pointer)
(defcfun (create-application "create_application" ) t-app)
(defcfun (exec "exec") :void (app t-app))
(defcfun (create-window-aalt "create_window_aalt") t-window)
(defcfun (show "show") :void (o t-window))
(defparameter a (create-application))
(defparameter w (create-window-aalt))
(show w)
(exec a)
But if I use LET or LET*...I have a memory fault !
(let* ((a (create-application)) (w (create-window-aalt)))
(show w)
(exec a))
CORRUPTION WARNING in SBCL pid 1312(tid 140737353860992):
Memory fault at a556508 (pc=0x7ffff659b7f1, sp=0x7ffff2bbe688)
The integrity of this image is possibly compromised.
Exiting.
Does someone know why ?
I am using SBCL :
env LD_LIBRARY_PATH=`pwd` \
env LD_PRELOAD=/usr/lib/libQtGui.so.4 \
sbcl --script aalt.lisp
Thanks.
I would suggest you do the following:
Since you are writing library C++ and using its symbols from Lisp, make sure that you use extern "C" declarations - those are needed to ensure that C++ compiler does not mangle names.
Check that your library works in a C (not C++) application. This will ensure that the library itself is working (e.g., it does not throw C++ exceptions).
UPD:
I've tried to run your code and had the same crash. The problem seems to be in your create_application function. I've attached my fixed version of this function at http://paste.lisp.org/display/138049.
Concretely, there are 2 problems:
create_application allocated v on stack. Subsequent code (i.e., the let binding) overwrites it.
argv should be NULL-terminated. I.e., it should contain argc+1 elements - the last element is NULL. (Qt seems to not use this, but it is good habit to write code according to specs).
In your case, the stack allocation is the problem - it seems that let binding overwrites the value of v on stack, crashing SBCL. Using malloc or new to allocate argv on heap fixes this issue.

Resources