/* Copyright 2009-2024 * Kaz Kylheku * Vancouver, Canada * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions are met: * * 1. Redistributions of source code must retain the above copyright notice, * this list of conditions and the following disclaimer. * * 2. Redistributions in binary form must reproduce the above copyright notice, * this list of conditions and the following disclaimer in the documentation * and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE * POSSIBILITY OF SUCH DAMAGE. */ #if __i386__ struct jmp { unsigned eip; unsigned esp; unsigned ebp; unsigned ebx; unsigned esi; unsigned edi; }; #elif __x86_64__ struct jmp { unsigned long rip; unsigned long rsp; unsigned long rbp; unsigned long rbx; unsigned long r12; unsigned long r13; unsigned long r14; unsigned long r15; #if __CYGWIN__ unsigned long rsi; unsigned long rdi; #endif }; #elif __arm__ && !__thumb__ struct jmp { unsigned long r4; unsigned long r5; unsigned long r6; unsigned long r7; unsigned long r8; unsigned long r9; unsigned long r10; unsigned long fp; unsigned long sp; unsigned long lr; }; #elif __arm__ && __thumb__ struct jmp { unsigned long lr; unsigned long r4; unsigned long r5; unsigned long r6; unsigned long r7; unsigned long r8; unsigned long r9; unsigned long r10; unsigned long fp; unsigned long sp; }; #elif __PPC64__ #if __ALTIVEC__ #define UW_JMP_ALIGN __attribute__ ((aligned (32))) #else #define UW_JMP_ALIGN #endif struct UW_JMP_ALIGN jmp { #if __ALTIVEC__ unsigned long vr31[4]; #endif unsigned long r1; unsigned long r2; unsigned long r11; unsigned long r12; unsigned long r13; unsigned long r14; unsigned long r15; unsigned long r16; unsigned long r17; unsigned long r18; unsigned long r19; unsigned long r20; unsigned long r21; unsigned long r22; unsigned long r23; unsigned long r24; unsigned long r25; unsigned long r26; unsigned long r27; unsigned long r28; unsigned long r29; unsigned long r30; unsigned long r31; }; #elif __aarch64__ struct jmp { unsigned long x19; unsigned long x20; unsigned long x21; unsigned long x22; unsigned long x23; unsigned long x24; unsigned long x25; unsigned long x26; unsigned long x27; unsigned long x28; unsigned long x29; unsigned long x30; unsigned long d8; unsigned long d9; unsigned long d10; unsigned long d11; unsigned long d12; unsigned long d13; unsigned long d14; unsigned long d15; unsigned long x16; }; /* Jump buffer contains: x19-x28, x29(fp), x30(lr), (x31)sp, d8-d15. Other registers are not saved. */ #elif __mips__ struct jmp { unsigned long s0; /* $16 */ unsigned long s1; /* ... */ unsigned long s2; unsigned long s3; unsigned long s4; unsigned long s5; unsigned long s6; /* ... */ unsigned long s8; /* $23 */ unsigned long gp; /* $28 */ unsigned long sp; /* $29 */ unsigned long fp; /* $30 */ unsigned long ra; /* $31 */ }; #elif __riscv struct jmp { unsigned long ra; /* x1 */ unsigned long sp; /* x2 */ unsigned long fp; /* x8 */ unsigned long s1; /* x9 */ unsigned long s2; /* x18 */ unsigned long s3; /* x19 */ unsigned long s4; /* x20 */ unsigned long s5; /* x21 */ unsigned long s6; /* x22 */ unsigned long s7; /* x23 */ unsigned long s8; /* x24 */ unsigned long s9; /* x25 */ unsigned long s10; /* x26 */ unsigned long s11; /* x27 */ #if 0 && !__riscv_float_abi_soft double fs0; /* f8 */ double fs1; /* f9 */ double fs2; /* f18 */ double fs3; /* f19 */ double fs4; /* f20 */ double fs5; /* f21 */ double fs6; /* f22 */ double fs7; /* f23 */ double fs8; /* f24 */ double fs9; /* f25 */ double fs10; /* f26 */ double fs11; /* f27 */ #endif }; #elif __loongarch64 struct jmp { unsigned long ra; unsigned long sp; unsigned long fp; unsigned long s0; unsigned long s1; unsigned long s2; unsigned long s3; unsigned long s4; unsigned long s5; unsigned long s6; unsigned long s7; unsigned long s8; #if 0 && !__loongarch64_soft_float double fs0; double fs1; double fs2; double fs3; double fs4; double fs5; double fs6; double fs7; #endif }; #else #error port me! #endif #ifdef __cplusplus extern "C" { #endif int jmp_save(struct jmp *); NORETURN void jmp_restore(struct jmp *, int); #ifdef __cplusplus } #endif #if CONFIG_DEBUG_SUPPORT #define EJ_DBG_MEMB int ds; #else #define EJ_DBG_MEMB #endif #define EJ_OPT_MEMB EJ_DBG_MEMB #if HAVE_POSIX_SIGS typedef struct { struct jmp jb; volatile sig_atomic_t se; volatile small_sigset_t blocked; volatile val de; volatile int gc; val **volatile gc_pt; EJ_OPT_MEMB volatile int rv; } extended_jmp_buf; #else typedef struct { struct jmp jb; volatile val de; volatile int gc; val **volatile gc_pt; EJ_OPT_MEMB volatile int rv; } extended_jmp_buf; #endif #define extended_setjmp(EJB) \ (jmp_save(&(EJB).jb) \ ? ((EJB).rv) \ : (extjmp_save(&(EJB)), 0)) #define extended_longjmp(EJB, ARG) \ ((EJB).rv = (ARG), extjmp_restore(&(EJB)), jmp_restore(&(EJB).jb, 1)) void extjmp_save(extended_jmp_buf *ejb); void extjmp_restore(extended_jmp_buf *); typedef union uw_frame uw_frame_t; typedef enum uw_frtype { UW_BLOCK, UW_CAPTURED_BLOCK, UW_MENV, UW_CATCH, UW_HANDLE, UW_CONT_COPY, UW_GUARD, #if CONFIG_DEBUG_SUPPORT UW_FCALL, UW_EVAL, UW_EXPAND #endif } uw_frtype_t; struct uw_common { uw_frame_t *up; uw_frtype_t type; }; struct uw_block { uw_frame_t *up; uw_frtype_t type; val tag; val result; val protocol; mem_t *cont_bottom; extended_jmp_buf jb; }; struct uw_dynamic_env { uw_frame_t *up; uw_frtype_t type; uw_frame_t *up_env; val func_bindings; val match_context; }; struct uw_catch { uw_frame_t *up; uw_frtype_t type; val matches; int visible; val sym; val args; val desc; uw_frame_t *cont; extended_jmp_buf jb; }; struct uw_handler { uw_frame_t *up; uw_frtype_t type; val matches; /* Same position as in uw_catch! */ int visible; /* Likewise. */ val fun; val package, package_alist; }; struct uw_cont_copy { uw_frame_t *up; uw_frtype_t type; mem_t *ptr; void (*copy)(mem_t *ptr); }; struct uw_guard { uw_frame_t *up; uw_frtype_t type; int uw_ok; }; #if CONFIG_DEBUG_SUPPORT struct uw_fcall { uw_frame_t *up; uw_frtype_t type; val fun; struct args *args; }; struct uw_eval { uw_frame_t *up; uw_frtype_t type; val form; val env; }; #endif #if __aarch64__ || (__clang__ && __amd64__) #define UW_FRAME_ALIGN __attribute__ ((aligned (16))) #else #define UW_FRAME_ALIGN #endif union uw_frame { struct uw_common uw; struct uw_block bl; struct uw_dynamic_env ev; struct uw_catch ca; struct uw_handler ha; struct uw_cont_copy cp; struct uw_guard gu; #if CONFIG_DEBUG_SUPPORT struct uw_fcall fc; struct uw_eval el; #endif } UW_FRAME_ALIGN; typedef struct { val de; uw_frame_t *stack; uw_frame_t *menv_stack; } uw_snapshot_t; extern val catch_frame_s; uw_snapshot_t uw_snapshot(void); void uw_restore(const uw_snapshot_t *); void uw_push_block(uw_frame_t *, val tag); void uw_push_match_env(uw_frame_t *); val uw_get_func(val sym); val uw_set_func(val sym, val value); val uw_get_match_context(void); val uw_set_match_context(val context); val uw_block_return_proto(val tag, val result, val protocol); INLINE val uw_block_return(val tag, val result) { return uw_block_return_proto(tag, result, nil); } val uw_block_abscond(val tag, val result); void uw_push_catch(uw_frame_t *, val matches); void uw_push_handler(uw_frame_t *, val matches, val fun); #if CONFIG_DEBUG_SUPPORT void uw_push_fcall(uw_frame_t *, val fun, struct args *args); void uw_push_eval(uw_frame_t *, val form, val env); void uw_push_expand(uw_frame_t *, val form, val env); #endif val uw_rthrow(val sym, val exception); val uw_rthrowv(val sym, struct args *); val uw_rthrowfv(val sym, val fmt, struct args *); NORETURN val uw_throw(val sym, val exception); NORETURN val uw_throwf(val sym, val fmt, ...); NORETURN val uw_ethrowf(val sym, val fmt, ...); NORETURN val uw_errorfv(val fmt, struct args *args); val uw_warningf(val fmt, ...); val uw_defer_warning(val args); val uw_warning_exists(val tag); val uw_dump_deferred_warnings(val stream); val uw_release_deferred_warnings(void); val uw_purge_deferred_warning(val tag); val uw_register_tentative_def(val tag); val uw_tentative_def_exists(val tag); val uw_register_subtype(val sub, val super); val uw_exception_subtype_p(val sub, val sup); void uw_continue(uw_frame_t *target); void uw_push_guard(uw_frame_t *, int uw_ok); void uw_pop_frame(uw_frame_t *); void uw_pop_block(uw_frame_t *, val *pret); void uw_pop_until(uw_frame_t *); uw_frame_t *uw_current_frame(void); uw_frame_t *uw_current_exit_point(void); val uw_get_frames(void); val uw_find_frame(val extype, val frtype); val uw_find_frames(val extype, val frtype); #if CONFIG_DEBUG_SUPPORT val uw_find_frames_by_mask(val mask); val uw_last_form_expanded(void); #else #define uw_last_form_expanded() nil #endif val uw_invoke_catch(val catch_frame, val sym, struct args *); val uw_muffle_warning(val exc, struct args *); val uw_trace_error(val ctx, val exc, struct args *); val uw_capture_cont(val tag, val fun, val ctx_form); void uw_push_cont_copy(uw_frame_t *, mem_t *ptr, void (*copy)(mem_t *ptr)); void uw_init(void); void uw_late_init(void); NORETURN val type_mismatch(val, ...); NORETURN void invalid_ops(val self, val obj1, val obj2); NORETURN void invalid_op(val self, val obj); #define uw_mark_frame \ uw_frame_t *uw_top = uw_current_frame() #define uw_fast_return(VAL) \ do { \ uw_pop_until(uw_top); \ return VAL; \ } while (0) #define uw_block_beg(TAG, RESULTVAR) \ do { \ uw_frame_t uw_blk; \ obj_t **uw_rslt = &RESULTVAR; \ uw_push_block(&uw_blk, TAG); \ if (extended_setjmp(uw_blk.bl.jb)) { \ RESULTVAR = uw_blk.bl.result; \ } else { \ enum { dummy ## __LINE__ } #define uw_block_begin(TAG, RESULTVAR) \ obj_t *RESULTVAR = nil; \ do { \ uw_frame_t uw_blk; \ obj_t **uw_rslt = &RESULTVAR; \ uw_push_block(&uw_blk, TAG); \ if (extended_setjmp(uw_blk.bl.jb)) { \ RESULTVAR = uw_blk.bl.result; \ } else { \ enum { dummy ## __LINE__ } #define uw_block_end \ } \ uw_pop_block(&uw_blk, uw_rslt); \ } while (0) #define uw_match_env_begin \ do { \ uw_frame_t uw_env; \ uw_push_match_env(&uw_env); \ { \ enum { dummy ## __LINE__ } #define uw_match_env_end \ } \ uw_pop_frame(&uw_env); \ } while (0) #define uw_simple_catch_begin \ do { \ uw_frame_t uw_catch; \ uw_push_catch(&uw_catch, nil); \ switch (extended_setjmp(uw_catch.ca.jb)) { \ case 0: #define uw_catch_begin(MATCHES, SYMVAR, \ EXCVAR) \ do { \ obj_t *SYMVAR = nil; \ obj_t *EXCVAR = nil; \ uw_frame_t uw_catch; \ uw_push_catch(&uw_catch, MATCHES); \ switch (extended_setjmp(uw_catch.ca.jb)) { \ case 0: #define uw_catch_begin_w_desc(MATCHES, SYMVAR, \ EXCVAR, DESC) \ do { \ obj_t *SYMVAR = nil; \ obj_t *EXCVAR = nil; \ uw_frame_t uw_catch; \ uw_push_catch(&uw_catch, MATCHES); \ uw_catch.ca.desc = (DESC); \ switch (extended_setjmp(uw_catch.ca.jb)) { \ case 0: #define uw_catch(SYMVAR, EXCVAR) \ goto uw_unwind_label; \ break; \ case 2: \ EXCVAR = uw_catch.ca.args; \ SYMVAR = uw_catch.ca.sym; \ (void) SYMVAR; \ /* prevent looping */ \ uw_catch.ca.matches = nil; #define uw_unwind \ /* suppress unused label warning */ \ goto uw_unwind_label; \ uw_unwind_label: \ case 1: \ /* prevent looping */ \ uw_catch.ca.visible = 0; #define uw_curr_exit_point \ (uw_catch.ca.cont) #define uw_catch_end \ break; \ default: \ abort(); \ } \ uw_pop_frame(&uw_catch); \ if (uw_catch.ca.cont) \ uw_continue(uw_catch.ca.cont); \ } while(0) #define internal_error(STR) \ do { \ extern obj_t *num(cnum); \ uw_throwf(internal_error_s, \ lit("~a:~a ~a"), \ lit(__FILE__), \ num(__LINE__), lit(STR), \ nao); \ } while (0) #define panic(STR) \ do { \ extern obj_t *num(cnum); \ uw_throwf(panic_s, \ lit("~a:~a ~a"), \ lit(__FILE__), \ num(__LINE__), lit(STR), \ nao); \ } while (0) #define type_assert(EXPR, ARGS) \ if (!(EXPR)) type_mismatch ARGS #define bug_unless(EXPR) \ if (!(EXPR)) \ internal_error("assertion " \ #EXPR \ " failed") #define ignerr_func_body(type, init, expr, \ stream, prefix) \ val (_s_y_m_s) = cons(error_s, nil); \ type (_r_e_t) = (init); \ uw_frame_t _h_n_d; \ uw_catch_begin (_s_y_m_s, _e_x, _e_x_a); \ uw_push_handler(&_h_n_d, _s_y_m_s, \ func_f1v(cons(stream, prefix), \ uw_trace_error)); \ _r_e_t = expr; \ uw_pop_frame(&_h_n_d); \ uw_catch(_e_x, _e_x_a); \ (void) _e_x_a; \ uw_unwind { } \ uw_catch_end; \ return _r_e_t; #define ignerr_begin \ uw_catch_begin (cons(error_s, nil), _x_s_y_m, _x_a_r_g_s) #define ignerr_end \ uw_catch(_x_s_y_m, _x_a_r_g_s) \ (void) _x_s_y_m; (void) _x_a_r_g_s; \ uw_unwind { } \ uw_catch_end