From: Mark H Weaver Date: Mon, 12 Aug 2013 02:46:22 +0000 (-0400) Subject: Merge remote-tracking branch 'origin/stable-2.0' X-Git-Url: https://git.hcoop.net/bpt/guile.git/commitdiff_plain/1160e2d94e6a53e4509f81ff08798655db9cae26?hp=-c Merge remote-tracking branch 'origin/stable-2.0' --- 1160e2d94e6a53e4509f81ff08798655db9cae26 diff --combined libguile/foreign.c index db8e13127,01af90019..76e43f3ad --- a/libguile/foreign.c +++ b/libguile/foreign.c @@@ -65,6 -65,16 +65,6 @@@ SCM_SYMBOL (sym_null_pointer_error, "nu /* The cell representing the null pointer. */ static SCM null_pointer; -#if SIZEOF_VOID_P == 4 -# define scm_to_uintptr scm_to_uint32 -# define scm_from_uintptr scm_from_uint32 -#elif SIZEOF_VOID_P == 8 -# define scm_to_uintptr scm_to_uint64 -# define scm_from_uintptr scm_from_uint64 -#else -# error unsupported pointer size -#endif - /* Raise a null pointer dereference error. */ static void @@@ -79,19 -89,22 +79,19 @@@ static SCM cif_to_procedure (SCM cif, S static SCM pointer_weak_refs = SCM_BOOL_F; -static scm_i_pthread_mutex_t weak_refs_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER; static void register_weak_reference (SCM from, SCM to) { - scm_i_pthread_mutex_lock (&weak_refs_lock); - scm_hashq_set_x (pointer_weak_refs, from, to); - scm_i_pthread_mutex_unlock (&weak_refs_lock); + scm_weak_table_putq_x (pointer_weak_refs, from, to); } static void pointer_finalizer_trampoline (void *ptr, void *data) { scm_t_pointer_finalizer finalizer = data; - finalizer (SCM_POINTER_VALUE (PTR2SCM (ptr))); + finalizer (SCM_POINTER_VALUE (SCM_PACK_POINTER (ptr))); } SCM_DEFINE (scm_pointer_p, "pointer?", 1, 0, 0, @@@ -115,7 -128,7 +115,7 @@@ SCM_DEFINE (scm_make_pointer, "make-poi void *c_finalizer; scm_t_uintptr c_address; - c_address = scm_to_uintptr (address); + c_address = scm_to_uintptr_t (address); if (SCM_UNBNDP (finalizer)) c_finalizer = NULL; else @@@ -163,7 -176,7 +163,7 @@@ SCM_DEFINE (scm_pointer_address, "point { SCM_VALIDATE_POINTER (1, pointer); - return scm_from_uintptr ((scm_t_uintptr) SCM_POINTER_VALUE (pointer)); + return scm_from_uintptr_t ((scm_t_uintptr) SCM_POINTER_VALUE (pointer)); } #undef FUNC_NAME @@@ -188,7 -201,7 +188,7 @@@ SCM_DEFINE (scm_scm_to_pointer, "scm->p SCM ret; ret = scm_from_pointer ((void*) SCM_UNPACK (scm), NULL); - if (SCM_NIMP (ret)) + if (SCM_HEAP_OBJECT_P (ret)) register_weak_reference (ret, scm); return ret; @@@ -260,8 -273,8 +260,8 @@@ SCM_DEFINE (scm_pointer_to_bytevector, blen = scm_to_size_t (len); ret = scm_c_take_typed_bytevector ((signed char *) ptr + boffset, - blen, btype); - register_weak_reference (ret, pointer); + blen, btype, pointer); + return ret; } #undef FUNC_NAME @@@ -313,9 -326,9 +313,9 @@@ SCM_DEFINE (scm_set_pointer_finalizer_x void scm_i_pointer_print (SCM pointer, SCM port, scm_print_state *pstate) { - scm_puts ("#', port); + scm_puts_unlocked ("#', port); } @@@ -329,9 -342,15 +329,15 @@@ SCM_DEFINE (scm_dereference_pointer, "d "holds a pointer, return this pointer.") #define FUNC_NAME s_scm_dereference_pointer { + void **ptr; + SCM_VALIDATE_POINTER (1, pointer); - return scm_from_pointer (* (void **) SCM_POINTER_VALUE (pointer), NULL); + ptr = SCM_POINTER_VALUE (pointer); + if (SCM_UNLIKELY (ptr == NULL)) + null_pointer_error (FUNC_NAME); + + return scm_from_pointer (*ptr, NULL); } #undef FUNC_NAME @@@ -528,14 -547,13 +534,14 @@@ SCM_DEFINE (scm_sizeof, "sizeof", 1, 0 { /* a struct */ size_t off = 0; + size_t align = scm_to_size_t (scm_alignof(type)); while (scm_is_pair (type)) { off = ROUND_UP (off, scm_to_size_t (scm_alignof (scm_car (type)))); off += scm_to_size_t (scm_sizeof (scm_car (type))); type = scm_cdr (type); } - return scm_from_size_t (off); + return scm_from_size_t (ROUND_UP(off, align)); } else scm_wrong_type_arg (FUNC_NAME, 1, type); @@@ -822,7 -840,7 +828,7 @@@ make_objcode_trampoline (unsigned int n if (i != size) scm_syserror ("make_objcode_trampoline"); - return scm_bytecode_to_native_objcode (bytecode); + return scm_bytecode_to_objcode (bytecode, SCM_UNDEFINED); } #undef GEN_CODE @@@ -1153,7 -1171,7 +1159,7 @@@ invoke_closure (ffi_cif *cif, void *ret size_t i; SCM proc, *argv, result; - proc = PTR2SCM (data); + proc = SCM_PACK_POINTER (data); argv = alloca (cif->nargs * sizeof (*argv)); @@@ -1184,7 -1202,7 +1190,7 @@@ SCM_DEFINE (scm_procedure_to_pointer, " closure = ffi_closure_alloc (sizeof (ffi_closure), &executable); err = ffi_prep_closure_loc ((ffi_closure *) closure, cif, - invoke_closure, SCM2PTR (proc), + invoke_closure, SCM_UNPACK_POINTER (proc), executable); if (err != FFI_OK) { @@@ -1350,7 -1368,7 +1356,7 @@@ scm_register_foreign (void "scm_init_foreign", (scm_t_extension_init_func)scm_init_foreign, NULL); - pointer_weak_refs = scm_make_weak_key_hash_table (SCM_UNDEFINED); + pointer_weak_refs = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY); } /* diff --combined libguile/numbers.c index 3cdc7fd16,6f3a6ec46..b5bce2308 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@@ -48,6 -48,7 +48,7 @@@ #endif #include + #include #include #include @@@ -213,7 -214,7 +214,7 @@@ finalize_bignum (void *ptr, void *data { SCM bignum; - bignum = PTR2SCM (ptr); + bignum = SCM_PACK_POINTER (ptr); mpz_clear (SCM_I_BIG_MPZ (bignum)); } @@@ -650,7 -651,7 +651,7 @@@ scm_i_from_double (double val { SCM z; - z = PTR2SCM (scm_gc_malloc_pointerless (sizeof (scm_t_double), "real")); + z = SCM_PACK_POINTER (scm_gc_malloc_pointerless (sizeof (scm_t_double), "real")); SCM_SET_CELL_TYPE (z, scm_tc16_real); SCM_REAL_VALUE (z) = val; @@@ -669,7 -670,7 +670,7 @@@ SCM_PRIMITIVE_GENERIC (scm_exact_p, "ex else if (SCM_NUMBERP (x)) return SCM_BOOL_T; else - SCM_WTA_DISPATCH_1 (g_scm_exact_p, x, 1, s_scm_exact_p); + return scm_wta_dispatch_1 (g_scm_exact_p, x, 1, s_scm_exact_p); } #undef FUNC_NAME @@@ -690,7 -691,7 +691,7 @@@ SCM_PRIMITIVE_GENERIC (scm_inexact_p, " else if (SCM_NUMBERP (x)) return SCM_BOOL_F; else - SCM_WTA_DISPATCH_1 (g_scm_inexact_p, x, 1, s_scm_inexact_p); + return scm_wta_dispatch_1 (g_scm_inexact_p, x, 1, s_scm_inexact_p); } #undef FUNC_NAME @@@ -729,7 -730,7 +730,7 @@@ SCM_PRIMITIVE_GENERIC (scm_odd_p, "odd? return SCM_BOOL_F; } } - SCM_WTA_DISPATCH_1 (g_scm_odd_p, n, 1, s_scm_odd_p); + return scm_wta_dispatch_1 (g_scm_odd_p, n, 1, s_scm_odd_p); } #undef FUNC_NAME @@@ -763,7 -764,7 +764,7 @@@ SCM_PRIMITIVE_GENERIC (scm_even_p, "eve return SCM_BOOL_T; } } - SCM_WTA_DISPATCH_1 (g_scm_even_p, n, 1, s_scm_even_p); + return scm_wta_dispatch_1 (g_scm_even_p, n, 1, s_scm_even_p); } #undef FUNC_NAME @@@ -778,7 -779,7 +779,7 @@@ SCM_PRIMITIVE_GENERIC (scm_finite_p, "f else if (scm_is_real (x)) return SCM_BOOL_T; else - SCM_WTA_DISPATCH_1 (g_scm_finite_p, x, 1, s_scm_finite_p); + return scm_wta_dispatch_1 (g_scm_finite_p, x, 1, s_scm_finite_p); } #undef FUNC_NAME @@@ -793,7 -794,7 +794,7 @@@ SCM_PRIMITIVE_GENERIC (scm_inf_p, "inf? else if (scm_is_real (x)) return SCM_BOOL_F; else - SCM_WTA_DISPATCH_1 (g_scm_inf_p, x, 1, s_scm_inf_p); + return scm_wta_dispatch_1 (g_scm_inf_p, x, 1, s_scm_inf_p); } #undef FUNC_NAME @@@ -808,7 -809,7 +809,7 @@@ SCM_PRIMITIVE_GENERIC (scm_nan_p, "nan? else if (scm_is_real (x)) return SCM_BOOL_F; else - SCM_WTA_DISPATCH_1 (g_scm_nan_p, x, 1, s_scm_nan_p); + return scm_wta_dispatch_1 (g_scm_nan_p, x, 1, s_scm_nan_p); } #undef FUNC_NAME @@@ -936,7 -937,7 +937,7 @@@ SCM_PRIMITIVE_GENERIC (scm_abs, "abs", SCM_FRACTION_DENOMINATOR (x)); } else - SCM_WTA_DISPATCH_1 (g_scm_abs, x, 1, s_scm_abs); + return scm_wta_dispatch_1 (g_scm_abs, x, 1, s_scm_abs); } #undef FUNC_NAME @@@ -951,10 -952,10 +952,10 @@@ SCM_PRIMITIVE_GENERIC (scm_quotient, "q if (SCM_LIKELY (scm_is_integer (y))) return scm_truncate_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_quotient, x, y, SCM_ARG2, s_scm_quotient); + return scm_wta_dispatch_2 (g_scm_quotient, x, y, SCM_ARG2, s_scm_quotient); } else - SCM_WTA_DISPATCH_2 (g_scm_quotient, x, y, SCM_ARG1, s_scm_quotient); + return scm_wta_dispatch_2 (g_scm_quotient, x, y, SCM_ARG1, s_scm_quotient); } #undef FUNC_NAME @@@ -972,10 -973,10 +973,10 @@@ SCM_PRIMITIVE_GENERIC (scm_remainder, " if (SCM_LIKELY (scm_is_integer (y))) return scm_truncate_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_remainder, x, y, SCM_ARG2, s_scm_remainder); + return scm_wta_dispatch_2 (g_scm_remainder, x, y, SCM_ARG2, s_scm_remainder); } else - SCM_WTA_DISPATCH_2 (g_scm_remainder, x, y, SCM_ARG1, s_scm_remainder); + return scm_wta_dispatch_2 (g_scm_remainder, x, y, SCM_ARG1, s_scm_remainder); } #undef FUNC_NAME @@@ -994,10 -995,10 +995,10 @@@ SCM_PRIMITIVE_GENERIC (scm_modulo, "mod if (SCM_LIKELY (scm_is_integer (y))) return scm_floor_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_modulo, x, y, SCM_ARG2, s_scm_modulo); + return scm_wta_dispatch_2 (g_scm_modulo, x, y, SCM_ARG2, s_scm_modulo); } else - SCM_WTA_DISPATCH_2 (g_scm_modulo, x, y, SCM_ARG1, s_scm_modulo); + return scm_wta_dispatch_2 (g_scm_modulo, x, y, SCM_ARG1, s_scm_modulo); } #undef FUNC_NAME @@@ -1096,9 -1097,10 +1097,9 @@@ static voi two_valued_wta_dispatch_2 (SCM gf, SCM a1, SCM a2, int pos, const char *subr, SCM *rp1, SCM *rp2) { - if (SCM_UNPACK (gf)) - scm_i_extract_values_2 (scm_call_generic_2 (gf, a1, a2), rp1, rp2); - else - scm_wrong_type_arg (subr, pos, (pos == SCM_ARG1) ? a1 : a2); + SCM vals = scm_wta_dispatch_2 (gf, a1, a2, pos, subr); + + scm_i_extract_values_2 (vals, rp1, rp2); } SCM_DEFINE (scm_euclidean_quotient, "euclidean-quotient", 2, 0, 0, @@@ -1230,8 -1232,8 +1231,8 @@@ SCM_PRIMITIVE_GENERIC (scm_floor_quotie else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_floor_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG2, - s_scm_floor_quotient); + return scm_wta_dispatch_2 (g_scm_floor_quotient, x, y, SCM_ARG2, + s_scm_floor_quotient); } else if (SCM_BIGP (x)) { @@@ -1271,8 -1273,8 +1272,8 @@@ else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_floor_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG2, - s_scm_floor_quotient); + return scm_wta_dispatch_2 (g_scm_floor_quotient, x, y, SCM_ARG2, + s_scm_floor_quotient); } else if (SCM_REALP (x)) { @@@ -1281,8 -1283,8 +1282,8 @@@ return scm_i_inexact_floor_quotient (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG2, - s_scm_floor_quotient); + return scm_wta_dispatch_2 (g_scm_floor_quotient, x, y, SCM_ARG2, + s_scm_floor_quotient); } else if (SCM_FRACTIONP (x)) { @@@ -1292,12 -1294,12 +1293,12 @@@ else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_floor_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG2, - s_scm_floor_quotient); + return scm_wta_dispatch_2 (g_scm_floor_quotient, x, y, SCM_ARG2, + s_scm_floor_quotient); } else - SCM_WTA_DISPATCH_2 (g_scm_floor_quotient, x, y, SCM_ARG1, - s_scm_floor_quotient); + return scm_wta_dispatch_2 (g_scm_floor_quotient, x, y, SCM_ARG1, + s_scm_floor_quotient); } #undef FUNC_NAME @@@ -1390,8 -1392,8 +1391,8 @@@ SCM_PRIMITIVE_GENERIC (scm_floor_remain else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_floor_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG2, - s_scm_floor_remainder); + return scm_wta_dispatch_2 (g_scm_floor_remainder, x, y, SCM_ARG2, + s_scm_floor_remainder); } else if (SCM_BIGP (x)) { @@@ -1426,8 -1428,8 +1427,8 @@@ else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_floor_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG2, - s_scm_floor_remainder); + return scm_wta_dispatch_2 (g_scm_floor_remainder, x, y, SCM_ARG2, + s_scm_floor_remainder); } else if (SCM_REALP (x)) { @@@ -1436,8 -1438,8 +1437,8 @@@ return scm_i_inexact_floor_remainder (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG2, - s_scm_floor_remainder); + return scm_wta_dispatch_2 (g_scm_floor_remainder, x, y, SCM_ARG2, + s_scm_floor_remainder); } else if (SCM_FRACTIONP (x)) { @@@ -1447,12 -1449,12 +1448,12 @@@ else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_floor_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG2, - s_scm_floor_remainder); + return scm_wta_dispatch_2 (g_scm_floor_remainder, x, y, SCM_ARG2, + s_scm_floor_remainder); } else - SCM_WTA_DISPATCH_2 (g_scm_floor_remainder, x, y, SCM_ARG1, - s_scm_floor_remainder); + return scm_wta_dispatch_2 (g_scm_floor_remainder, x, y, SCM_ARG1, + s_scm_floor_remainder); } #undef FUNC_NAME @@@ -1763,8 -1765,8 +1764,8 @@@ SCM_PRIMITIVE_GENERIC (scm_ceiling_quot else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_ceiling_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, - s_scm_ceiling_quotient); + return scm_wta_dispatch_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, + s_scm_ceiling_quotient); } else if (SCM_BIGP (x)) { @@@ -1804,8 -1806,8 +1805,8 @@@ else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_ceiling_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, - s_scm_ceiling_quotient); + return scm_wta_dispatch_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, + s_scm_ceiling_quotient); } else if (SCM_REALP (x)) { @@@ -1814,8 -1816,8 +1815,8 @@@ return scm_i_inexact_ceiling_quotient (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, - s_scm_ceiling_quotient); + return scm_wta_dispatch_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, + s_scm_ceiling_quotient); } else if (SCM_FRACTIONP (x)) { @@@ -1825,12 -1827,12 +1826,12 @@@ else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_ceiling_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, - s_scm_ceiling_quotient); + return scm_wta_dispatch_2 (g_scm_ceiling_quotient, x, y, SCM_ARG2, + s_scm_ceiling_quotient); } else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_quotient, x, y, SCM_ARG1, - s_scm_ceiling_quotient); + return scm_wta_dispatch_2 (g_scm_ceiling_quotient, x, y, SCM_ARG1, + s_scm_ceiling_quotient); } #undef FUNC_NAME @@@ -1933,8 -1935,8 +1934,8 @@@ SCM_PRIMITIVE_GENERIC (scm_ceiling_rema else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_ceiling_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, - s_scm_ceiling_remainder); + return scm_wta_dispatch_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, + s_scm_ceiling_remainder); } else if (SCM_BIGP (x)) { @@@ -1969,8 -1971,8 +1970,8 @@@ else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_ceiling_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, - s_scm_ceiling_remainder); + return scm_wta_dispatch_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, + s_scm_ceiling_remainder); } else if (SCM_REALP (x)) { @@@ -1979,8 -1981,8 +1980,8 @@@ return scm_i_inexact_ceiling_remainder (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, - s_scm_ceiling_remainder); + return scm_wta_dispatch_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, + s_scm_ceiling_remainder); } else if (SCM_FRACTIONP (x)) { @@@ -1990,12 -1992,12 +1991,12 @@@ else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_ceiling_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, - s_scm_ceiling_remainder); + return scm_wta_dispatch_2 (g_scm_ceiling_remainder, x, y, SCM_ARG2, + s_scm_ceiling_remainder); } else - SCM_WTA_DISPATCH_2 (g_scm_ceiling_remainder, x, y, SCM_ARG1, - s_scm_ceiling_remainder); + return scm_wta_dispatch_2 (g_scm_ceiling_remainder, x, y, SCM_ARG1, + s_scm_ceiling_remainder); } #undef FUNC_NAME @@@ -2295,8 -2297,8 +2296,8 @@@ SCM_PRIMITIVE_GENERIC (scm_truncate_quo else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_truncate_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, - s_scm_truncate_quotient); + return scm_wta_dispatch_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, + s_scm_truncate_quotient); } else if (SCM_BIGP (x)) { @@@ -2336,8 -2338,8 +2337,8 @@@ else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_truncate_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, - s_scm_truncate_quotient); + return scm_wta_dispatch_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, + s_scm_truncate_quotient); } else if (SCM_REALP (x)) { @@@ -2346,8 -2348,8 +2347,8 @@@ return scm_i_inexact_truncate_quotient (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, - s_scm_truncate_quotient); + return scm_wta_dispatch_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, + s_scm_truncate_quotient); } else if (SCM_FRACTIONP (x)) { @@@ -2357,12 -2359,12 +2358,12 @@@ else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_truncate_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, - s_scm_truncate_quotient); + return scm_wta_dispatch_2 (g_scm_truncate_quotient, x, y, SCM_ARG2, + s_scm_truncate_quotient); } else - SCM_WTA_DISPATCH_2 (g_scm_truncate_quotient, x, y, SCM_ARG1, - s_scm_truncate_quotient); + return scm_wta_dispatch_2 (g_scm_truncate_quotient, x, y, SCM_ARG1, + s_scm_truncate_quotient); } #undef FUNC_NAME @@@ -2430,8 -2432,8 +2431,8 @@@ SCM_PRIMITIVE_GENERIC (scm_truncate_rem else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_truncate_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, - s_scm_truncate_remainder); + return scm_wta_dispatch_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, + s_scm_truncate_remainder); } else if (SCM_BIGP (x)) { @@@ -2464,8 -2466,8 +2465,8 @@@ else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_truncate_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, - s_scm_truncate_remainder); + return scm_wta_dispatch_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, + s_scm_truncate_remainder); } else if (SCM_REALP (x)) { @@@ -2474,8 -2476,8 +2475,8 @@@ return scm_i_inexact_truncate_remainder (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, - s_scm_truncate_remainder); + return scm_wta_dispatch_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, + s_scm_truncate_remainder); } else if (SCM_FRACTIONP (x)) { @@@ -2485,12 -2487,12 +2486,12 @@@ else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_truncate_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, - s_scm_truncate_remainder); + return scm_wta_dispatch_2 (g_scm_truncate_remainder, x, y, SCM_ARG2, + s_scm_truncate_remainder); } else - SCM_WTA_DISPATCH_2 (g_scm_truncate_remainder, x, y, SCM_ARG1, - s_scm_truncate_remainder); + return scm_wta_dispatch_2 (g_scm_truncate_remainder, x, y, SCM_ARG1, + s_scm_truncate_remainder); } #undef FUNC_NAME @@@ -2777,8 -2779,8 +2778,8 @@@ SCM_PRIMITIVE_GENERIC (scm_centered_quo else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_centered_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG2, - s_scm_centered_quotient); + return scm_wta_dispatch_2 (g_scm_centered_quotient, x, y, SCM_ARG2, + s_scm_centered_quotient); } else if (SCM_BIGP (x)) { @@@ -2826,8 -2828,8 +2827,8 @@@ else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_centered_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG2, - s_scm_centered_quotient); + return scm_wta_dispatch_2 (g_scm_centered_quotient, x, y, SCM_ARG2, + s_scm_centered_quotient); } else if (SCM_REALP (x)) { @@@ -2836,8 -2838,8 +2837,8 @@@ return scm_i_inexact_centered_quotient (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG2, - s_scm_centered_quotient); + return scm_wta_dispatch_2 (g_scm_centered_quotient, x, y, SCM_ARG2, + s_scm_centered_quotient); } else if (SCM_FRACTIONP (x)) { @@@ -2847,12 -2849,12 +2848,12 @@@ else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_centered_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG2, - s_scm_centered_quotient); + return scm_wta_dispatch_2 (g_scm_centered_quotient, x, y, SCM_ARG2, + s_scm_centered_quotient); } else - SCM_WTA_DISPATCH_2 (g_scm_centered_quotient, x, y, SCM_ARG1, - s_scm_centered_quotient); + return scm_wta_dispatch_2 (g_scm_centered_quotient, x, y, SCM_ARG1, + s_scm_centered_quotient); } #undef FUNC_NAME @@@ -2991,8 -2993,8 +2992,8 @@@ SCM_PRIMITIVE_GENERIC (scm_centered_rem else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_centered_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG2, - s_scm_centered_remainder); + return scm_wta_dispatch_2 (g_scm_centered_remainder, x, y, SCM_ARG2, + s_scm_centered_remainder); } else if (SCM_BIGP (x)) { @@@ -3032,8 -3034,8 +3033,8 @@@ else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_centered_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG2, - s_scm_centered_remainder); + return scm_wta_dispatch_2 (g_scm_centered_remainder, x, y, SCM_ARG2, + s_scm_centered_remainder); } else if (SCM_REALP (x)) { @@@ -3042,8 -3044,8 +3043,8 @@@ return scm_i_inexact_centered_remainder (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG2, - s_scm_centered_remainder); + return scm_wta_dispatch_2 (g_scm_centered_remainder, x, y, SCM_ARG2, + s_scm_centered_remainder); } else if (SCM_FRACTIONP (x)) { @@@ -3053,12 -3055,12 +3054,12 @@@ else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_centered_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG2, - s_scm_centered_remainder); + return scm_wta_dispatch_2 (g_scm_centered_remainder, x, y, SCM_ARG2, + s_scm_centered_remainder); } else - SCM_WTA_DISPATCH_2 (g_scm_centered_remainder, x, y, SCM_ARG1, - s_scm_centered_remainder); + return scm_wta_dispatch_2 (g_scm_centered_remainder, x, y, SCM_ARG1, + s_scm_centered_remainder); } #undef FUNC_NAME @@@ -3473,8 -3475,8 +3474,8 @@@ SCM_PRIMITIVE_GENERIC (scm_round_quotie else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_round_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG2, - s_scm_round_quotient); + return scm_wta_dispatch_2 (g_scm_round_quotient, x, y, SCM_ARG2, + s_scm_round_quotient); } else if (SCM_BIGP (x)) { @@@ -3524,8 -3526,8 +3525,8 @@@ else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_round_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG2, - s_scm_round_quotient); + return scm_wta_dispatch_2 (g_scm_round_quotient, x, y, SCM_ARG2, + s_scm_round_quotient); } else if (SCM_REALP (x)) { @@@ -3534,8 -3536,8 +3535,8 @@@ return scm_i_inexact_round_quotient (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG2, - s_scm_round_quotient); + return scm_wta_dispatch_2 (g_scm_round_quotient, x, y, SCM_ARG2, + s_scm_round_quotient); } else if (SCM_FRACTIONP (x)) { @@@ -3545,12 -3547,12 +3546,12 @@@ else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_round_quotient (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG2, - s_scm_round_quotient); + return scm_wta_dispatch_2 (g_scm_round_quotient, x, y, SCM_ARG2, + s_scm_round_quotient); } else - SCM_WTA_DISPATCH_2 (g_scm_round_quotient, x, y, SCM_ARG1, - s_scm_round_quotient); + return scm_wta_dispatch_2 (g_scm_round_quotient, x, y, SCM_ARG1, + s_scm_round_quotient); } #undef FUNC_NAME @@@ -3677,8 -3679,8 +3678,8 @@@ SCM_PRIMITIVE_GENERIC (scm_round_remain else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_round_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG2, - s_scm_round_remainder); + return scm_wta_dispatch_2 (g_scm_round_remainder, x, y, SCM_ARG2, + s_scm_round_remainder); } else if (SCM_BIGP (x)) { @@@ -3725,8 -3727,8 +3726,8 @@@ else if (SCM_FRACTIONP (y)) return scm_i_exact_rational_round_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG2, - s_scm_round_remainder); + return scm_wta_dispatch_2 (g_scm_round_remainder, x, y, SCM_ARG2, + s_scm_round_remainder); } else if (SCM_REALP (x)) { @@@ -3735,8 -3737,8 +3736,8 @@@ return scm_i_inexact_round_remainder (SCM_REAL_VALUE (x), scm_to_double (y)); else - SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG2, - s_scm_round_remainder); + return scm_wta_dispatch_2 (g_scm_round_remainder, x, y, SCM_ARG2, + s_scm_round_remainder); } else if (SCM_FRACTIONP (x)) { @@@ -3746,12 -3748,12 +3747,12 @@@ else if (SCM_I_INUMP (y) || SCM_BIGP (y) || SCM_FRACTIONP (y)) return scm_i_exact_rational_round_remainder (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG2, - s_scm_round_remainder); + return scm_wta_dispatch_2 (g_scm_round_remainder, x, y, SCM_ARG2, + s_scm_round_remainder); } else - SCM_WTA_DISPATCH_2 (g_scm_round_remainder, x, y, SCM_ARG1, - s_scm_round_remainder); + return scm_wta_dispatch_2 (g_scm_round_remainder, x, y, SCM_ARG1, + s_scm_round_remainder); } #undef FUNC_NAME @@@ -4143,7 -4145,7 +4144,7 @@@ scm_gcd (SCM x, SCM y else if (SCM_REALP (y) && scm_is_integer (y)) goto handle_inexacts; else - SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG2, s_gcd); + return scm_wta_dispatch_2 (g_gcd, x, y, SCM_ARG2, s_gcd); } else if (SCM_BIGP (x)) { @@@ -4175,7 -4177,7 +4176,7 @@@ else if (SCM_REALP (y) && scm_is_integer (y)) goto handle_inexacts; else - SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG2, s_gcd); + return scm_wta_dispatch_2 (g_gcd, x, y, SCM_ARG2, s_gcd); } else if (SCM_REALP (x) && scm_is_integer (x)) { @@@ -4187,10 -4189,10 +4188,10 @@@ scm_inexact_to_exact (y))); } else - SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG2, s_gcd); + return scm_wta_dispatch_2 (g_gcd, x, y, SCM_ARG2, s_gcd); } else - SCM_WTA_DISPATCH_2 (g_gcd, x, y, SCM_ARG1, s_gcd); + return scm_wta_dispatch_2 (g_gcd, x, y, SCM_ARG1, s_gcd); } SCM_PRIMITIVE_GENERIC (scm_i_lcm, "lcm", 0, 2, 1, @@@ -4244,7 -4246,7 +4245,7 @@@ scm_lcm (SCM n1, SCM n2 else if (SCM_REALP (n2) && scm_is_integer (n2)) goto handle_inexacts; else - SCM_WTA_DISPATCH_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm); + return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm); } else if (SCM_LIKELY (SCM_BIGP (n1))) { @@@ -4267,7 -4269,7 +4268,7 @@@ else if (SCM_REALP (n2) && scm_is_integer (n2)) goto handle_inexacts; else - SCM_WTA_DISPATCH_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm); + return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm); } else if (SCM_REALP (n1) && scm_is_integer (n1)) { @@@ -4279,10 -4281,10 +4280,10 @@@ scm_inexact_to_exact (n2))); } else - SCM_WTA_DISPATCH_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm); + return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG2, s_lcm); } else - SCM_WTA_DISPATCH_2 (g_lcm, n1, n2, SCM_ARG1, s_lcm); + return scm_wta_dispatch_2 (g_lcm, n1, n2, SCM_ARG1, s_lcm); } /* Emulating 2's complement bignums with sign magnitude arithmetic: @@@ -5004,7 -5006,7 +5005,7 @@@ left_shift_exact_integer (SCM n, long c return result; } else - scm_syserror ("left_shift_exact_integer"); + assert (0); } /* Efficiently compute floor (N / 2^COUNT), @@@ -5030,7 -5032,7 +5031,7 @@@ floor_right_shift_exact_integer (SCM n return scm_i_normbig (result); } else - scm_syserror ("floor_right_shift_exact_integer"); + assert (0); } /* Efficiently compute round (N / 2^COUNT), @@@ -5068,7 -5070,7 +5069,7 @@@ round_right_shift_exact_integer (SCM n return scm_i_normbig (q); } else - scm_syserror ("round_right_shift_exact_integer"); + assert (0); } SCM_DEFINE (scm_ash, "ash", 2, 0, 0, @@@ -5682,7 -5684,7 +5683,7 @@@ in scm_print_real (SCM sexp, SCM port, scm_print_state *pstate SCM_UNUSED) { char num_buf[FLOBUFLEN]; - scm_lfwrite (num_buf, iflo2str (sexp, num_buf, 10), port); + scm_lfwrite_unlocked (num_buf, iflo2str (sexp, num_buf, 10), port); return !0; } @@@ -5690,7 -5692,7 +5691,7 @@@ voi scm_i_print_double (double val, SCM port) { char num_buf[FLOBUFLEN]; - scm_lfwrite (num_buf, idbl2str (val, num_buf, 10), port); + scm_lfwrite_unlocked (num_buf, idbl2str (val, num_buf, 10), port); } int @@@ -5698,7 -5700,7 +5699,7 @@@ scm_print_complex (SCM sexp, SCM port, { char num_buf[FLOBUFLEN]; - scm_lfwrite (num_buf, iflo2str (sexp, num_buf, 10), port); + scm_lfwrite_unlocked (num_buf, iflo2str (sexp, num_buf, 10), port); return !0; } @@@ -5706,7 -5708,7 +5707,7 @@@ voi scm_i_print_complex (double real, double imag, SCM port) { char num_buf[FLOBUFLEN]; - scm_lfwrite (num_buf, icmplx2str (real, imag, num_buf, 10), port); + scm_lfwrite_unlocked (num_buf, icmplx2str (real, imag, num_buf, 10), port); } int @@@ -5727,7 -5729,7 +5728,7 @@@ scm_bigprint (SCM exp, SCM port, scm_pr void (*freefunc) (void *, size_t); mp_get_memory_functions (NULL, NULL, &freefunc); scm_remember_upto_here_1 (exp); - scm_lfwrite (str, len, port); + scm_lfwrite_unlocked (str, len, port); freefunc (str, len + 1); return !0; } @@@ -6199,7 -6201,7 +6200,7 @@@ mem2ureal (SCM mem, unsigned int *p_idx } /* We should never get here */ - scm_syserror ("mem2ureal"); + assert (0); } @@@ -6596,8 -6598,7 +6597,8 @@@ scm_num_eq_p (SCM x, SCM y else if (SCM_FRACTIONP (y)) return SCM_BOOL_F; else - SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p); + return scm_wta_dispatch_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, + s_scm_i_num_eq_p); } else if (SCM_BIGP (x)) { @@@ -6632,8 -6633,7 +6633,8 @@@ else if (SCM_FRACTIONP (y)) return SCM_BOOL_F; else - SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p); + return scm_wta_dispatch_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, + s_scm_i_num_eq_p); } else if (SCM_REALP (x)) { @@@ -6668,8 -6668,7 +6669,8 @@@ goto again; } else - SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p); + return scm_wta_dispatch_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, + s_scm_i_num_eq_p); } else if (SCM_COMPLEXP (x)) { @@@ -6712,8 -6711,7 +6713,8 @@@ goto again; } else - SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p); + return scm_wta_dispatch_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, + s_scm_i_num_eq_p); } else if (SCM_FRACTIONP (x)) { @@@ -6743,12 -6741,10 +6744,12 @@@ else if (SCM_FRACTIONP (y)) return scm_i_fraction_equalp (x, y); else - SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, s_scm_i_num_eq_p); + return scm_wta_dispatch_2 (g_scm_i_num_eq_p, x, y, SCM_ARGn, + s_scm_i_num_eq_p); } else - SCM_WTA_DISPATCH_2 (g_scm_i_num_eq_p, x, y, SCM_ARG1, s_scm_i_num_eq_p); + return scm_wta_dispatch_2 (g_scm_i_num_eq_p, x, y, SCM_ARG1, + s_scm_i_num_eq_p); } @@@ -6825,8 -6821,7 +6826,8 @@@ scm_less_p (SCM x, SCM y goto again; } else - SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, s_scm_i_num_less_p); + return scm_wta_dispatch_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, + s_scm_i_num_less_p); } else if (SCM_BIGP (x)) { @@@ -6854,8 -6849,7 +6855,8 @@@ else if (SCM_FRACTIONP (y)) goto int_frac; else - SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, s_scm_i_num_less_p); + return scm_wta_dispatch_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, + s_scm_i_num_less_p); } else if (SCM_REALP (x)) { @@@ -6901,8 -6895,7 +6902,8 @@@ goto again; } else - SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, s_scm_i_num_less_p); + return scm_wta_dispatch_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, + s_scm_i_num_less_p); } else if (SCM_FRACTIONP (x)) { @@@ -6935,12 -6928,10 +6936,12 @@@ goto again; } else - SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, s_scm_i_num_less_p); + return scm_wta_dispatch_2 (g_scm_i_num_less_p, x, y, SCM_ARGn, + s_scm_i_num_less_p); } else - SCM_WTA_DISPATCH_2 (g_scm_i_num_less_p, x, y, SCM_ARG1, s_scm_i_num_less_p); + return scm_wta_dispatch_2 (g_scm_i_num_less_p, x, y, SCM_ARG1, + s_scm_i_num_less_p); } @@@ -6969,9 -6960,9 +6970,9 @@@ SC scm_gr_p (SCM x, SCM y) { if (!SCM_NUMBERP (x)) - SCM_WTA_DISPATCH_2 (g_scm_i_num_gr_p, x, y, SCM_ARG1, FUNC_NAME); + return scm_wta_dispatch_2 (g_scm_i_num_gr_p, x, y, SCM_ARG1, FUNC_NAME); else if (!SCM_NUMBERP (y)) - SCM_WTA_DISPATCH_2 (g_scm_i_num_gr_p, x, y, SCM_ARG2, FUNC_NAME); + return scm_wta_dispatch_2 (g_scm_i_num_gr_p, x, y, SCM_ARG2, FUNC_NAME); else return scm_less_p (y, x); } @@@ -7003,9 -6994,9 +7004,9 @@@ SC scm_leq_p (SCM x, SCM y) { if (!SCM_NUMBERP (x)) - SCM_WTA_DISPATCH_2 (g_scm_i_num_leq_p, x, y, SCM_ARG1, FUNC_NAME); + return scm_wta_dispatch_2 (g_scm_i_num_leq_p, x, y, SCM_ARG1, FUNC_NAME); else if (!SCM_NUMBERP (y)) - SCM_WTA_DISPATCH_2 (g_scm_i_num_leq_p, x, y, SCM_ARG2, FUNC_NAME); + return scm_wta_dispatch_2 (g_scm_i_num_leq_p, x, y, SCM_ARG2, FUNC_NAME); else if (scm_is_true (scm_nan_p (x)) || scm_is_true (scm_nan_p (y))) return SCM_BOOL_F; else @@@ -7039,9 -7030,9 +7040,9 @@@ SC scm_geq_p (SCM x, SCM y) { if (!SCM_NUMBERP (x)) - SCM_WTA_DISPATCH_2 (g_scm_i_num_geq_p, x, y, SCM_ARG1, FUNC_NAME); + return scm_wta_dispatch_2 (g_scm_i_num_geq_p, x, y, SCM_ARG1, FUNC_NAME); else if (!SCM_NUMBERP (y)) - SCM_WTA_DISPATCH_2 (g_scm_i_num_geq_p, x, y, SCM_ARG2, FUNC_NAME); + return scm_wta_dispatch_2 (g_scm_i_num_geq_p, x, y, SCM_ARG2, FUNC_NAME); else if (scm_is_true (scm_nan_p (x)) || scm_is_true (scm_nan_p (y))) return SCM_BOOL_F; else @@@ -7068,7 -7059,7 +7069,7 @@@ SCM_PRIMITIVE_GENERIC (scm_zero_p, "zer else if (SCM_FRACTIONP (z)) return SCM_BOOL_F; else - SCM_WTA_DISPATCH_1 (g_scm_zero_p, z, SCM_ARG1, s_scm_zero_p); + return scm_wta_dispatch_1 (g_scm_zero_p, z, SCM_ARG1, s_scm_zero_p); } #undef FUNC_NAME @@@ -7092,7 -7083,7 +7093,7 @@@ SCM_PRIMITIVE_GENERIC (scm_positive_p, else if (SCM_FRACTIONP (x)) return scm_positive_p (SCM_FRACTION_NUMERATOR (x)); else - SCM_WTA_DISPATCH_1 (g_scm_positive_p, x, SCM_ARG1, s_scm_positive_p); + return scm_wta_dispatch_1 (g_scm_positive_p, x, SCM_ARG1, s_scm_positive_p); } #undef FUNC_NAME @@@ -7116,7 -7107,7 +7117,7 @@@ SCM_PRIMITIVE_GENERIC (scm_negative_p, else if (SCM_FRACTIONP (x)) return scm_negative_p (SCM_FRACTION_NUMERATOR (x)); else - SCM_WTA_DISPATCH_1 (g_scm_negative_p, x, SCM_ARG1, s_scm_negative_p); + return scm_wta_dispatch_1 (g_scm_negative_p, x, SCM_ARG1, s_scm_negative_p); } #undef FUNC_NAME @@@ -7150,11 -7141,11 +7151,11 @@@ scm_max (SCM x, SCM y if (SCM_UNBNDP (y)) { if (SCM_UNBNDP (x)) - SCM_WTA_DISPATCH_0 (g_max, s_max); + return scm_wta_dispatch_0 (g_max, s_max); else if (SCM_I_INUMP(x) || SCM_BIGP(x) || SCM_REALP(x) || SCM_FRACTIONP(x)) return x; else - SCM_WTA_DISPATCH_1 (g_max, x, SCM_ARG1, s_max); + return scm_wta_dispatch_1 (g_max, x, SCM_ARG1, s_max); } if (SCM_I_INUMP (x)) @@@ -7193,7 -7184,7 +7194,7 @@@ return (scm_is_false (scm_less_p (x, y)) ? x : y); } else - SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); + return scm_wta_dispatch_2 (g_max, x, y, SCM_ARGn, s_max); } else if (SCM_BIGP (x)) { @@@ -7223,7 -7214,7 +7224,7 @@@ goto use_less; } else - SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); + return scm_wta_dispatch_2 (g_max, x, y, SCM_ARGn, s_max); } else if (SCM_REALP (x)) { @@@ -7277,7 -7268,7 +7278,7 @@@ return (xx < yy) ? scm_i_from_double (yy) : x; } else - SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); + return scm_wta_dispatch_2 (g_max, x, y, SCM_ARGn, s_max); } else if (SCM_FRACTIONP (x)) { @@@ -7300,10 -7291,10 +7301,10 @@@ goto use_less; } else - SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARGn, s_max); + return scm_wta_dispatch_2 (g_max, x, y, SCM_ARGn, s_max); } else - SCM_WTA_DISPATCH_2 (g_max, x, y, SCM_ARG1, s_max); + return scm_wta_dispatch_2 (g_max, x, y, SCM_ARG1, s_max); } @@@ -7330,11 -7321,11 +7331,11 @@@ scm_min (SCM x, SCM y if (SCM_UNBNDP (y)) { if (SCM_UNBNDP (x)) - SCM_WTA_DISPATCH_0 (g_min, s_min); + return scm_wta_dispatch_0 (g_min, s_min); else if (SCM_I_INUMP(x) || SCM_BIGP(x) || SCM_REALP(x) || SCM_FRACTIONP(x)) return x; else - SCM_WTA_DISPATCH_1 (g_min, x, SCM_ARG1, s_min); + return scm_wta_dispatch_1 (g_min, x, SCM_ARG1, s_min); } if (SCM_I_INUMP (x)) @@@ -7363,7 -7354,7 +7364,7 @@@ return (scm_is_false (scm_less_p (x, y)) ? y : x); } else - SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min); + return scm_wta_dispatch_2 (g_min, x, y, SCM_ARGn, s_min); } else if (SCM_BIGP (x)) { @@@ -7393,7 -7384,7 +7394,7 @@@ goto use_less; } else - SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min); + return scm_wta_dispatch_2 (g_min, x, y, SCM_ARGn, s_min); } else if (SCM_REALP (x)) { @@@ -7436,7 -7427,7 +7437,7 @@@ return (yy < xx) ? scm_i_from_double (yy) : x; } else - SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min); + return scm_wta_dispatch_2 (g_min, x, y, SCM_ARGn, s_min); } else if (SCM_FRACTIONP (x)) { @@@ -7459,10 -7450,10 +7460,10 @@@ goto use_less; } else - SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARGn, s_min); + return scm_wta_dispatch_2 (g_min, x, y, SCM_ARGn, s_min); } else - SCM_WTA_DISPATCH_2 (g_min, x, y, SCM_ARG1, s_min); + return scm_wta_dispatch_2 (g_min, x, y, SCM_ARG1, s_min); } @@@ -7491,7 -7482,7 +7492,7 @@@ scm_sum (SCM x, SCM y { if (SCM_NUMBERP (x)) return x; if (SCM_UNBNDP (x)) return SCM_INUM0; - SCM_WTA_DISPATCH_1 (g_sum, x, SCM_ARG1, s_sum); + return scm_wta_dispatch_1 (g_sum, x, SCM_ARG1, s_sum); } if (SCM_LIKELY (SCM_I_INUMP (x))) @@@ -7524,7 -7515,7 +7525,7 @@@ scm_product (x, SCM_FRACTION_DENOMINATOR (y))), SCM_FRACTION_DENOMINATOR (y)); else - SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); + return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum); } else if (SCM_BIGP (x)) { if (SCM_I_INUMP (y)) @@@ -7589,7 -7580,7 +7590,7 @@@ scm_product (x, SCM_FRACTION_DENOMINATOR (y))), SCM_FRACTION_DENOMINATOR (y)); else - SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); + return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum); } else if (SCM_REALP (x)) { @@@ -7609,7 -7600,7 +7610,7 @@@ else if (SCM_FRACTIONP (y)) return scm_i_from_double (SCM_REAL_VALUE (x) + scm_i_fraction2double (y)); else - SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); + return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum); } else if (SCM_COMPLEXP (x)) { @@@ -7633,7 -7624,7 +7634,7 @@@ return scm_c_make_rectangular (SCM_COMPLEX_REAL (x) + scm_i_fraction2double (y), SCM_COMPLEX_IMAG (x)); else - SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); + return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum); } else if (SCM_FRACTIONP (x)) { @@@ -7656,10 -7647,10 +7657,10 @@@ scm_product (SCM_FRACTION_NUMERATOR (y), SCM_FRACTION_DENOMINATOR (x))), scm_product (SCM_FRACTION_DENOMINATOR (x), SCM_FRACTION_DENOMINATOR (y))); else - SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARGn, s_sum); + return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARGn, s_sum); } else - SCM_WTA_DISPATCH_2 (g_sum, x, y, SCM_ARG1, s_sum); + return scm_wta_dispatch_2 (g_sum, x, y, SCM_ARG1, s_sum); } @@@ -7699,7 -7690,7 +7700,7 @@@ scm_difference (SCM x, SCM y if (SCM_UNLIKELY (SCM_UNBNDP (y))) { if (SCM_UNBNDP (x)) - SCM_WTA_DISPATCH_0 (g_difference, s_difference); + return scm_wta_dispatch_0 (g_difference, s_difference); else if (SCM_I_INUMP (x)) { @@@ -7723,7 -7714,7 +7724,7 @@@ (scm_difference (SCM_FRACTION_NUMERATOR (x), SCM_UNDEFINED), SCM_FRACTION_DENOMINATOR (x)); else - SCM_WTA_DISPATCH_1 (g_difference, x, SCM_ARG1, s_difference); + return scm_wta_dispatch_1 (g_difference, x, SCM_ARG1, s_difference); } if (SCM_LIKELY (SCM_I_INUMP (x))) @@@ -7810,7 -7801,7 +7811,7 @@@ SCM_FRACTION_NUMERATOR (y)), SCM_FRACTION_DENOMINATOR (y)); else - SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference); + return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference); } else if (SCM_BIGP (x)) { @@@ -7874,8 -7865,7 +7875,8 @@@ return scm_i_make_ratio (scm_difference (scm_product (x, SCM_FRACTION_DENOMINATOR (y)), SCM_FRACTION_NUMERATOR (y)), SCM_FRACTION_DENOMINATOR (y)); - else SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference); + else + return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference); } else if (SCM_REALP (x)) { @@@ -7895,7 -7885,7 +7896,7 @@@ else if (SCM_FRACTIONP (y)) return scm_i_from_double (SCM_REAL_VALUE (x) - scm_i_fraction2double (y)); else - SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference); + return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference); } else if (SCM_COMPLEXP (x)) { @@@ -7919,7 -7909,7 +7920,7 @@@ return scm_c_make_rectangular (SCM_COMPLEX_REAL (x) - scm_i_fraction2double (y), SCM_COMPLEX_IMAG (x)); else - SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference); + return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference); } else if (SCM_FRACTIONP (x)) { @@@ -7943,10 -7933,10 +7944,10 @@@ scm_product (SCM_FRACTION_NUMERATOR (y), SCM_FRACTION_DENOMINATOR (x))), scm_product (SCM_FRACTION_DENOMINATOR (x), SCM_FRACTION_DENOMINATOR (y))); else - SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARGn, s_difference); + return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARGn, s_difference); } else - SCM_WTA_DISPATCH_2 (g_difference, x, y, SCM_ARG1, s_difference); + return scm_wta_dispatch_2 (g_difference, x, y, SCM_ARG1, s_difference); } #undef FUNC_NAME @@@ -7989,7 -7979,7 +7990,7 @@@ scm_product (SCM x, SCM y else if (SCM_NUMBERP (x)) return x; else - SCM_WTA_DISPATCH_1 (g_product, x, SCM_ARG1, s_product); + return scm_wta_dispatch_1 (g_product, x, SCM_ARG1, s_product); } if (SCM_LIKELY (SCM_I_INUMP (x))) @@@ -8022,7 -8012,7 +8023,7 @@@ else if (SCM_NUMP (y)) return SCM_INUM0; else - SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product); + return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product); break; case -1: /* @@@ -8073,7 -8063,7 +8074,7 @@@ return scm_i_make_ratio (scm_product (x, SCM_FRACTION_NUMERATOR (y)), SCM_FRACTION_DENOMINATOR (y)); else - SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product); + return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product); } else if (SCM_BIGP (x)) { @@@ -8108,7 -8098,7 +8109,7 @@@ return scm_i_make_ratio (scm_product (x, SCM_FRACTION_NUMERATOR (y)), SCM_FRACTION_DENOMINATOR (y)); else - SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product); + return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product); } else if (SCM_REALP (x)) { @@@ -8131,7 -8121,7 +8132,7 @@@ else if (SCM_FRACTIONP (y)) return scm_i_from_double (SCM_REAL_VALUE (x) * scm_i_fraction2double (y)); else - SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product); + return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product); } else if (SCM_COMPLEXP (x)) { @@@ -8164,7 -8154,7 +8165,7 @@@ yy * SCM_COMPLEX_IMAG (x)); } else - SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product); + return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product); } else if (SCM_FRACTIONP (x)) { @@@ -8189,10 -8179,10 +8190,10 @@@ scm_product (SCM_FRACTION_DENOMINATOR (x), SCM_FRACTION_DENOMINATOR (y))); else - SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARGn, s_product); + return scm_wta_dispatch_2 (g_product, x, y, SCM_ARGn, s_product); } else - SCM_WTA_DISPATCH_2 (g_product, x, y, SCM_ARG1, s_product); + return scm_wta_dispatch_2 (g_product, x, y, SCM_ARG1, s_product); } #if ((defined (HAVE_ISINF) && defined (HAVE_ISNAN)) \ @@@ -8256,7 -8246,7 +8257,7 @@@ scm_divide (SCM x, SCM y if (SCM_UNLIKELY (SCM_UNBNDP (y))) { if (SCM_UNBNDP (x)) - SCM_WTA_DISPATCH_0 (g_divide, s_divide); + return scm_wta_dispatch_0 (g_divide, s_divide); else if (SCM_I_INUMP (x)) { scm_t_inum xx = SCM_I_INUM (x); @@@ -8302,7 -8292,7 +8303,7 @@@ return scm_i_make_ratio_already_reduced (SCM_FRACTION_DENOMINATOR (x), SCM_FRACTION_NUMERATOR (x)); else - SCM_WTA_DISPATCH_1 (g_divide, x, SCM_ARG1, s_divide); + return scm_wta_dispatch_1 (g_divide, x, SCM_ARG1, s_divide); } if (SCM_LIKELY (SCM_I_INUMP (x))) @@@ -8371,7 -8361,7 +8372,7 @@@ return scm_i_make_ratio (scm_product (x, SCM_FRACTION_DENOMINATOR (y)), SCM_FRACTION_NUMERATOR (y)); else - SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide); + return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARGn, s_divide); } else if (SCM_BIGP (x)) { @@@ -8453,7 -8443,7 +8454,7 @@@ return scm_i_make_ratio (scm_product (x, SCM_FRACTION_DENOMINATOR (y)), SCM_FRACTION_NUMERATOR (y)); else - SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide); + return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARGn, s_divide); } else if (SCM_REALP (x)) { @@@ -8498,7 -8488,7 +8499,7 @@@ else if (SCM_FRACTIONP (y)) return scm_i_from_double (rx / scm_i_fraction2double (y)); else - SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide); + return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARGn, s_divide); } else if (SCM_COMPLEXP (x)) { @@@ -8565,7 -8555,7 +8566,7 @@@ return scm_c_make_rectangular (rx / yy, ix / yy); } else - SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide); + return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARGn, s_divide); } else if (SCM_FRACTIONP (x)) { @@@ -8610,10 -8600,10 +8611,10 @@@ return scm_i_make_ratio (scm_product (SCM_FRACTION_NUMERATOR (x), SCM_FRACTION_DENOMINATOR (y)), scm_product (SCM_FRACTION_NUMERATOR (y), SCM_FRACTION_DENOMINATOR (x))); else - SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARGn, s_divide); + return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARGn, s_divide); } else - SCM_WTA_DISPATCH_2 (g_divide, x, y, SCM_ARG1, s_divide); + return scm_wta_dispatch_2 (g_divide, x, y, SCM_ARG1, s_divide); } #undef FUNC_NAME @@@ -8679,7 -8669,7 +8680,7 @@@ SCM_PRIMITIVE_GENERIC (scm_truncate_num return scm_truncate_quotient (SCM_FRACTION_NUMERATOR (x), SCM_FRACTION_DENOMINATOR (x)); else - SCM_WTA_DISPATCH_1 (g_scm_truncate_number, x, SCM_ARG1, + return scm_wta_dispatch_1 (g_scm_truncate_number, x, SCM_ARG1, s_scm_truncate_number); } #undef FUNC_NAME @@@ -8699,8 -8689,8 +8700,8 @@@ SCM_PRIMITIVE_GENERIC (scm_round_number return scm_round_quotient (SCM_FRACTION_NUMERATOR (x), SCM_FRACTION_DENOMINATOR (x)); else - SCM_WTA_DISPATCH_1 (g_scm_round_number, x, SCM_ARG1, - s_scm_round_number); + return scm_wta_dispatch_1 (g_scm_round_number, x, SCM_ARG1, + s_scm_round_number); } #undef FUNC_NAME @@@ -8717,7 -8707,7 +8718,7 @@@ SCM_PRIMITIVE_GENERIC (scm_floor, "floo return scm_floor_quotient (SCM_FRACTION_NUMERATOR (x), SCM_FRACTION_DENOMINATOR (x)); else - SCM_WTA_DISPATCH_1 (g_scm_floor, x, 1, s_scm_floor); + return scm_wta_dispatch_1 (g_scm_floor, x, 1, s_scm_floor); } #undef FUNC_NAME @@@ -8734,7 -8724,7 +8735,7 @@@ SCM_PRIMITIVE_GENERIC (scm_ceiling, "ce return scm_ceiling_quotient (SCM_FRACTION_NUMERATOR (x), SCM_FRACTION_DENOMINATOR (x)); else - SCM_WTA_DISPATCH_1 (g_scm_ceiling, x, 1, s_scm_ceiling); + return scm_wta_dispatch_1 (g_scm_ceiling, x, 1, s_scm_ceiling); } #undef FUNC_NAME @@@ -8773,9 -8763,9 +8774,9 @@@ SCM_PRIMITIVE_GENERIC (scm_expt, "expt" else if (scm_is_complex (x) && scm_is_complex (y)) return scm_exp (scm_product (scm_log (x), y)); else if (scm_is_complex (x)) - SCM_WTA_DISPATCH_2 (g_scm_expt, x, y, SCM_ARG2, s_scm_expt); + return scm_wta_dispatch_2 (g_scm_expt, x, y, SCM_ARG2, s_scm_expt); else - SCM_WTA_DISPATCH_2 (g_scm_expt, x, y, SCM_ARG1, s_scm_expt); + return scm_wta_dispatch_2 (g_scm_expt, x, y, SCM_ARG1, s_scm_expt); } #undef FUNC_NAME @@@ -8802,7 -8792,7 +8803,7 @@@ SCM_PRIMITIVE_GENERIC (scm_sin, "sin", cos (x) * sinh (y)); } else - SCM_WTA_DISPATCH_1 (g_scm_sin, z, 1, s_scm_sin); + return scm_wta_dispatch_1 (g_scm_sin, z, 1, s_scm_sin); } #undef FUNC_NAME @@@ -8823,7 -8813,7 +8824,7 @@@ SCM_PRIMITIVE_GENERIC (scm_cos, "cos", -sin (x) * sinh (y)); } else - SCM_WTA_DISPATCH_1 (g_scm_cos, z, 1, s_scm_cos); + return scm_wta_dispatch_1 (g_scm_cos, z, 1, s_scm_cos); } #undef FUNC_NAME @@@ -8848,7 -8838,7 +8849,7 @@@ SCM_PRIMITIVE_GENERIC (scm_tan, "tan", return scm_c_make_rectangular (sin (x) / w, sinh (y) / w); } else - SCM_WTA_DISPATCH_1 (g_scm_tan, z, 1, s_scm_tan); + return scm_wta_dispatch_1 (g_scm_tan, z, 1, s_scm_tan); } #undef FUNC_NAME @@@ -8869,7 -8859,7 +8870,7 @@@ SCM_PRIMITIVE_GENERIC (scm_sinh, "sinh" cosh (x) * sin (y)); } else - SCM_WTA_DISPATCH_1 (g_scm_sinh, z, 1, s_scm_sinh); + return scm_wta_dispatch_1 (g_scm_sinh, z, 1, s_scm_sinh); } #undef FUNC_NAME @@@ -8890,7 -8880,7 +8891,7 @@@ SCM_PRIMITIVE_GENERIC (scm_cosh, "cosh" sinh (x) * sin (y)); } else - SCM_WTA_DISPATCH_1 (g_scm_cosh, z, 1, s_scm_cosh); + return scm_wta_dispatch_1 (g_scm_cosh, z, 1, s_scm_cosh); } #undef FUNC_NAME @@@ -8915,7 -8905,7 +8916,7 @@@ SCM_PRIMITIVE_GENERIC (scm_tanh, "tanh" return scm_c_make_rectangular (sinh (x) / w, sin (y) / w); } else - SCM_WTA_DISPATCH_1 (g_scm_tanh, z, 1, s_scm_tanh); + return scm_wta_dispatch_1 (g_scm_tanh, z, 1, s_scm_tanh); } #undef FUNC_NAME @@@ -8943,7 -8933,7 +8944,7 @@@ SCM_PRIMITIVE_GENERIC (scm_asin, "asin" scm_sys_asinh (scm_c_make_rectangular (-y, x))); } else - SCM_WTA_DISPATCH_1 (g_scm_asin, z, 1, s_scm_asin); + return scm_wta_dispatch_1 (g_scm_asin, z, 1, s_scm_asin); } #undef FUNC_NAME @@@ -8973,7 -8963,7 +8974,7 @@@ SCM_PRIMITIVE_GENERIC (scm_acos, "acos" scm_sys_asinh (scm_c_make_rectangular (-y, x)))); } else - SCM_WTA_DISPATCH_1 (g_scm_acos, z, 1, s_scm_acos); + return scm_wta_dispatch_1 (g_scm_acos, z, 1, s_scm_acos); } #undef FUNC_NAME @@@ -9000,17 -8990,17 +9001,17 @@@ SCM_PRIMITIVE_GENERIC (scm_atan, "atan" scm_c_make_rectangular (0, 2)); } else - SCM_WTA_DISPATCH_1 (g_scm_atan, z, SCM_ARG1, s_scm_atan); + return scm_wta_dispatch_1 (g_scm_atan, z, SCM_ARG1, s_scm_atan); } else if (scm_is_real (z)) { if (scm_is_real (y)) return scm_i_from_double (atan2 (scm_to_double (z), scm_to_double (y))); else - SCM_WTA_DISPATCH_2 (g_scm_atan, z, y, SCM_ARG2, s_scm_atan); + return scm_wta_dispatch_2 (g_scm_atan, z, y, SCM_ARG2, s_scm_atan); } else - SCM_WTA_DISPATCH_2 (g_scm_atan, z, y, SCM_ARG1, s_scm_atan); + return scm_wta_dispatch_2 (g_scm_atan, z, y, SCM_ARG1, s_scm_atan); } #undef FUNC_NAME @@@ -9028,7 -9018,7 +9029,7 @@@ SCM_PRIMITIVE_GENERIC (scm_sys_asinh, " scm_sqrt (scm_sum (scm_product (z, z), SCM_INUM1)))); else - SCM_WTA_DISPATCH_1 (g_scm_sys_asinh, z, 1, s_scm_sys_asinh); + return scm_wta_dispatch_1 (g_scm_sys_asinh, z, 1, s_scm_sys_asinh); } #undef FUNC_NAME @@@ -9046,7 -9036,7 +9047,7 @@@ SCM_PRIMITIVE_GENERIC (scm_sys_acosh, " scm_sqrt (scm_difference (scm_product (z, z), SCM_INUM1)))); else - SCM_WTA_DISPATCH_1 (g_scm_sys_acosh, z, 1, s_scm_sys_acosh); + return scm_wta_dispatch_1 (g_scm_sys_acosh, z, 1, s_scm_sys_acosh); } #undef FUNC_NAME @@@ -9064,7 -9054,7 +9065,7 @@@ SCM_PRIMITIVE_GENERIC (scm_sys_atanh, " scm_difference (SCM_INUM1, z))), SCM_I_MAKINUM (2)); else - SCM_WTA_DISPATCH_1 (g_scm_sys_atanh, z, 1, s_scm_sys_atanh); + return scm_wta_dispatch_1 (g_scm_sys_atanh, z, 1, s_scm_sys_atanh); } #undef FUNC_NAME @@@ -9073,7 -9063,7 +9074,7 @@@ scm_c_make_rectangular (double re, doub { SCM z; - z = PTR2SCM (scm_gc_malloc_pointerless (sizeof (scm_t_complex), + z = SCM_PACK_POINTER (scm_gc_malloc_pointerless (sizeof (scm_t_complex), "complex")); SCM_SET_CELL_TYPE (z, scm_tc16_complex); SCM_COMPLEX_REAL (z) = re; @@@ -9165,7 -9155,7 +9166,7 @@@ SCM_PRIMITIVE_GENERIC (scm_real_part, " else if (SCM_I_INUMP (z) || SCM_BIGP (z) || SCM_REALP (z) || SCM_FRACTIONP (z)) return z; else - SCM_WTA_DISPATCH_1 (g_scm_real_part, z, SCM_ARG1, s_scm_real_part); + return scm_wta_dispatch_1 (g_scm_real_part, z, SCM_ARG1, s_scm_real_part); } #undef FUNC_NAME @@@ -9180,7 -9170,7 +9181,7 @@@ SCM_PRIMITIVE_GENERIC (scm_imag_part, " else if (SCM_I_INUMP (z) || SCM_REALP (z) || SCM_BIGP (z) || SCM_FRACTIONP (z)) return SCM_INUM0; else - SCM_WTA_DISPATCH_1 (g_scm_imag_part, z, SCM_ARG1, s_scm_imag_part); + return scm_wta_dispatch_1 (g_scm_imag_part, z, SCM_ARG1, s_scm_imag_part); } #undef FUNC_NAME @@@ -9194,9 -9184,17 +9195,17 @@@ SCM_PRIMITIVE_GENERIC (scm_numerator, " else if (SCM_FRACTIONP (z)) return SCM_FRACTION_NUMERATOR (z); else if (SCM_REALP (z)) - return scm_exact_to_inexact (scm_numerator (scm_inexact_to_exact (z))); + { + double zz = SCM_REAL_VALUE (z); + if (zz == floor (zz)) + /* Handle -0.0 and infinities in accordance with R6RS + flnumerator, and optimize handling of integers. */ + return z; + else + return scm_exact_to_inexact (scm_numerator (scm_inexact_to_exact (z))); + } else - SCM_WTA_DISPATCH_1 (g_scm_numerator, z, SCM_ARG1, s_scm_numerator); + return scm_wta_dispatch_1 (g_scm_numerator, z, SCM_ARG1, s_scm_numerator); } #undef FUNC_NAME @@@ -9211,10 -9209,17 +9220,18 @@@ SCM_PRIMITIVE_GENERIC (scm_denominator else if (SCM_FRACTIONP (z)) return SCM_FRACTION_DENOMINATOR (z); else if (SCM_REALP (z)) - return scm_exact_to_inexact (scm_denominator (scm_inexact_to_exact (z))); + { + double zz = SCM_REAL_VALUE (z); + if (zz == floor (zz)) + /* Handle infinities in accordance with R6RS fldenominator, and + optimize handling of integers. */ + return scm_i_from_double (1.0); + else + return scm_exact_to_inexact (scm_denominator (scm_inexact_to_exact (z))); + } else - SCM_WTA_DISPATCH_1 (g_scm_denominator, z, SCM_ARG1, s_scm_denominator); + return scm_wta_dispatch_1 (g_scm_denominator, z, SCM_ARG1, + s_scm_denominator); } #undef FUNC_NAME @@@ -9257,8 -9262,7 +9274,8 @@@ SCM_PRIMITIVE_GENERIC (scm_magnitude, " SCM_FRACTION_DENOMINATOR (z)); } else - SCM_WTA_DISPATCH_1 (g_scm_magnitude, z, SCM_ARG1, s_scm_magnitude); + return scm_wta_dispatch_1 (g_scm_magnitude, z, SCM_ARG1, + s_scm_magnitude); } #undef FUNC_NAME @@@ -9305,7 -9309,7 +9322,7 @@@ SCM_PRIMITIVE_GENERIC (scm_angle, "angl else return scm_i_from_double (atan2 (0.0, -1.0)); } else - SCM_WTA_DISPATCH_1 (g_scm_angle, z, SCM_ARG1, s_scm_angle); + return scm_wta_dispatch_1 (g_scm_angle, z, SCM_ARG1, s_scm_angle); } #undef FUNC_NAME @@@ -9324,8 -9328,7 +9341,8 @@@ SCM_PRIMITIVE_GENERIC (scm_exact_to_ine else if (SCM_INEXACTP (z)) return z; else - SCM_WTA_DISPATCH_1 (g_scm_exact_to_inexact, z, 1, s_scm_exact_to_inexact); + return scm_wta_dispatch_1 (g_scm_exact_to_inexact, z, 1, + s_scm_exact_to_inexact); } #undef FUNC_NAME @@@ -9346,8 -9349,7 +9363,8 @@@ SCM_PRIMITIVE_GENERIC (scm_inexact_to_e else if (SCM_COMPLEXP (z) && SCM_COMPLEX_IMAG (z) == 0.0) val = SCM_COMPLEX_REAL (z); else - SCM_WTA_DISPATCH_1 (g_scm_inexact_to_exact, z, 1, s_scm_inexact_to_exact); + return scm_wta_dispatch_1 (g_scm_inexact_to_exact, z, 1, + s_scm_inexact_to_exact); if (!SCM_LIKELY (isfinite (val))) SCM_OUT_OF_RANGE (1, z); @@@ -9843,6 -9845,46 +9860,6 @@@ scm_from_double (double val return scm_i_from_double (val); } -#if SCM_ENABLE_DEPRECATED == 1 - -float -scm_num2float (SCM num, unsigned long pos, const char *s_caller) -{ - scm_c_issue_deprecation_warning - ("`scm_num2float' is deprecated. Use scm_to_double instead."); - - if (SCM_BIGP (num)) - { - float res = mpz_get_d (SCM_I_BIG_MPZ (num)); - if (!isinf (res)) - return res; - else - scm_out_of_range (NULL, num); - } - else - return scm_to_double (num); -} - -double -scm_num2double (SCM num, unsigned long pos, const char *s_caller) -{ - scm_c_issue_deprecation_warning - ("`scm_num2double' is deprecated. Use scm_to_double instead."); - - if (SCM_BIGP (num)) - { - double res = mpz_get_d (SCM_I_BIG_MPZ (num)); - if (!isinf (res)) - return res; - else - scm_out_of_range (NULL, num); - } - else - return scm_to_double (num); -} - -#endif - int scm_is_complex (SCM val) { @@@ -9985,7 -10027,7 +10002,7 @@@ SCM_PRIMITIVE_GENERIC (scm_log, "log", return log_of_fraction (SCM_FRACTION_NUMERATOR (z), SCM_FRACTION_DENOMINATOR (z)); else - SCM_WTA_DISPATCH_1 (g_scm_log, z, 1, s_scm_log); + return scm_wta_dispatch_1 (g_scm_log, z, 1, s_scm_log); } #undef FUNC_NAME @@@ -10032,7 -10074,7 +10049,7 @@@ SCM_PRIMITIVE_GENERIC (scm_log10, "log1 log_of_fraction (SCM_FRACTION_NUMERATOR (z), SCM_FRACTION_DENOMINATOR (z))); else - SCM_WTA_DISPATCH_1 (g_scm_log10, z, 1, s_scm_log10); + return scm_wta_dispatch_1 (g_scm_log10, z, 1, s_scm_log10); } #undef FUNC_NAME @@@ -10060,7 -10102,7 +10077,7 @@@ SCM_PRIMITIVE_GENERIC (scm_exp, "exp", return scm_i_from_double (exp (scm_to_double (z))); } else - SCM_WTA_DISPATCH_1 (g_scm_exp, z, 1, s_scm_exp); + return scm_wta_dispatch_1 (g_scm_exp, z, 1, s_scm_exp); } #undef FUNC_NAME @@@ -10307,7 -10349,7 +10324,7 @@@ SCM_PRIMITIVE_GENERIC (scm_sqrt, "sqrt" } } else - SCM_WTA_DISPATCH_1 (g_scm_sqrt, z, 1, s_scm_sqrt); + return scm_wta_dispatch_1 (g_scm_sqrt, z, 1, s_scm_sqrt); } #undef FUNC_NAME diff --combined libguile/print.c index 50f5a3e68,4e68fd6c4..dbc6e96ed --- a/libguile/print.c +++ b/libguile/print.c @@@ -30,6 -30,7 +30,6 @@@ #include #include -#include #include "libguile/_scm.h" #include "libguile/chars.h" @@@ -40,6 -41,7 +40,6 @@@ #include "libguile/macros.h" #include "libguile/procprop.h" #include "libguile/read.h" -#include "libguile/weaks.h" #include "libguile/programs.h" #include "libguile/alist.h" #include "libguile/struct.h" @@@ -161,7 -163,7 +161,7 @@@ do { \ if (pstate->top - pstate->list_offset >= pstate->level) \ { \ - scm_putc ('#', port); \ + scm_putc_unlocked ('#', port); \ return; \ } \ } \ @@@ -305,9 -307,9 +305,9 @@@ print_circref (SCM port, scm_print_stat for (i = pstate->top - 1; 1; --i) if (scm_is_eq (PSTATE_STACK_REF(pstate, i), ref)) break; - scm_putc ('#', port); + scm_putc_unlocked ('#', port); scm_intprint (i - self, 10, port); - scm_putc ('#', port); + scm_putc_unlocked ('#', port); } /* Print the name of a symbol. */ @@@ -336,7 -338,6 +336,7 @@@ quote_keywordish_symbols (void (INITIAL_IDENTIFIER_MASK \ | UC_CATEGORY_MASK_Nd | UC_CATEGORY_MASK_Mc | UC_CATEGORY_MASK_Me) +/* FIXME: Cache this information on the symbol, somehow. */ static int symbol_has_extended_read_syntax (SCM sym) { @@@ -349,56 -350,26 +349,56 @@@ c = scm_i_symbol_ref (sym, 0); - /* Single dot; conflicts with dotted-pair notation. */ - if (len == 1 && c == '.') - return 1; - - /* Other initial-character constraints. */ - if (c == '\'' || c == '`' || c == ',' || c == '"' || c == ';' || c == '#') - return 1; + switch (c) + { + case '\'': + case '`': + case ',': + case '"': + case ';': + case '#': + /* Some initial-character constraints. */ + return 1; - /* Keywords can be identified by trailing colons too. */ - if (c == ':' || scm_i_symbol_ref (sym, len - 1) == ':') - return quote_keywordish_symbols (); + case ':': + /* Symbols that look like keywords. */ + return quote_keywordish_symbols (); - /* Number-ish symbols. */ - if (scm_is_true (scm_i_string_to_number (scm_symbol_to_string (sym), 10))) - return 1; + case '.': + /* Single dot conflicts with dotted-pair notation. */ + if (len == 1) + return 1; + /* Fall through to check numbers. */ + case '+': + case '-': + case '0': + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': + /* Number-ish symbols. Numbers with radixes already caught be # + above. */ + if (scm_is_true (scm_i_string_to_number (scm_symbol_to_string (sym), 10))) + return 1; + break; + + default: + break; + } /* Other disallowed first characters. */ if (!uc_is_general_category_withtable (c, INITIAL_IDENTIFIER_MASK)) return 1; + /* Keywords can be identified by trailing colons too. */ + if (scm_i_symbol_ref (sym, len - 1) == ':') + return quote_keywordish_symbols (); + /* Otherwise, any character that's in the identifier category mask is fine to pass through as-is, provided it's not one of the ASCII delimiters like `;'. */ @@@ -417,16 -388,7 +417,16 @@@ static void print_normal_symbol (SCM sym, SCM port) { - scm_display (scm_symbol_to_string (sym), port); + size_t len; + scm_t_string_failed_conversion_handler strategy; + + len = scm_i_symbol_length (sym); + strategy = SCM_PTAB_ENTRY (port)->ilseq_handler; + + if (scm_i_is_narrow_symbol (sym)) + display_string (scm_i_symbol_chars (sym), 1, len, port, strategy); + else + display_string (scm_i_symbol_wide_chars (sym), 0, len, port, strategy); } static void @@@ -438,7 -400,7 +438,7 @@@ print_extended_symbol (SCM sym, SCM por len = scm_i_symbol_length (sym); strategy = PORT_CONVERSION_HANDLER (port); - scm_lfwrite ("#{", 2, port); + scm_lfwrite_unlocked ("#{", 2, port); for (pos = 0; pos < len; pos++) { @@@ -448,7 -410,8 +448,8 @@@ SUBSEQUENT_IDENTIFIER_MASK | UC_CATEGORY_MASK_Zs)) { - if (!display_character (c, port, strategy)) + if (!display_character (c, port, strategy) + || (c == '\\' && !display_character (c, port, strategy))) scm_encoding_error ("print_extended_symbol", errno, "cannot convert to output locale", port, SCM_MAKE_CHAR (c)); @@@ -461,12 -424,12 +462,12 @@@ } } - scm_lfwrite ("}#", 2, port); + scm_lfwrite_unlocked ("}#", 2, port); } /* FIXME: allow R6RS hex escapes instead of #{...}#. */ -void -scm_i_print_symbol_name (SCM sym, SCM port) +static void +print_symbol (SCM sym, SCM port) { if (symbol_has_extended_read_syntax (sym)) print_extended_symbol (sym, port); @@@ -477,8 -440,8 +478,8 @@@ void scm_print_symbol_name (const char *str, size_t len, SCM port) { - SCM symbol = scm_from_locale_symboln (str, len); - scm_i_print_symbol_name (symbol, port); + SCM symbol = scm_from_utf8_symboln (str, len); + print_symbol (symbol, port); } /* Print generally. Handles both write and display according to PSTATE. @@@ -497,7 -460,7 +498,7 @@@ static void iprin1 (SCM exp, SCM port, scm_intprint (i, 8, port); \ else \ { \ - scm_puts ("x", port); \ + scm_puts_unlocked ("x", port); \ scm_intprint (i, 16, port); \ } \ } \ @@@ -552,7 -515,7 +553,7 @@@ iprin1 (SCM exp, SCM port, scm_print_st else if (SCM_IFLAGP (exp) && ((size_t) SCM_IFLAGNUM (exp) < (sizeof iflagnames / sizeof (char *)))) { - scm_puts (iflagnames [SCM_IFLAGNUM (exp)], port); + scm_puts_unlocked (iflagnames [SCM_IFLAGNUM (exp)], port); } else { @@@ -573,7 -536,7 +574,7 @@@ goto print_struct; pwps = scm_i_port_with_print_state (port, pstate->handle); pstate->revealed = 1; - scm_call_generic_2 (print, exp, pwps); + scm_call_2 (print, exp, pwps); } else { @@@ -641,22 -604,21 +642,22 @@@ case scm_tc7_symbol: if (scm_i_symbol_is_interned (exp)) { - scm_i_print_symbol_name (exp, port); + print_symbol (exp, port); scm_remember_upto_here_1 (exp); } else { - scm_puts ("#', port); + scm_putc_unlocked ('>', port); } break; case scm_tc7_variable: scm_i_variable_print (exp, port, pstate); break; + case scm_tc7_rtl_program: case scm_tc7_program: scm_i_program_print (exp, port, pstate); break; @@@ -666,12 -628,6 +667,12 @@@ case scm_tc7_hashtable: scm_i_hashtable_print (exp, port, pstate); break; + case scm_tc7_weak_set: + scm_i_weak_set_print (exp, port, pstate); + break; + case scm_tc7_weak_table: + scm_i_weak_table_print (exp, port, pstate); + break; case scm_tc7_fluid: scm_i_fluid_print (exp, port, pstate); break; @@@ -690,6 -646,12 +691,6 @@@ case scm_tc7_vm_cont: scm_i_vm_cont_print (exp, port, pstate); break; - case scm_tc7_prompt: - scm_i_prompt_print (exp, port, pstate); - break; - case scm_tc7_with_fluids: - scm_i_with_fluids_print (exp, port, pstate); - break; case scm_tc7_array: ENTER_NESTED_DATA (pstate, exp, circref); scm_i_print_array (exp, port, pstate); @@@ -703,11 -665,14 +704,11 @@@ break; case scm_tc7_wvect: ENTER_NESTED_DATA (pstate, exp, circref); - if (SCM_IS_WHVEC (exp)) - scm_puts ("#wh(", port); - else - scm_puts ("#w(", port); + scm_puts_unlocked ("#w(", port); goto common_vector_printer; case scm_tc7_vector: ENTER_NESTED_DATA (pstate, exp, circref); - scm_puts ("#(", port); + scm_puts_unlocked ("#(", port); common_vector_printer: { register long i; @@@ -719,26 -684,43 +720,26 @@@ last = pstate->length - 1; cutp = 1; } - if (SCM_I_WVECTP (exp)) - { - /* Elements of weak vectors may not be accessed via the - `SIMPLE_VECTOR_REF ()' macro. */ - for (i = 0; i < last; ++i) - { - scm_iprin1 (scm_c_vector_ref (exp, i), - port, pstate); - scm_putc (' ', port); - } - } - else - { - for (i = 0; i < last; ++i) - { - scm_iprin1 (SCM_SIMPLE_VECTOR_REF (exp, i), port, pstate); - scm_putc (' ', port); - } - } - + for (i = 0; i < last; ++i) + { + scm_iprin1 (scm_c_vector_ref (exp, i), port, pstate); + scm_putc_unlocked (' ', port); + } if (i == last) { /* CHECK_INTS; */ scm_iprin1 (scm_c_vector_ref (exp, i), port, pstate); } if (cutp) - scm_puts (" ...", port); - scm_putc (')', port); + scm_puts_unlocked (" ...", port); + scm_putc_unlocked (')', port); } EXIT_NESTED_DATA (pstate); break; case scm_tc7_port: { - register long i = SCM_PTOBNUM (exp); - if (i < scm_numptob - && scm_ptobs[i].print - && (scm_ptobs[i].print) (exp, port, pstate)) + scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (exp); + if (ptob->print && ptob->print (exp, port, pstate)) break; goto punk; } @@@ -883,7 -865,7 +884,7 @@@ display_string_as_utf8 (const void *str /* INPUT was successfully converted, entirely; print the result. */ - scm_lfwrite (utf8_buf, utf8_len, port); + scm_lfwrite_unlocked (utf8_buf, utf8_len, port); printed += i - printed; } @@@ -892,54 -874,6 +893,54 @@@ return len; } +/* Write STR to PORT as ISO-8859-1. STR is a LEN-codepoint string; it + is narrow if NARROW_P is true, wide otherwise. Return LEN. */ +static size_t +display_string_as_latin1 (const void *str, int narrow_p, size_t len, + SCM port, + scm_t_string_failed_conversion_handler strategy) +{ + size_t printed = 0; + + if (narrow_p) + { + scm_lfwrite_unlocked (str, len, port); + return len; + } + + while (printed < len) + { + char buf[256]; + size_t i; + + for (i = 0; i < sizeof(buf) && printed < len; i++, printed++) + { + scm_t_wchar c = STR_REF (str, printed); + + if (c < 256) + buf[i] = c; + else + break; + } + + scm_lfwrite_unlocked (buf, i, port); + + if (i < sizeof(buf) && printed < len) + { + if (strategy == SCM_FAILED_CONVERSION_ERROR) + break; + else if (strategy == SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE) + write_character_escaped (STR_REF (str, printed), 1, port); + else + /* STRATEGY is `SCM_FAILED_CONVERSION_QUESTION_MARK'. */ + display_string ("?", 1, 1, port, strategy); + printed++; + } + } + + return printed; +} + /* Convert STR through PORT's output conversion descriptor and write the output to PORT. Return the number of codepoints written. */ static size_t @@@ -963,8 -897,8 +964,8 @@@ display_string_using_iconv (const void pti->at_stream_start_for_bom_read = 0; /* Write a BOM if appropriate. */ - if (SCM_UNLIKELY (c_strcasecmp(pt->encoding, "UTF-16") == 0 - || c_strcasecmp(pt->encoding, "UTF-32") == 0)) + if (SCM_UNLIKELY (strcmp(pt->encoding, "UTF-16") == 0 + || strcmp(pt->encoding, "UTF-32") == 0)) display_character (SCM_UNICODE_BOM, port, iconveh_error); } @@@ -1008,7 -942,7 +1009,7 @@@ iconv (id->output_cd, NULL, NULL, NULL, NULL); /* Print the OUTPUT_LEN bytes successfully converted. */ - scm_lfwrite (encoded_output, output_len, port); + scm_lfwrite_unlocked (encoded_output, output_len, port); /* See how many input codepoints these OUTPUT_LEN bytes corresponds to. */ @@@ -1043,7 -977,7 +1044,7 @@@ { /* INPUT was successfully converted, entirely; print the result. */ - scm_lfwrite (encoded_output, output_len, port); + scm_lfwrite_unlocked (encoded_output, output_len, port); codepoints_read = i - printed; printed += codepoints_read; } @@@ -1063,6 -997,7 +1064,6 @@@ static size_ display_string (const void *str, int narrow_p, size_t len, SCM port, scm_t_string_failed_conversion_handler strategy) - { scm_t_port_internal *pti; @@@ -1070,10 -1005,9 +1071,10 @@@ if (pti->encoding_mode == SCM_PORT_ENCODING_MODE_UTF8) return display_string_as_utf8 (str, narrow_p, len, port); + else if (pti->encoding_mode == SCM_PORT_ENCODING_MODE_LATIN1) + return display_string_as_latin1 (str, narrow_p, len, port, strategy); else - return display_string_using_iconv (str, narrow_p, len, - port, strategy); + return display_string_using_iconv (str, narrow_p, len, port, strategy); } /* Attempt to display CH to PORT according to STRATEGY. Return non-zero @@@ -1118,7 -1052,7 +1119,7 @@@ write_character_escaped (scm_t_wchar ch /* Use special escapes for some C0 controls. */ buf[0] = '\\'; buf[1] = escapes[ch - 0x07]; - scm_lfwrite (buf, 2, port); + scm_lfwrite_unlocked (buf, 2, port); } else if (!SCM_R6RS_ESCAPES_P) { @@@ -1128,7 -1062,7 +1129,7 @@@ buf[1] = 'x'; buf[2] = hex[ch / 16]; buf[3] = hex[ch % 16]; - scm_lfwrite (buf, 4, port); + scm_lfwrite_unlocked (buf, 4, port); } else if (ch <= 0xFFFF) { @@@ -1138,7 -1072,7 +1139,7 @@@ buf[3] = hex[(ch & 0xF00) >> 8]; buf[4] = hex[(ch & 0xF0) >> 4]; buf[5] = hex[(ch & 0xF)]; - scm_lfwrite (buf, 6, port); + scm_lfwrite_unlocked (buf, 6, port); } else if (ch > 0xFFFF) { @@@ -1150,7 -1084,7 +1151,7 @@@ buf[5] = hex[(ch & 0xF00) >> 8]; buf[6] = hex[(ch & 0xF0) >> 4]; buf[7] = hex[(ch & 0xF)]; - scm_lfwrite (buf, 8, port); + scm_lfwrite_unlocked (buf, 8, port); } } else @@@ -1173,7 -1107,7 +1174,7 @@@ buf[i] = 'x'; i --; buf[i] = '\\'; - scm_lfwrite (buf + i, 9 - i, port); + scm_lfwrite_unlocked (buf + i, 9 - i, port); } } else @@@ -1183,7 -1117,7 +1184,7 @@@ name = scm_i_charname (SCM_MAKE_CHAR (ch)); if (name != NULL) - scm_puts (name, port); + scm_puts_unlocked (name, port); else PRINT_CHAR_ESCAPE (ch, port); } @@@ -1277,14 -1211,14 +1278,14 @@@ voi scm_intprint (scm_t_intmax n, int radix, SCM port) { char num_buf[SCM_INTBUFLEN]; - scm_lfwrite (num_buf, scm_iint2str (n, radix, num_buf), port); + scm_lfwrite_unlocked (num_buf, scm_iint2str (n, radix, num_buf), port); } void scm_uintprint (scm_t_uintmax n, int radix, SCM port) { char num_buf[SCM_INTBUFLEN]; - scm_lfwrite (num_buf, scm_iuint2str (n, radix, num_buf), port); + scm_lfwrite_unlocked (num_buf, scm_iuint2str (n, radix, num_buf), port); } /* Print an object of unrecognized type. @@@ -1293,19 -1227,19 +1294,19 @@@ void scm_ipruk (char *hdr, SCM ptr, SCM port) { - scm_puts ("#', port); + scm_putc_unlocked ('>', port); } @@@ -1316,7 -1250,7 +1317,7 @@@ scm_iprlist (char *hdr, SCM exp, int tl { register SCM hare, tortoise; long floor = pstate->top - 2; - scm_puts (hdr, port); + scm_puts_unlocked (hdr, port); /* CHECK_INTS; */ if (pstate->fancyp) goto fancy_printing; @@@ -1346,18 -1280,18 +1347,18 @@@ if (scm_is_eq (PSTATE_STACK_REF(pstate, i), exp)) goto circref; PUSH_REF (pstate, exp); - scm_putc (' ', port); + scm_putc_unlocked (' ', port); /* CHECK_INTS; */ scm_iprin1 (SCM_CAR (exp), port, pstate); } if (!SCM_NULL_OR_NIL_P (exp)) { - scm_puts (" . ", port); + scm_puts_unlocked (" . ", port); scm_iprin1 (exp, port, pstate); } end: - scm_putc (tlr, port); + scm_putc_unlocked (tlr, port); pstate->top = floor + 2; return; @@@ -1378,7 -1312,7 +1379,7 @@@ fancy_printing { if (n == 0) { - scm_puts (" ...", port); + scm_puts_unlocked (" ...", port); goto skip_tail; } else @@@ -1386,14 -1320,14 +1387,14 @@@ } PUSH_REF(pstate, exp); ++pstate->list_offset; - scm_putc (' ', port); + scm_putc_unlocked (' ', port); /* CHECK_INTS; */ scm_iprin1 (SCM_CAR (exp), port, pstate); } } if (!SCM_NULL_OR_NIL_P (exp)) { - scm_puts (" . ", port); + scm_puts_unlocked (" . ", port); scm_iprin1 (exp, port, pstate); } skip_tail: @@@ -1404,7 -1338,7 +1405,7 @@@ fancy_circref pstate->list_offset -= pstate->top - floor - 2; circref: - scm_puts (" . ", port); + scm_puts_unlocked (" . ", port); print_circref (port, pstate, exp); goto end; } @@@ -1429,11 -1363,7 +1430,11 @@@ scm_write (SCM obj, SCM port SCM_ASSERT (scm_valid_oport_value_p (port), port, SCM_ARG2, s_write); + scm_dynwind_begin (0); + scm_dynwind_lock_port (SCM_COERCE_OUTPORT (port)); scm_prin1 (obj, port, 1); + scm_dynwind_end (); + return SCM_UNSPECIFIED; } @@@ -1448,11 -1378,7 +1449,11 @@@ scm_display (SCM obj, SCM port SCM_ASSERT (scm_valid_oport_value_p (port), port, SCM_ARG2, s_display); + scm_dynwind_begin (0); + scm_dynwind_lock_port (SCM_COERCE_OUTPORT (port)); scm_prin1 (obj, port, 0); + scm_dynwind_end (); + return SCM_UNSPECIFIED; } @@@ -1565,7 -1491,7 +1566,7 @@@ SCM_DEFINE (scm_newline, "newline", 0, SCM_VALIDATE_OPORT_VALUE (1, port); - scm_putc ('\n', SCM_COERCE_OUTPORT (port)); + scm_putc_unlocked ('\n', SCM_COERCE_OUTPORT (port)); return SCM_UNSPECIFIED; } #undef FUNC_NAME @@@ -1610,7 -1536,7 +1611,7 @@@ static in port_with_ps_print (SCM obj, SCM port, scm_print_state *pstate) { obj = SCM_PORT_WITH_PS_PORT (obj); - return scm_ptobs[SCM_PTOBNUM (obj)].print (obj, port, pstate); + return SCM_PORT_DESCRIPTOR (obj)->print (obj, port, pstate); } SCM @@@ -1657,6 -1583,8 +1658,6 @@@ scm_init_print ( { SCM type; - scm_gc_register_root (&print_state_pool); - scm_gc_register_root (&scm_print_state_vtable); type = scm_make_vtable (scm_from_locale_string (SCM_PRINT_STATE_LAYOUT), SCM_BOOL_F); scm_set_struct_vtable_name_x (type, scm_from_latin1_symbol ("print-state")); diff --combined module/language/scheme/decompile-tree-il.scm index 2decd9749,fad857d33..99edee44c --- a/module/language/scheme/decompile-tree-il.scm +++ b/module/language/scheme/decompile-tree-il.scm @@@ -219,12 -219,10 +219,12 @@@ exp `(quote ,exp))) - (( exps) - (build-begin (map recurse exps))) + (( head tail) + (build-begin (cons (recurse head) + (build-begin-body + (recurse tail))))) - (( proc args) + (( proc args) (match `(,(recurse proc) ,@(map recurse args)) ((('lambda (formals ...) body ...) args ...) (=> failure) @@@ -233,9 -231,6 +233,9 @@@ (failure))) (e e))) + (( name args) + `(,name ,@(map recurse args))) + (( name) name) @@@ -432,12 -427,27 +432,12 @@@ `(call-with-values (lambda () ,@(recurse-body exp)) ,(recurse (make-lambda #f '() body)))) - (( body winder unwinder) - `(dynamic-wind ,(recurse winder) - (lambda () ,@(recurse-body body)) - ,(recurse unwinder))) - - (( fluids vals body) - `(with-fluids ,(map list - (map recurse fluids) - (map recurse vals)) - ,@(recurse-body body))) - - (( fluid) - `(fluid-ref ,(recurse fluid))) - - (( fluid exp) - `(fluid-set! ,(recurse fluid) ,(recurse exp))) - - (( tag body handler) + (( escape-only? tag body handler) `(call-with-prompt ,(recurse tag) - (lambda () ,@(recurse-body body)) + ,(if escape-only? + `(lambda () ,(recurse body)) + (recurse body)) ,(recurse handler))) @@@ -648,7 -658,7 +648,7 @@@ (() (primitive 'if)) ; (if #f #f) (() (primitive 'quote)) - (( proc args) + (( proc args) (if (lexical-ref? proc) (let* ((gensym (lexical-ref-gensym proc)) (name (source-name gensym))) @@@ -663,7 -673,6 +663,7 @@@ (for-each recurse args)) (( name) (primitive name)) + (( name args) (primitive name) (for-each recurse args)) (( gensym) (lexical gensym)) (( gensym exp) @@@ -686,11 -695,9 +686,11 @@@ (primitive 'if) (recurse test) (recurse consequent) (recurse alternate)) - (( exps) (primitive 'begin) (for-each recurse exps)) + (( head tail) + (primitive 'begin) (recurse head) (recurse tail)) + (( body) - (if body (recurse body))) + (if body (recurse body) (primitive 'case-lambda))) (( req opt rest kw inits gensyms body alternate) (primitive 'lambda) @@@ -746,8 -753,23 +746,8 @@@ (primitive 'call-with-values) (recurse exp) (recurse body)) - (( winder body unwinder) - (primitive 'dynamic-wind) - (recurse winder) (recurse body) (recurse unwinder)) - - (( fluids vals body) - (primitive 'with-fluids) - (for-each recurse fluids) - (for-each recurse vals) - (recurse body)) - - (( fluid) (primitive 'fluid-ref) (recurse fluid)) - (( fluid exp) - (primitive 'fluid-set!) (recurse fluid) (recurse exp)) - (( tag body handler) (primitive 'call-with-prompt) - (primitive 'lambda) (recurse tag) (recurse body) (recurse handler)) (( tag args tail) diff --combined test-suite/tests/foreign.test index 74cdc1b4f,acdb3db05..8ba989e4d --- a/test-suite/tests/foreign.test +++ b/test-suite/tests/foreign.test @@@ -51,6 -51,10 +51,10 @@@ (pass-if "null-pointer? %null-pointer" (null-pointer? %null-pointer)) + (pass-if-exception "dereference-pointer %null-pointer" + exception:null-pointer-error + (dereference-pointer %null-pointer)) + (pass-if-exception "pointer->bytevector %null-pointer" exception:null-pointer-error (pointer->bytevector %null-pointer 7))) @@@ -338,10 -342,6 +342,10 @@@ (= (sizeof (list int8 double)) (+ (alignof double) (sizeof double)))) + (pass-if "sizeof { double, int8 }" + (= (sizeof (list double int8)) + (+ (alignof double) (sizeof double)))) + (pass-if "sizeof { short, int, long, pointer }" (let ((layout (list short int long '*))) (>= (sizeof layout)