Integration with setjmp/longjmp.

Defining libpng bindings, with longjmp catching, is
now possible.

* autoload.c (ffi_set_entries): Add setjmp symbol, which is
a new macro in stdlib/ffi.tl.

* ffi.c (jmp_buf_s): New symbol variable.
(mk_jmp_buf, rt_setjmp, longjmp_wrap): New functions.
(ffi_init): Initialize jmp_buf_s. Register
sys:rt-setjmp and longjmp intrinsics.

* ffi.h (jmp_buf_s): Declared.

* stdlib/ffi.h (setjmp): New macro. Rather than introducing
a new special operator, we use a run-time support function
called sys:rt-setjmp, which takes functional arguments.

* unwind.[ch] (uw_snapshot, uw_restore): New functions.
The rt_setjmp function needs these to restore our unwind
frame stack into a sane state after catching a longjmp,
which bails without unwinding it, leaving the pointers
referring to frames that no longer exist.

* tests/017/setjmp.tl,
* tests/017/setjmp.expected: New files.

* txr.1: Documented.

2 files changed, 50 insertions, 0 deletions

diff --git a/tests/017/setjmp.expected b/tests/017/setjmp.expected
new file mode 100644
index 00000000..3d7a5493
--- /dev/null
+++ b/tests/017/setjmp.expected
@@ -0,0 +1,4 @@
+setjmp
+result 42
+libpng longjmp
+libpng error 42
diff --git a/tests/017/setjmp.tl b/tests/017/setjmp.tl
new file mode 100644
index 00000000..6cb64b5a
--- /dev/null
+++ b/tests/017/setjmp.tl
@@ -0,0 +1,46 @@
+;; test local setjmp
+(let ((jb (jmp-buf)))
+  (setjmp jb result
+    (progn (put-line "setjmp")
+           (longjmp jb 42))
+    (put-line `result @result`)))
+
+(defun png-fake-output ()
+  (put-string "libpng longjmp\nlibpng error 42\n")
+  (exit))
+
+(unless (ignerr (dlopen "libpng.so"))
+  (png-fake-output))
+
+;; needed by png-set-longjmp-fn API
+(defvarl libc (dlopen nil))
+(defvarl longjmp-addr (dlsym libc "longjmp"))
+
+(typedef png-structp (cptr png))
+
+(with-dyn-lib "libpng.so"
+  (deffi png-get-header-ver "png_get_header_ver" str (png-structp))
+  (deffi png-create-read-struct "png_create_read_struct" png-structp (str cptr cptr cptr))
+  (deffi png-set-longjmp-fn "png_set_longjmp_fn" (carray uchar) (png-structp (cptr dlsym) size-t))
+  (deffi png-longjmp "png_longjmp" void (png-structp int)))
+
+(defvar png-ver (png-get-header-ver cptr-null))
+
+;; In the png.h header, png_setjmp is a macro only; you cannot
+;; #undef it to get to a function. So we write the macro in
+;; the same way as a Lisp macro, in terms of png-set-longjmp-fn,
+;; whereby we pass the longjmp function, and sizeof (jmp_buf).
+(defmacro png-setjmp (png-ptr)
+  (let ((jmpbuf-size (load-time (len (jmp-buf)))))
+    ^(png-set-longjmp-fn ,png-ptr longjmp-addr ,jmpbuf-size)))
+
+;;; Test
+
+;; get png handle
+(defvar png (png-create-read-struct png-ver cptr-null cptr-null cptr-null))
+
+;; get jmp_buf from png handle, setjmp it, longjmp to it.
+(setjmp (png-setjmp png) err
+  (progn (put-line "libpng longjmp")
+         (png-longjmp png 42))
+  (put-line `libpng error @err`))