Index: configure.in =================================================================== --- configure.in.orig 2008-05-28 18:14:11.123693215 +0000 +++ configure.in 2008-05-28 21:24:57.979038726 +0000 @@ -268,7 +407,12 @@ else SCM_I_GSC_ENABLE_ELISP=0 fi -AC_CHECK_LIB(uca, __uc_get_ar_bsp) + +AC_CHECK_LIB([uca], [__uc_get_ar_bsp], + [case "${host_cpu}-${host_os}" in + ia64-hpux*) + LIBS="$LIBS -luca" ;; + esac]) AC_C_CONST @@ -281,7 +425,6 @@ else SCM_I_GSC_C_INLINE=NULL fi -AC_CHECK_LIB(uca, __uc_get_ar_bsp) AC_C_BIGENDIAN @@ -685,7 +828,44 @@ # isblank - available as a GNU extension or in C99 # _NSGetEnviron - Darwin specific # -AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround ftime ftruncate fchown getcwd geteuid gettimeofday gmtime_r ioctl lstat mkdir mknod nice pipe _pipe readdir_r readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron strncasecmp]) +AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid fesetround ftime ftruncate fchown getcwd geteuid gettimeofday ioctl lstat mkdir mknod nice pipe _pipe readlink rename rmdir select setegid seteuid setlocale setpgid setsid sigaction siginterrupt stat64 strftime strptime symlink sync sysconf tcgetpgrp tcsetpgrp times uname waitpid strdup system usleep atexit on_exit chown link fcntl ttyname getpwent getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp index bcopy memcpy rindex truncate unsetenv isblank _NSGetEnviron strncasecmp]) + +case "${host_os}" in +hpux*) CPPFLAGS="${CPPFLAGS} -D_REENTRANT" ;; +esac + +# HPUX 10 has a non-posix gmtime_r that returns an int +AC_CACHE_CHECK([for posix gmtime_r], [ac_cv_func_gmtime_r],[ + AC_TRY_COMPILE( + [#include ], + [ + struct tm * (*ptr) (time_t const *, struct tm*) = gmtime_r; + if (ptr) return 0; + *gmtime_r (0,0); + ], + [ac_cv_func_gmtime_r=yes], + [ac_cv_func_gmtime_r=no]) +]) + +if test "X$ac_cv_func_gmtime_r" = "Xyes"; then + AC_DEFINE([HAVE_GMTIME_R],1,[Define if you have a POSIX gmtime_r]) +fi + +# HP-UX 10 has a non-posix readdir_r that takes only 2 arguments +AC_CACHE_CHECK([for posix readdir_r], [ac_cv_func_readdir_r],[ + AC_TRY_COMPILE( + [#include ], + [ + DIR *d=NULL; + struct dirent *ent1 = NULL; + struct dirent **ent2 = NULL; + int x = readdir_r(d,ent1,ent2);], + [ac_cv_func_readdir_r=yes], + [ac_cv_func_readdir_r=no])]) + +if test "X$ac_cv_func_readdir_r" = "Xyes"; then + AC_DEFINE([HAVE_READDIR_R],1,[Define if you have a POSIX readdir_r]) +fi # Reasons for testing: # netdb.h - not in mingw Index: libguile/read.c =================================================================== --- libguile/read.c.orig 2008-05-28 18:14:10.889204697 +0000 +++ libguile/read.c 2008-05-28 18:15:06.936445832 +0000 @@ -63,7 +63,7 @@ "Record positions of source code expressions." }, { SCM_OPTION_BOOLEAN, "case-insensitive", 0, "Convert symbols to lower case."}, - { SCM_OPTION_SCM, "keywords", SCM_UNPACK (SCM_BOOL_F), + { SCM_OPTION_SCM, "keywords", scm_tc8_flag, "Style of keyword recognition: #f, 'prefix or 'postfix."} #if SCM_ENABLE_ELISP , Index: libguile/eval.c =================================================================== --- libguile/eval.c.orig 2008-05-28 18:14:10.873544509 +0000 +++ libguile/eval.c 2008-05-28 18:15:07.165321457 +0000 @@ -2358,81 +2358,77 @@ static SCM unmemoize_builtin_macro (const SCM expr, const SCM env) { - switch (ISYMNUM (SCM_CAR (expr))) - { - case (ISYMNUM (SCM_IM_AND)): - return unmemoize_and (expr, env); + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_AND))) + return unmemoize_and (expr, env); - case (ISYMNUM (SCM_IM_BEGIN)): - return unmemoize_begin (expr, env); + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_BEGIN))) + return unmemoize_begin (expr, env); - case (ISYMNUM (SCM_IM_CASE)): - return unmemoize_case (expr, env); + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_CASE))) + return unmemoize_case (expr, env); - case (ISYMNUM (SCM_IM_COND)): - return unmemoize_cond (expr, env); + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_COND))) + return unmemoize_cond (expr, env); - case (ISYMNUM (SCM_IM_DELAY)): - return unmemoize_delay (expr, env); + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_DELAY))) + return unmemoize_delay (expr, env); - case (ISYMNUM (SCM_IM_DO)): - return unmemoize_do (expr, env); + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_DO))) + return unmemoize_do (expr, env); - case (ISYMNUM (SCM_IM_IF)): - return unmemoize_if (expr, env); + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_IF))) + return unmemoize_if (expr, env); - case (ISYMNUM (SCM_IM_LAMBDA)): - return unmemoize_lambda (expr, env); + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_LAMBDA))) + return unmemoize_lambda (expr, env); - case (ISYMNUM (SCM_IM_LET)): - return unmemoize_let (expr, env); + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_LET))) + return unmemoize_let (expr, env); - case (ISYMNUM (SCM_IM_LETREC)): - return unmemoize_letrec (expr, env); + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_LETREC))) + return unmemoize_letrec (expr, env); - case (ISYMNUM (SCM_IM_LETSTAR)): - return unmemoize_letstar (expr, env); + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_LETSTAR))) + return unmemoize_letstar (expr, env); - case (ISYMNUM (SCM_IM_OR)): - return unmemoize_or (expr, env); + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_OR))) + return unmemoize_or (expr, env); - case (ISYMNUM (SCM_IM_QUOTE)): - return unmemoize_quote (expr, env); + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_QUOTE))) + return unmemoize_quote (expr, env); - case (ISYMNUM (SCM_IM_SET_X)): - return unmemoize_set_x (expr, env); + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_SET_X))) + return unmemoize_set_x (expr, env); - case (ISYMNUM (SCM_IM_APPLY)): - return unmemoize_apply (expr, env); + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_APPLY))) + return unmemoize_apply (expr, env); - case (ISYMNUM (SCM_IM_BIND)): - return unmemoize_exprs (expr, env); /* FIXME */ + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_BIND))) + return unmemoize_exprs (expr, env); /* FIXME */ - case (ISYMNUM (SCM_IM_CONT)): - return unmemoize_atcall_cc (expr, env); + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_CONT))) + return unmemoize_atcall_cc (expr, env); - case (ISYMNUM (SCM_IM_CALL_WITH_VALUES)): - return unmemoize_at_call_with_values (expr, env); + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_CALL_WITH_VALUES))) + return unmemoize_at_call_with_values (expr, env); #if 0 - /* See futures.h for a comment why futures are not enabled. - */ - case (ISYMNUM (SCM_IM_FUTURE)): - return unmemoize_future (expr, env); + /* See futures.h for a comment why futures are not enabled. + */ + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_FUTURE))) + return unmemoize_future (expr, env); #endif - case (ISYMNUM (SCM_IM_SLOT_REF)): - return unmemoize_atslot_ref (expr, env); + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_SLOT_REF))) + return unmemoize_atslot_ref (expr, env); - case (ISYMNUM (SCM_IM_SLOT_SET_X)): - return unmemoize_atslot_set_x (expr, env); + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_SLOT_SET_X))) + return unmemoize_atslot_set_x (expr, env); - case (ISYMNUM (SCM_IM_NIL_COND)): - return unmemoize_exprs (expr, env); /* FIXME */ + if (ISYMNUM (SCM_CAR (expr)) == (ISYMNUM (SCM_IM_NIL_COND))) + return unmemoize_exprs (expr, env); /* FIXME */ - default: - return unmemoize_exprs (expr, env); /* FIXME */ - } + return unmemoize_exprs (expr, env); /* FIXME */ } @@ -3337,9 +3333,7 @@ SCM_TICK; if (SCM_ISYMP (SCM_CAR (x))) { - switch (ISYMNUM (SCM_CAR (x))) - { - case (ISYMNUM (SCM_IM_AND)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_AND))) { x = SCM_CDR (x); while (!scm_is_null (SCM_CDR (x))) { @@ -3351,8 +3345,8 @@ } PREP_APPLY (SCM_UNDEFINED, SCM_EOL); goto carloop; - - case (ISYMNUM (SCM_IM_BEGIN)): + } + if (ISYMNUM (SCM_CAR (x)) ==(ISYMNUM (SCM_IM_BEGIN))) { x = SCM_CDR (x); if (scm_is_null (x)) RETURN (SCM_UNSPECIFIED); @@ -3420,9 +3414,9 @@ else RETURN (last_form); } + } - - case (ISYMNUM (SCM_IM_CASE)): + if (ISYMNUM (SCM_CAR (x)) ==(ISYMNUM (SCM_IM_CASE))) { x = SCM_CDR (x); { const SCM key = EVALCAR (x, env); @@ -3453,9 +3447,9 @@ } } RETURN (SCM_UNSPECIFIED); + } - - case (ISYMNUM (SCM_IM_COND)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_COND))) { x = SCM_CDR (x); while (!scm_is_null (x)) { @@ -3514,9 +3508,9 @@ } } RETURN (SCM_UNSPECIFIED); + } - - case (ISYMNUM (SCM_IM_DO)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_DO))) { x = SCM_CDR (x); { /* Compute the initialization values and the initial environment. */ @@ -3585,9 +3579,9 @@ RETURN (SCM_UNSPECIFIED); PREP_APPLY (SCM_UNDEFINED, SCM_EOL); goto nontoplevel_begin; + } - - case (ISYMNUM (SCM_IM_IF)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_IF))) { x = SCM_CDR (x); { SCM test_result = EVALCAR (x, env); @@ -3601,9 +3595,9 @@ } PREP_APPLY (SCM_UNDEFINED, SCM_EOL); goto carloop; + } - - case (ISYMNUM (SCM_IM_LET)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_LET))) { x = SCM_CDR (x); { SCM init_forms = SCM_CADR (x); @@ -3619,9 +3613,9 @@ x = SCM_CDDR (x); PREP_APPLY (SCM_UNDEFINED, SCM_EOL); goto nontoplevel_begin; + } - - case (ISYMNUM (SCM_IM_LETREC)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_LETREC))) { x = SCM_CDR (x); env = SCM_EXTEND_ENV (SCM_CAR (x), undefineds, env); x = SCM_CDR (x); @@ -3635,9 +3629,9 @@ x = SCM_CDR (x); PREP_APPLY (SCM_UNDEFINED, SCM_EOL); goto nontoplevel_begin; + } - - case (ISYMNUM (SCM_IM_LETSTAR)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_LETSTAR))) { x = SCM_CDR (x); { SCM bindings = SCM_CAR (x); @@ -3656,9 +3650,9 @@ x = SCM_CDR (x); PREP_APPLY (SCM_UNDEFINED, SCM_EOL); goto nontoplevel_begin; + } - - case (ISYMNUM (SCM_IM_OR)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_OR))) { x = SCM_CDR (x); while (!scm_is_null (SCM_CDR (x))) { @@ -3670,17 +3664,17 @@ } PREP_APPLY (SCM_UNDEFINED, SCM_EOL); goto carloop; + } - - case (ISYMNUM (SCM_IM_LAMBDA)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_LAMBDA))) { RETURN (scm_closure (SCM_CDR (x), env)); + } - - case (ISYMNUM (SCM_IM_QUOTE)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_QUOTE))) { RETURN (SCM_CDR (x)); + } - - case (ISYMNUM (SCM_IM_SET_X)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_SET_X))) { x = SCM_CDR (x); { SCM *location; @@ -3700,9 +3694,9 @@ *location = EVALCAR (x, env); } RETURN (SCM_UNSPECIFIED); + } - - case (ISYMNUM (SCM_IM_APPLY)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_APPLY))) { /* Evaluate the procedure to be applied. */ x = SCM_CDR (x); proc = EVALCAR (x, env); @@ -3751,9 +3745,9 @@ ENTER_APPLY; RETURN (SCM_APPLY (proc, arg1, SCM_EOL)); } + } - - case (ISYMNUM (SCM_IM_CONT)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_CONT))) { { int first; SCM val = scm_make_continuation (&first); @@ -3770,18 +3764,21 @@ goto evap1; } } + } - - case (ISYMNUM (SCM_IM_DELAY)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_DELAY))) { RETURN (scm_makprom (scm_closure (SCM_CDR (x), env))); - + } #if 0 /* See futures.h for a comment why futures are not enabled. */ - case (ISYMNUM (SCM_IM_FUTURE)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_FUTURE))) { RETURN (scm_i_make_future (scm_closure (SCM_CDR (x), env))); + } #endif - +/* + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_DISPATCH))) { +*/ /* PLACEHOLDER for case (ISYMNUM (SCM_IM_DISPATCH)): The following code (type_dispatch) is intended to be the tail of the case clause for the internal macro SCM_IM_DISPATCH. Please don't @@ -3791,6 +3788,7 @@ /* The type dispatch code is duplicated below * (c.f. objects.c:scm_mcache_compute_cmethod) since that * cuts down execution time for type dispatch to 50%. */ + if (0) { type_dispatch: /* inputs: x, arg1 */ /* Type dispatch means to determine from the types of the function * arguments (i. e. the 'signature' of the call), which method from @@ -3915,18 +3913,18 @@ } } } + } - - case (ISYMNUM (SCM_IM_SLOT_REF)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_SLOT_REF))) { x = SCM_CDR (x); { SCM instance = EVALCAR (x, env); unsigned long int slot = SCM_I_INUM (SCM_CDR (x)); RETURN (SCM_PACK (SCM_STRUCT_DATA (instance) [slot])); } + } - - case (ISYMNUM (SCM_IM_SLOT_SET_X)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_SLOT_SET_X))) { x = SCM_CDR (x); { SCM instance = EVALCAR (x, env); @@ -3935,11 +3933,10 @@ SCM_STRUCT_DATA (instance) [slot] = SCM_UNPACK (value); RETURN (SCM_UNSPECIFIED); } - + } #if SCM_ENABLE_ELISP - - case (ISYMNUM (SCM_IM_NIL_COND)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_NIL_COND))) { { SCM test_form = SCM_CDR (x); x = SCM_CDR (test_form); @@ -3964,10 +3961,10 @@ PREP_APPLY (SCM_UNDEFINED, SCM_EOL); goto carloop; } - + } #endif /* SCM_ENABLE_ELISP */ - case (ISYMNUM (SCM_IM_BIND)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_BIND))) { { SCM vars, exps, vals; @@ -3997,9 +3994,9 @@ RETURN (proc); } + } - - case (ISYMNUM (SCM_IM_CALL_WITH_VALUES)): + if (ISYMNUM (SCM_CAR (x)) == (ISYMNUM (SCM_IM_CALL_WITH_VALUES))) { { SCM producer; @@ -4021,11 +4018,7 @@ PREP_APPLY (proc, arg1); goto apply_proc; } - - - default: - break; - } + } } else { Index: libguile/fports.c =================================================================== --- libguile/fports.c.orig 2008-05-28 18:14:10.894643700 +0000 +++ libguile/fports.c 2008-05-28 18:15:07.183102061 +0000 @@ -78,6 +78,12 @@ #define OFF_T_MAX LONG_MAX #define OFF_T_MIN LONG_MIN #elif SIZEOF_OFF_T == SIZEOF_LONG_LONG +#ifndef LONG_LONG_MAX +#define LONG_LONG_MAX 9223372036854775807LL +#endif +#ifndef LONG_LONG_MIN +#define LONG_LONG_MIN (-LONG_LONG_MAX - 1LL) +#endif #define OFF_T_MAX LONG_LONG_MAX #define OFF_T_MIN LONG_LONG_MIN #else Index: libguile/hash.c =================================================================== --- libguile/hash.c.orig 2008-05-28 18:14:10.862008652 +0000 +++ libguile/hash.c 2008-05-28 18:15:07.197348933 +0000 @@ -61,24 +61,19 @@ case scm_tc3_imm24: if (SCM_CHARP(obj)) return (unsigned)(scm_c_downcase(SCM_CHAR(obj))) % n; - switch (SCM_UNPACK (obj)) { #ifndef SICP - case SCM_UNPACK(SCM_EOL): - d = 256; - break; + if (SCM_UNPACK (obj) == SCM_UNPACK(SCM_EOL)) + d = 256; + else #endif - case SCM_UNPACK(SCM_BOOL_T): - d = 257; - break; - case SCM_UNPACK(SCM_BOOL_F): + if (SCM_UNPACK (obj) == SCM_UNPACK(SCM_BOOL_T)) + d = 257; + else if (SCM_UNPACK (obj) == SCM_UNPACK(SCM_BOOL_F)) d = 258; - break; - case SCM_UNPACK(SCM_EOF_VAL): + else if (SCM_UNPACK (obj) == SCM_UNPACK(SCM_EOF_VAL)) d = 259; - break; - default: + else d = 263; /* perhaps should be error */ - } return d % n; default: return 263 % n; /* perhaps should be error */ Index: libguile/print.c =================================================================== --- libguile/print.c.orig 2008-05-28 18:14:10.878783435 +0000 +++ libguile/print.c 2008-05-28 18:15:07.229252563 +0000 @@ -71,7 +71,7 @@ SCM_SYMBOL (sym_reader, "reader"); scm_t_option scm_print_opts[] = { - { SCM_OPTION_SCM, "closure-hook", SCM_UNPACK (SCM_BOOL_F), + { SCM_OPTION_SCM, "closure-hook", scm_tc8_flag, "Hook for printing closures (should handle macros as well)." }, { SCM_OPTION_BOOLEAN, "source", 0, "Print closures with source." }, Index: test-suite/standalone/test-conversion.c =================================================================== --- test-suite/standalone/test-conversion.c.orig 2008-05-28 18:14:10.993540911 +0000 +++ test-suite/standalone/test-conversion.c 2008-05-28 18:15:07.251098443 +0000 @@ -27,7 +27,8 @@ #ifdef HAVE_INTTYPES_H # include -#elif (!defined PRIiMAX) +#endif +#if (!defined PRIiMAX) # if (defined SIZEOF_LONG_LONG) && (SIZEOF_LONG_LONG >= 8) # define PRIiMAX "lli" # define PRIuMAX "llu" Index: libguile/hashtab.c =================================================================== --- libguile/hashtab.c.orig 2008-05-28 18:14:10.856701152 +0000 +++ libguile/hashtab.c 2008-05-28 18:15:07.270945309 +0000 @@ -908,8 +908,71 @@ /* Hash table iterators */ -static const char s_scm_hash_fold[]; +SCM +scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table); +void +scm_internal_hash_for_each_handle (SCM (*fn) (), void *closure, SCM table); +SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0, + (SCM proc, SCM init, SCM table), + "An iterator over hash-table elements.\n" + "Accumulates and returns a result by applying PROC successively.\n" + "The arguments to PROC are \"(key value prior-result)\" where key\n" + "and value are successive pairs from the hash table TABLE, and\n" + "prior-result is either INIT (for the first application of PROC)\n" + "or the return value of the previous application of PROC.\n" + "For example, @code{(hash-fold acons '() tab)} will convert a hash\n" + "table into an a-list of key-value pairs.") +#define FUNC_NAME s_scm_hash_fold +{ + SCM_VALIDATE_PROC (1, proc); + if (!SCM_HASHTABLE_P (table)) + SCM_VALIDATE_VECTOR (3, table); + return scm_internal_hash_fold (scm_call_3, (void *) SCM_UNPACK (proc), init, table); +} +#undef FUNC_NAME + +static SCM +for_each_proc (void *proc, SCM handle) +{ + return scm_call_2 (SCM_PACK (proc), SCM_CAR (handle), SCM_CDR (handle)); +} + +SCM_DEFINE (scm_hash_for_each, "hash-for-each", 2, 0, 0, + (SCM proc, SCM table), + "An iterator over hash-table elements.\n" + "Applies PROC successively on all hash table items.\n" + "The arguments to PROC are \"(key value)\" where key\n" + "and value are successive pairs from the hash table TABLE.") +#define FUNC_NAME s_scm_hash_for_each +{ + SCM_VALIDATE_PROC (1, proc); + if (!SCM_HASHTABLE_P (table)) + SCM_VALIDATE_VECTOR (2, table); + + scm_internal_hash_for_each_handle (for_each_proc, + (void *) SCM_UNPACK (proc), + table); + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME +SCM_DEFINE (scm_hash_for_each_handle, "hash-for-each-handle", 2, 0, 0, + (SCM proc, SCM table), + "An iterator over hash-table elements.\n" + "Applies PROC successively on all hash table handles.") +#define FUNC_NAME s_scm_hash_for_each_handle +{ + scm_t_trampoline_1 call = scm_trampoline_1 (proc); + SCM_ASSERT (call, proc, 1, FUNC_NAME); + if (!SCM_HASHTABLE_P (table)) + SCM_VALIDATE_VECTOR (2, table); + + scm_internal_hash_for_each_handle (call, + (void *) SCM_UNPACK (proc), + table); + return SCM_UNSPECIFIED; +} +#undef FUNC_NAME SCM scm_internal_hash_fold (SCM (*fn) (), void *closure, SCM init, SCM table) { @@ -946,8 +1009,6 @@ scm_internal_hash_fold_handles, but we don't want to promote such an API. */ -static const char s_scm_hash_for_each[]; - void scm_internal_hash_for_each_handle (SCM (*fn) (), void *closure, SCM table) { @@ -976,67 +1037,6 @@ } } -SCM_DEFINE (scm_hash_fold, "hash-fold", 3, 0, 0, - (SCM proc, SCM init, SCM table), - "An iterator over hash-table elements.\n" - "Accumulates and returns a result by applying PROC successively.\n" - "The arguments to PROC are \"(key value prior-result)\" where key\n" - "and value are successive pairs from the hash table TABLE, and\n" - "prior-result is either INIT (for the first application of PROC)\n" - "or the return value of the previous application of PROC.\n" - "For example, @code{(hash-fold acons '() tab)} will convert a hash\n" - "table into an a-list of key-value pairs.") -#define FUNC_NAME s_scm_hash_fold -{ - SCM_VALIDATE_PROC (1, proc); - if (!SCM_HASHTABLE_P (table)) - SCM_VALIDATE_VECTOR (3, table); - return scm_internal_hash_fold (scm_call_3, (void *) SCM_UNPACK (proc), init, table); -} -#undef FUNC_NAME - -static SCM -for_each_proc (void *proc, SCM handle) -{ - return scm_call_2 (SCM_PACK (proc), SCM_CAR (handle), SCM_CDR (handle)); -} - -SCM_DEFINE (scm_hash_for_each, "hash-for-each", 2, 0, 0, - (SCM proc, SCM table), - "An iterator over hash-table elements.\n" - "Applies PROC successively on all hash table items.\n" - "The arguments to PROC are \"(key value)\" where key\n" - "and value are successive pairs from the hash table TABLE.") -#define FUNC_NAME s_scm_hash_for_each -{ - SCM_VALIDATE_PROC (1, proc); - if (!SCM_HASHTABLE_P (table)) - SCM_VALIDATE_VECTOR (2, table); - - scm_internal_hash_for_each_handle (for_each_proc, - (void *) SCM_UNPACK (proc), - table); - return SCM_UNSPECIFIED; -} -#undef FUNC_NAME - -SCM_DEFINE (scm_hash_for_each_handle, "hash-for-each-handle", 2, 0, 0, - (SCM proc, SCM table), - "An iterator over hash-table elements.\n" - "Applies PROC successively on all hash table handles.") -#define FUNC_NAME s_scm_hash_for_each_handle -{ - scm_t_trampoline_1 call = scm_trampoline_1 (proc); - SCM_ASSERT (call, proc, 1, FUNC_NAME); - if (!SCM_HASHTABLE_P (table)) - SCM_VALIDATE_VECTOR (2, table); - - scm_internal_hash_for_each_handle (call, - (void *) SCM_UNPACK (proc), - table); - return SCM_UNSPECIFIED; -} -#undef FUNC_NAME static SCM map_proc (void *proc, SCM key, SCM data, SCM value) Index: libguile/deprecated.c =================================================================== --- libguile/deprecated.c.orig 2008-05-28 18:14:10.868232852 +0000 +++ libguile/deprecated.c 2008-05-28 18:15:07.418809362 +0000 @@ -319,14 +319,14 @@ static void maybe_close_port (void *data, SCM port) { - SCM except = (SCM)data; + SCM _except = (SCM)data; - while (!scm_is_null (except)) + while (!scm_is_null (_except)) { - SCM p = SCM_COERCE_OUTPORT (SCM_CAR (except)); + SCM p = SCM_COERCE_OUTPORT (SCM_CAR (_except)); if (scm_is_eq (p, port)) return; - except = SCM_CDR (except); + _except = SCM_CDR (_except); } scm_close_port (port); Index: guile-config/guile-config.in =================================================================== --- guile-config/guile-config.in.orig 2008-05-28 22:02:48.000000000 +0000 +++ guile-config/guile-config.in 2008-05-28 22:11:01.068986013 +0000 @@ -151,13 +151,12 @@ (display (string-join (list (get-build-info 'CFLAGS) - "-lguile -lltdl" (if (or (string=? libdir "/usr/lib") (string=? libdir "/usr/lib/")) "" (string-append "-L" (get-build-info 'libdir))) + "-lguile -lltdl" (string-join other-flags) - ))) (newline)))