I just spent an hour playing with the FFI. I haven't gone near this
since hacking on Meta-CVS.
After this experiment, I have a hunch that that the platform glue in
mcvs can be rewritten purely in FFI code, eliminating the need to do
any C compiling and linking.
I've been able to wrap up a fairly nasty function which stores values
in a structure you must predefine, has a special cleanup routine you
must call, and uses a callback for reporting errors.
Goal: wrap up glob and globfree.
caveats:
- gl_pathv isn't documented as null terminated, but treating it like
that seems to work under my glibc
- no constants defined for flags parameter
- passing closures for the function parameter of glob-ll causes them to
leak, so I bind the function to a special variable instead which is
retrieved by a trampoline, and pass the trampoline into glob-ll.
[1]> (glob "/var/log/*")
#("/var/log/anaconda.log" "/var/log/anaconda.syslog" "/var/log/audit"
"/var/log/boot.log" "/var/log/boot.log.1" "/var/log/boot.log.2"
"/var/log/boot.log.3" "/var/log/boot.log.4" "/var/log/btmp"
"/var/log/btmp.1"
"/var/log/cron" "/var/log/cron.1" "/var/log/cron.2" "/var/log/cron.3"
"/var/log/cron.4" "/var/log/cups" "/var/log/dmesg" "/var/log/gdm"
"/var/log/lastlog" "/var/log/mail" "/var/log/maillog"
"/var/log/maillog.1"
"/var/log/maillog.2" "/var/log/maillog.3" "/var/log/maillog.4"
"/var/log/messages" "/var/log/messages.1" "/var/log/messages.2"
"/var/log/messages.3" "/var/log/messages.4" "/var/log/ppp"
"/var/log/prelink.log" "/var/log/rpmpkgs" "/var/log/rpmpkgs.1"
"/var/log/rpmpkgs.2" "/var/log/rpmpkgs.3" "/var/log/rpmpkgs.4"
"/var/log/samba" "/var/log/scrollkeeper.log" "/var/log/secure"
"/var/log/secure.1" "/var/log/secure.2" "/var/log/secure.3"
"/var/log/secure.4" "/var/log/spooler" "/var/log/spooler.1"
"/var/log/spooler.2" "/var/log/spooler.3" "/var/log/spooler.4"
"/var/log/vbox" "/var/log/wtmp" "/var/log/wtmp.1"
"/var/log/Xorg.0.log"
"/var/log/Xorg.0.log.old" "/var/log/Xorg.1.log"
"/var/log/Xorg.1.log.old")
[2]> (glob "/var/spool/*/*" (lambda (path errno) (format t "~a ~a~%"
path errno) 0))
/var/spool/cups 13
/var/spool/mqueue 13
/var/spool/at 13
/var/spool/clientmqueue 13
/var/spool/cron 13
#("/var/spool/anacron/cron.daily" "/var/spool/anacron/cron.monthly"
"/var/spool/anacron/cron.weekly" "/var/spool/mail/root"
"/var/spool/mail/kaz")
(use-package :ffi)
(def-c-struct glob-t
(gl-pathc uint32)
(gl-pathv (c-array-ptr c-string))
(gl-offs uint32)
;; We don't know how big this struct really is,
;; so let's allocate extra space for it!
(padding (c-array int 16)))
(def-call-out glob-ll
(:language :stdc)
(:library "libc.so.6")
(:name "glob")
(:arguments (pattern c-string) (flags int)
(errorfunc (c-function (:language :stdc)
(:arguments (epath c-string)
(eerrno int))
(:return-type int)))
(glob c-pointer :in :none))
(:return-type int))
(def-call-out glob-free-ll
(:language :stdc)
(:library "libc.so.6")
(:name "globfree")
(:arguments (glob c-pointer :in :none)))
;; Hack to avoid passing closures into glob-ll;
;; they leak!!!
(defvar *error-func*)
(defun glob-error-bounce (path errno)
(funcall *error-func* path errno))
(defun glob (pattern &optional error-lambda)
(let* ((glob-foreign-struct (allocate-shallow 'glob-t))
(*error-func* error-lambda)
(result (glob-ll pattern 0
(if error-lambda #'glob-error-bounce)
glob-foreign-struct)))
(prog1 (glob-t-gl-pathv (foreign-value glob-foreign-struct))
(glob-free-ll glob-foreign-struct)
(foreign-free glob-foreign-struct))))
Kaz Kylheku wrote:
> After this experiment, I have a hunch that that the platform glue in
> mcvs can be rewritten purely in FFI code, eliminating the need to do
> any C compiling and linking.
Done!
I now have a version of Meta-CVS which builds and runs with no C
compiling and custom linking at all. You don't need any dev tools other
than an installation of CLISP.
On the downside, it's tied to the glibc2 ABI. For instance, to stat a
filesystem object, it calls the libc.so.6 ``secret'' entry point
"__xstat64". The structure that is used is field-for-field compatible
with glibc's "struct stat64", which has padding fields, and special
extensions like nanoseconds fields on the time stamps.
The install script is super simple. Just load everything, spit out a
mem image, and generate the script to invoke clisp with that mem image.
The mcvs-upgrade tool is gone. I wasn't able to use :EXECUTABLE T in
SAVEINITMEM, because this feature is slightly braindamaged. If you pass
arguments to the resulting program, they are processed as CLISP
arguments! Oops.