\f
/* the jump buffer data structure */
-static int scm_tc16_jmpbuffer;
+static scm_bits_t tc16_jmpbuffer;
-#define SCM_JMPBUFP(OBJ) (SCM_NIMP(OBJ) && (SCM_TYP16(OBJ) == scm_tc16_jmpbuffer))
+#define SCM_JMPBUFP(OBJ) SCM_TYP16_PREDICATE (tc16_jmpbuffer, OBJ)
-#define JBACTIVE(OBJ) (SCM_CELL_WORD_0 (OBJ) & (1L << 16L))
-#define ACTIVATEJB(OBJ) (SCM_SETOR_CAR (OBJ, (1L << 16L)))
-#define DEACTIVATEJB(OBJ) (SCM_SETAND_CAR (OBJ, ~(1L << 16L)))
+#define JBACTIVE(OBJ) (SCM_CELL_WORD_0 (OBJ) & (1L << 16L))
+#define ACTIVATEJB(OBJ) (SCM_SETOR_CAR (OBJ, (1L << 16L)))
+#define DEACTIVATEJB(OBJ) (SCM_SETAND_CAR (OBJ, ~(1L << 16L)))
#define JBJMPBUF(OBJ) ((jmp_buf *) SCM_CELL_WORD_1 (OBJ))
#define SETJBJMPBUF(x,v) (SCM_SET_CELL_WORD_1 ((x), (v)))
#endif
static int
-printjb (SCM exp, SCM port, scm_print_state *pstate)
+jmpbuffer_print (SCM exp, SCM port, scm_print_state *pstate)
{
scm_puts ("#<jmpbuffer ", port);
scm_puts (JBACTIVE(exp) ? "(active) " : "(inactive) ", port);
scm_intprint((long) JBJMPBUF (exp), 16, port);
-
scm_putc ('>', port);
return 1 ;
}
-
static SCM
make_jmpbuf (void)
{
SCM_REDEFER_INTS;
{
#ifdef DEBUG_EXTENSIONS
- SCM_NEWSMOB2 (answer, scm_tc16_jmpbuffer, 0, 0);
+ SCM_NEWSMOB2 (answer, tc16_jmpbuffer, 0, 0);
#else
- SCM_NEWSMOB (answer, scm_tc16_jmpbuffer, 0);
+ SCM_NEWSMOB (answer, tc16_jmpbuffer, 0);
#endif
SETJBJMPBUF(answer, (jmp_buf *)0);
DEACTIVATEJB(answer);
/* scm_internal_lazy_catch (the guts of lazy catching) */
/* The smob tag for lazy_catch smobs. */
-static long tc16_lazy_catch;
+static scm_bits_t tc16_lazy_catch;
/* This is the structure we put on the wind list for a lazy catch. It
stores the handler function to call, and the data pointer to pass
appear in normal data structures, only in the wind list. However,
it might be nice for debugging someday... */
static int
-print_lazy_catch (SCM closure, SCM port, scm_print_state *pstate)
+lazy_catch_print (SCM closure, SCM port, scm_print_state *pstate)
{
struct lazy_catch *c = (struct lazy_catch *) SCM_CELL_WORD_1 (closure);
char buf[200];
SCM_RETURN_NEWSMOB (tc16_lazy_catch, c);
}
-#define SCM_LAZY_CATCH_P(obj) (SCM_SMOB_PREDICATE (tc16_lazy_catch, obj))
+#define SCM_LAZY_CATCH_P(obj) (SCM_TYP16_PREDICATE (tc16_lazy_catch, obj))
/* Exactly like scm_internal_catch, except:
scm_display_backtrace (stack, p, SCM_UNDEFINED, SCM_UNDEFINED);
scm_newline (p);
}
- scm_display_error (stack, p, subr, message, parts, rest);
+ scm_i_display_error (stack, p, subr, message, parts, rest);
}
else
{
message header to print; if zero, we use "guile" instead. That
text is followed by a colon, then the message described by ARGS. */
+/* Dirk:FIXME:: The name of the function should make clear that the
+ * application gets terminated.
+ */
+
SCM
scm_handle_by_message (void *handler_data, SCM tag, SCM args)
{
- if (SCM_NFALSEP (scm_eq_p (tag, SCM_CAR (scm_intern0 ("quit")))))
+ if (SCM_NFALSEP (scm_eq_p (tag, scm_str2symbol ("quit"))))
{
exit (scm_exit_status (args));
}
handler_message (handler_data, tag, args);
- /* try to flush the error message first before the rest of the
- ports: if any throw error, it currently causes a bus
- exception. */
exit (2);
}
/* Search the wind list for an appropriate catch.
"Waiter, please bring us the wind list." */
- for (winds = scm_dynwinds; SCM_NIMP (winds); winds = SCM_CDR (winds))
+ for (winds = scm_dynwinds; SCM_CONSP (winds); winds = SCM_CDR (winds))
{
- if (! SCM_CONSP (winds))
- abort ();
-
dynpair = SCM_CAR (winds);
if (SCM_CONSP (dynpair))
{
}
}
- /* If we didn't find anything, abort. scm_boot_guile should
- have established a catch-all, but obviously things are
- thoroughly screwed up. */
- if (SCM_NULLP (winds))
- abort ();
+#ifdef __GNUC__
+ /* Dirk:FIXME:: This bugfix should be removed some time. */
+ /* GCC 2.95.2 has a bug in its optimizer that makes it generate
+ incorrect code sometimes. This barrier stops it from being too
+ clever. */
+ asm volatile ("" : "=g" (winds));
+#endif
- /* If the wind list is malformed, bail. */
- if (SCM_IMP (winds) || SCM_NCONSP (winds))
- abort ();
-
- if (!SCM_FALSEP (dynpair))
- jmpbuf = SCM_CDR (dynpair);
- else
+ /* If we didn't find anything, print a message and abort the process
+ right here. If you don't want this, establish a catch-all around
+ any code that might throw up. */
+ if (SCM_NULLP (winds))
{
- if (!noreturn)
- return SCM_UNSPECIFIED;
- else
- {
- scm_exitval = scm_cons (key, args);
- scm_dowinds (SCM_EOL, scm_ilength (scm_dynwinds));
-#ifdef DEBUG_EXTENSIONS
- scm_last_debug_frame = SCM_DFRAME (scm_rootcont);
-#endif
- longjmp (SCM_JMPBUF (scm_rootcont), 1);
- }
+ scm_handle_by_message (NULL, key, args);
+ abort ();
}
+ /* If the wind list is malformed, bail. */
+ if (!SCM_CONSP (winds))
+ abort ();
+
+ jmpbuf = SCM_CDR (dynpair);
+
for (wind_goal = scm_dynwinds;
!SCM_EQ_P (SCM_CDAR (wind_goal), jmpbuf);
wind_goal = SCM_CDR (wind_goal))
void
scm_init_throw ()
{
- scm_tc16_jmpbuffer = scm_make_smob_type_mfpe ("jmpbuffer",
- 0,
- NULL, /* mark */
- NULL,
- printjb,
- NULL);
-
- tc16_lazy_catch = scm_make_smob_type_mfpe ("lazy-catch", 0,
- NULL,
- NULL,
- print_lazy_catch,
- NULL);
+ tc16_jmpbuffer = scm_make_smob_type ("jmpbuffer", 0);
+ scm_set_smob_print (tc16_jmpbuffer, jmpbuffer_print);
+
+ tc16_lazy_catch = scm_make_smob_type ("lazy-catch", 0);
+ scm_set_smob_print (tc16_lazy_catch, lazy_catch_print);
+
+#ifndef SCM_MAGIC_SNARFER
#include "libguile/throw.x"
+#endif
}
/*