static lref_t *find_matching_escape(lref_t *start_frame, lref_t tag) { if (CURRENT_TIB()->escape_frame != NULL) start_frame = fstack_prev_frame(CURRENT_TIB()->escape_frame); dscwritef(DF_SHOW_THROWS, (_T("; DEBUG: looking for escape tag ~a\n"), tag)); for(lref_t *frame = start_frame; frame != NULL; frame = fstack_prev_frame(frame)) { if (fstack_frame_type(frame) != FRAME_ESCAPE) continue; lref_t ftag = frame[FOFS_ESCAPE_TAG]; dscwritef(DF_SHOW_THROWS, (_T("; DEBUG: frame: ~c&, tag ~a\n"), frame, ftag)); if (NULLP(ftag) || EQ(ftag, tag)) { return frame; } } dscwritef(DF_SHOW_THROWS, (_T("; DEBUG: No escape frame for tag ~a\n"), tag)); return NULL; }
void unwind_stack_for_throw() { for(lref_t *frame = CURRENT_TIB()->frame; frame != NULL; frame = fstack_prev_frame(frame)) { if (fstack_frame_type(frame) == FRAME_UNWIND) { dscwritef(DF_SHOW_THROWS, (_T("; DEBUG: throw invoking unwind, frame: ~c&\n"), frame)); apply1(frame[FOFS_UNWIND_AFTER], 0, NULL); continue; } if (fstack_frame_type(frame) != FRAME_ESCAPE) continue; if (frame == CURRENT_TIB()->escape_frame) { jmp_buf *jmpbuf = (jmp_buf *)frame[FOFS_ESCAPE_JMPBUF_PTR]; dscwritef(DF_SHOW_THROWS, (_T("; DEBUG: longjmp to frame: ~c&, jmpbuf: ~c&\n"), frame, jmpbuf)); CURRENT_TIB()->escape_frame = NULL; CURRENT_TIB()->frame = (lref_t *)frame[FOFS_ESCAPE_FRAME]; CURRENT_TIB()->fsp = CURRENT_TIB()->frame + 1; longjmp(*jmpbuf, 1); } } }
void unwind_stack_for_throw() { for(lref_t *frame = CURRENT_TIB()->frame; frame != NULL; frame = fstack_prev_frame(frame)) { if (fstack_frame_type(frame) == FRAME_UNWIND) { dscwritef(DF_SHOW_THROWS, (_T("; DEBUG: throw invoking unwind : ~c&\n"), frame)); apply1(frame[FOFS_UNWIND_AFTER], 0, NULL); continue; } if (fstack_frame_type(frame) != FRAME_ESCAPE) continue; if (frame == CURRENT_TIB()->escape_frame) { dscwritef(DF_SHOW_THROWS, (_T("; DEBUG: setjmp (from fsp=~c&) to target frame: ~c&\n"), CURRENT_TIB()->fsp, frame)); CURRENT_TIB()->escape_frame = NULL; CURRENT_TIB()->frame = (lref_t *)frame[FOFS_ESCAPE_FRAME]; CURRENT_TIB()->fsp = CURRENT_TIB()->frame + 1; longjmp((struct __jmp_buf_tag *)frame[FOFS_ESCAPE_JMPBUF_PTR], 1); } } }
lref_t topmost_primitive() { for(lref_t *frame = CURRENT_TIB()->frame; frame != NULL; frame = fstack_prev_frame(frame)) { if (fstack_frame_type(frame) == FRAME_SUBR) return frame[FOFS_SUBR_SUBR]; } return NIL; }