diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2023-09-27 21:08:08 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2023-09-27 21:08:08 -0700 |
commit | 9b5c23e7c88535f49dfbc8d5028ff5c82704435a (patch) | |
tree | 2974d99914ef067c7f7f8ca4e27d830410248b39 /tests/017/setjmp.tl | |
parent | f1c442b84179092d93b42fbf629fe7337bf177ba (diff) | |
download | txr-9b5c23e7c88535f49dfbc8d5028ff5c82704435a.tar.gz txr-9b5c23e7c88535f49dfbc8d5028ff5c82704435a.tar.bz2 txr-9b5c23e7c88535f49dfbc8d5028ff5c82704435a.zip |
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.
Diffstat (limited to 'tests/017/setjmp.tl')
-rw-r--r-- | tests/017/setjmp.tl | 46 |
1 files changed, 46 insertions, 0 deletions
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`)) |