Exactly as the question says. I want to use shared memory to communicate between two lisp processes. Any pointers on how to do that?
I can see some tutorials on doing this in clozure at :-
http://ccl.clozure.com/manual/chapter4.7.html
Can someone point me to a similar library to do this with sbcl?
For a portable implementation, you might want to use the osicat library, which provides a CFFI wrapper for many POSIX calls in the osicat-posix package.
There is a very nice and short article with code for using it at http://wandrian.net/2012-04-07-1352-mmap-files-in-lisp.html (by Nicolas Martyanoff).
To preserve that, I mostly cite from there:
Mapping a file is done by opening it with osicat-posix:open, reading its size with fstat, then calling mmap. Once the file has been mapped we can close the file descriptor, it’s not needed anymore.
(defun mmap-file (path)
(let ((fd (osicat-posix:open path (logior osicat-posix:o-rdonly))))
(unwind-protect
(let* ((size (osicat-posix:stat-size (osicat-posix:fstat fd)))
(addr (osicat-posix:mmap (cffi:null-pointer) size
(logior osicat-posix:prot-read)
(logior osicat-posix:map-private)
fd 0)))
(values addr size))
(osicat-posix:close fd))))
The mmap-file function returns two values: the address of the memory mapping and its size.
Unmapping this chunk of memory is done with osicat-posix:munmap.
Let’s add a macro to safely map and unmap files:
(defmacro with-mmapped-file ((file addr size) &body body)
(let ((original-addr (gensym "ADDR-"))
(original-size (gensym "SIZE-")))
`(multiple-value-bind (,addr ,size)
(mmap-file ,file)
(let ((,original-addr ,addr)
(,original-size ,size))
(unwind-protect
(progn ,#body)
(osicat-posix:munmap ,original-addr ,original-size))))))
This macro mmaps the given file and binds the two given variables to its address and and size. You can then calculate address pointers with cffi:inc-pointer and access the file contents with cffi:mem-aref. You might want to build your own wrappers around this to represent the format of your file (e. g. plain text in UTF-8).
(In comparison to the posting linked above, I removed the wrapping of osicat-posix:munmap into another function of exactly the same signature and effect, because it seemed superfluous to me.)
There is low-level mmap function bundled with sbcl:
CL-USER> (apropos "MMAP")
SB-POSIX:MMAP (fbound)
; No value
CL-USER> (describe 'sb-posix:mmap)
SB-POSIX:MMAP
[symbol]
MMAP names a compiled function:
Lambda-list: (ADDR LENGTH PROT FLAGS FD OFFSET)
Derived type: (FUNCTION (T T T T T T)
(VALUES SYSTEM-AREA-POINTER &OPTIONAL))
Inline proclamation: INLINE (inline expansion available)
Source file: SYS:CONTRIB;SB-POSIX;INTERFACE.LISP.NEWEST
; No value
You have to use explicit address arithmetics to use it, as in C.
Related
I use a macro called use-db and change-to-path in a lot of my projects.
(defmacro use-db (db project-name &body query)
`(progn
(change-to-path ,project-name)
(clsql:connect ,db :database-type :sqlite3)
(unwind-protect (progn ,#query)
(clsql:disconnect :database ,db))))
(defmacro change-to-path (project-name)
`(uiop:chdir (merge-pathnames (write-to-string ,project-name) "/Users/vince/quicklisp/local-projects/")))
As you can see, change to path changes the repl dir. Then use-db reads the sqlite db from the root of the project folder. This works fine.
However, when I try to read a db as part of a route (easy-routes + hunchentoot):
(defroute test-file ("/results" :method :post)
()
(get-one-col-as-list-db #'first "firstname"))
(defun get-one-col-as-list-db (fn tablename)
(ki:use-db "new.db" 'custom-sender
(mapcar fn
(clsql:query
(concatenate 'string "Select * from " tablename)))))
I get the following error:
Error in SB-POSIX:CHDIR: No such file or directory (2)
without using the change-to-path macro, clsql function would note find the database.
Is there a better way to use sqlite (from the file system) and manage the pathing for specific db files?
To change the current working directory, temporarily, use uiop:with-current-directory:
(uiop:with-current-directory ("/tmp/")
(uiop:getcwd))
(edit) chdir has a side effect: it effectively changes the current working directory (uiop:getcwd), while with-current-directory doesn't, or it does but only temporarily for the code under it. For your sanity you want to avoid chdir's side effets (or I do, I want to work at a project root). It could have an effect on bare-bones Hunchentoot, if it looks at a www/ directory under the project root, but in your case I'm not sure.
Your use-db mimics a well-known pattern: get a resource, and be sure to release it in case of errors. These macros are often named "with-something", just like "with-current-directory". Does CLSQL have such a macro? It does: with-database.
Why is your change-to-path a macro? It can be a function that concatenates strings and calls chdir.
Inside use-db, "project-name" is an unknown variable. Look at the compiler warnings:
; caught WARNING:
; undefined variable: COMMON-LISP-USER::PROJECT-NAME
How do you use the two anyways?
Error in SB-POSIX:CHDIR: No such file or directory (2) […] without using the change-to-path macro
what is the directory it tries to go to? You'd have a tip on how things are not working.
I try to never rely on the process working directory, because from Common Lisp I am much happier using *default-pathname-defaults* (no side effects!). This is a special variable with a long name, and what I want is to use merge-pathnames in most of the cases, so I have this macro:
(defmacro with-path (pathname &body body)
`(let ((*default-pathname-defaults* (merge-pathnames ,pathname)))
,#body))
It is just a local binding of a special variable so unwinding is trivial, and it comes with all the benefits of CL pathnames (and some of its drawbacks but that's fine).
On the Posix side of things, programs want a native namestring so I also use this a lot:
(defun fullname (pathname)
(osicat:native-namestring (merge-pathnames pathname)))
I do also have a concept of projects in my environment so it looks as follows. Note that I try to carry the special variable until the last moment, until it needs to be given to other processes, like:
(within-project projects:my-project
(with-path "build/"
(run "make")))
Here run grabs the current *default-pathname-defaults* for its :directory argument (using sb-ext:run-program but this is a detail).
Since it is a pathname, some components can be wild too, if that makes sense in your use case. For example, you can avoid giving a ".db" suffix if you prefer:
(defmacro using-db ((name db) &body body)
`(with-path #P"*.db"
(with-database (,name (list (fullname ,db)) :database-type :sqlite3)
,#body)))
For example, here I enter the "/tmp/" directory and open database "test.db":
(with-path "/tmp/"
(using-db (database "test")
database)))
#<CLSQL-SQLITE3:SQLITE3-DATABASE /tmp/test.db CLOSED {100DD6CE63}>
Edit: with respect to the following code:
(uiop:chdir
(merge-pathnames (write-to-string project-name)
"/Users/vince/quicklisp/local-projects/")))
Note that you can use ASDF to access files relative to systems:
(asdf:system-relative-pathname :cl-ppcre "ppcre.lisp")
#P"..../quicklisp/software/cl-ppcre-20220220-git/ppcre.lisp"
Sounds deceptively easy. This doesn't work:
~/.sbclrc
(load #P"~/in-package.lisp")
~/in-package.lisp
(in-package 'stored-package)
The package change only applies to the file in-package.lisp itself.
Try different approach: store just the name.
(defmacro recall-package (&optional (filename #p"~/lisp-package.lisp"))
"IN-PACKAGE the contents of the FILENAME"
(let ((p (car (uiop:read-file-lines filename))))
`(in-package ,p)))
This works, but only from ~/.sbclrc. Files which it LOADs expand the macro within their own context, and so it doesn't work.
SBCL reads it's .sbclrc like this:
(restart-case
(flet ((process-init-file (kind specified-pathname default-function)
(awhen (or specified-pathname (funcall default-function))
(with-open-file (stream (if specified-pathname
(parse-native-namestring it)
(pathname it))
:if-does-not-exist nil)
(cond (stream
(sb-fasl::call-with-load-bindings
(lambda (stream kind) (load-as-source stream :context kind))
stream kind stream))
(specified-pathname
(cerror "Ignore missing init file"
"The specified ~A file ~A was not found."
kind specified-pathname)))))))
(unless no-sysinit
(process-init-file "sysinit" sysinit *sysinit-pathname-function*))
(unless no-userinit
(process-init-file "userinit" userinit *userinit-pathname-function*))
Using these fancy sb-fasl::call-with-load-bindings and sb-int:load-as-source yields similar results to the above.
You can't do this with load, because
load binds *readtable* and *package* to the values they held before loading the file.
Function load
This means that any changes made to the values of these variables within a file being loaded are local to the file. That's almost always a good thing. In particular it means that there is no way at all (or no portable way: if you had access to the guts of the dynamic binding mechanism of the implementation this might not be true) that any changes made to the current package (ie the dynamic value of *package*) can ever propagate up through calls to load.
If all you want to do is set the package based on some name in a file, then this is relatively easy, with something like the below:
(defpackage :empty-package
(:use))
(defun set-package-from-file (f)
(let ((pn
(with-standard-io-syntax
;; EP just in case the file does somehow manage to smash
;; *package*)
(let* ((ep (find-package :empty-package))
(*package* ep)
(*read-eval* nil))
(unwind-protect
(with-open-file (in f)
(string (read in)))
;; Clean up EP to avoid leakage
(do-symbols (s ep)
(unintern s ep)))))))
(let ((p (find-package pn)))
(unless p (error "no package ~A" pn))
(setf *package* p))))
This is probably both overly-protective and thus will contain some horrible unexpected bug which I should have thought about (I know it's not safe against interning symbols in other packages). However the idea is that the file contains a single string-designator which should be the package name.
If you had time on your hands you could fairly easily write a version of load which would not rebind *package* &c, and which would work for source files. I think you can't portably write one which would work for FASL files.
Here's one reason why the behaviour the language specifies is the right behaviour: it makes compilation a lot easier. Consider a file which contains:
(in-package ...)
(defun foo (...) ...)
(load ...)
(defun bar (...)
(foo ...)
...)
If *package* could propagate up through load then compiling this file would be, at best, interesting.
I try to write BLOB into database - chunk by chunk, using database API C-function (say, db-write-chunk).
This function takes a pointer to a foreign memory (where chunk is placed) as an argument.
So, I make buffer for a chunk: foreign-buffer.
I'll take chunk data from a file (or binary stream) by read-sequence into stream-buffer:
(let ((foreign-buffer (foreign-alloc :uchar 1024)))
(stream-buffer ((make-array 1024 :element-type '(unsigned-byte 8))))
(loop
for cnt = (read-sequence stream-buffer MY-STREAM)
while (> cnt 0)
do
;; copy cnt bytes from stream-buffer into foreign-buffer
;; call db-write-chunk with foreign-buffer
L in BLOB is for Large and loop may iterate many times.
Besides that, all this code may be wrapped by the external loop (bulk-insert, for example).
So, I want to minimize the count of steps in the loop(s) body.
To have this done I need:
to be able to read sequence not into stream-buffer, but into foreign-buffer directly, like this:
(read-sequence (coerce foreign-buffer '(vector/array ...)) MY-STREAM)
or to be able to interpret stream-buffer as foreign memory, like this:
(db-write-chunk (mem-aptr stream-buffer :uchar 0))
Is it possible to solve my problem using single buffer only - native or foreign, without copying memory between them?
Like anything else ffi, this is implementation dependent, but cffi has cffi:make-shareable-byte-vector, which is a CL (unsigned-byte 8) array which you can then use with cffi:with-pointer-to-vector-data:
(cffi:defcfun memset :pointer
(ptr :pointer)
(val :int)
(size :int))
(let ((vec (cffi:make-shareable-byte-vector 256)))
(cffi:with-pointer-to-vector-data (ptr vec)
(memset ptr 0 (length vec))))
Depending on your use, this might be preferable to static-vectors, because you don't have to remember to free it manually. On SBCL this works by pinning the vector data during with-pointer-to-vector-data.
Is there a way, in common lisp, to receive a user input, say "foo", and defvar a global variable *foo*?
For example (which does NOT work):
(defun global-name (s)
"Takes s and changes it to *s*"
(concatenate 'string "*" s "*"))
(defun add-global-var (var)
"defvars a global variable and adds it to *global-list*"
(let ((var-name (global-name var)))
(defvar var-name var)
(push var-name *global-list*)))
; Used like this:
(add-global-var "myvar")
In this case, the var-name is a string, and will not work with defvar.
Déjà vu... I asked these kinds of questions 20+ years ago ;-)
Your question
Yes, you can do that (but no, you do not want to!)
(defun add-global-var (var-name &optional (package *package*))
(let ((var (intern var-name package)))
(proclaim `(special ,var))
(push var *global-list*)))
Please see
proclaim
intern
*package*
Alternatively, you can use a macro as the other answer suggests - in
fact, symbol creation at macroexpansion time (which is part of
compilation) is a very common thing,
cf. gensym.
Your problem
There is little reason to do this though.
Global variables created at run time were not available at compile time
and are, therefore, pretty useless.
Why do you want to do this?
If you want to map strings to values, you are much better off using an
equal hash table.
If you want to integrate with read,
you should call it while binding
*package*
to your internal temp package and then use
symbol-value
to store and retrieve values.
You will use intern to
map "variable names" to the symbols.
This is most likely a XY problem since it's very unusual to need to make a variable with a name made up in runtime. It's very common in compile time, but not runtime. #coredump has already covered compile time macros if that is what you are after.
Here is how you do it though:
(defun add-global-var (var)
"defvars a global variable and adds it to *global-list*"
(let ((var-name (intern (string-upcase (global-name var)))))
(set var-name var)
(push var-name *global-list*)))
set is deprecated, but I doubt it will ever be removed. Implementations might not be able to run as fast though since this is like messing with internals.
Since the names are not from source you you have no good use for the bidnings. because of this I would rather use a hash:
(defvar *bindings* (make-hash-table :test #'eq))
(defun add-binding (var)
(let ((var-name (intern (string-upcase (global-name var)))))
(setf (gethash var-name *bindings*) var)
*bindings*))
A reason to do this is as a part of your own little interpreter symbol table or something. You don't need a list of them since you can get all the keys from the hash as well as get the bound values.
Yes, with a macro:
(defvar *global-list* nil)
I changed global-name so that it also accepts symbols, to avoid thinking about whether the string should be upcased or not. With a symbol, the case is given by readtable-case (you can use uninterned symbols if you want to avoid polluting packages).
(defun global-name (name)
(check-type name (or string symbol))
(intern
(concatenate 'string "*" (string name) "*")))
I named the macro defvar*:
(defmacro defvar* (name)
`(push
(defvar ,(global-name name) ',name)
*global-list*))
Tests:
CL-USER> (defvar* #:foo)
(*FOO*)
CL-USER> (defvar* #:bar)
(*BAR* *FOO*)
Note:
You can also add an optional package argument like in #sds's answer, that's better.
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?