diff options
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/_scm.h | 19 | ||||
-rw-r--r-- | libguile/goops.c | 2 | ||||
-rw-r--r-- | libguile/gsubr.c | 8 | ||||
-rw-r--r-- | libguile/init.c | 3 | ||||
-rw-r--r-- | libguile/inline.h | 2 | ||||
-rw-r--r-- | libguile/procs.c | 58 | ||||
-rw-r--r-- | libguile/procs.h | 26 | ||||
-rw-r--r-- | libguile/threads.h | 2 |
8 files changed, 45 insertions, 75 deletions
diff --git a/libguile/_scm.h b/libguile/_scm.h index 6b728be2b..e40f29bb0 100644 --- a/libguile/_scm.h +++ b/libguile/_scm.h @@ -38,6 +38,25 @@ # include <config.h> #endif +/* Undefine HAVE_STRUCT_TIMESPEC, because the libguile C code doesn't + need it anymore, and because on MinGW: + + - the definition of struct timespec is provided (if at all) by + pthread.h + + - pthread.h will _not_ define struct timespec if + HAVE_STRUCT_TIMESPEC is 1, because then it thinks that it doesn't + need to. + + The libguile C code doesn't need HAVE_STRUCT_TIMESPEC anymore, + because the value of HAVE_STRUCT_TIMESPEC has already been + incorporated in how scm_t_timespec is defined (in scmconfig.h), and + the rest of the libguile C code now just uses scm_t_timespec. + */ +#ifdef HAVE_STRUCT_TIMESPEC +#undef HAVE_STRUCT_TIMESPEC +#endif + #include <errno.h> #include "libguile/__scm.h" diff --git a/libguile/goops.c b/libguile/goops.c index 9ac9e9afa..520b1c25d 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -1905,7 +1905,7 @@ scm_c_extend_primitive_generic (SCM extended, SCM extension) gext = scm_call_2 (SCM_VARIABLE_REF (scm_var_make_extended_generic), gf, SCM_SNAME (extension)); - *SCM_SUBR_GENERIC (extension) = gext; + SCM_SET_SUBR_GENERIC (extension, gext); } else { diff --git a/libguile/gsubr.c b/libguile/gsubr.c index be5c34271..fdb70ed92 100644 --- a/libguile/gsubr.c +++ b/libguile/gsubr.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2006, 2008, 2009 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public @@ -75,13 +75,13 @@ create_gsubr (int define, const char *name, subr = scm_c_make_subr (name, scm_tc7_lsubr_2, fcn); create_subr: if (define) - scm_define (SCM_SUBR_ENTRY(subr).name, subr); + scm_define (SCM_SNAME (subr), subr); return subr; default: { SCM cclo = scm_makcclo (scm_f_gsubr_apply, 3L); SCM subr = scm_c_make_subr (name, scm_tc7_subr_0, fcn); - SCM sym = SCM_SUBR_ENTRY(subr).name; + SCM sym = SCM_SNAME (subr); if (SCM_GSUBR_MAX < req + opt + rst) { fprintf (stderr, @@ -151,7 +151,7 @@ create_gsubr_with_generic (int define, subr = scm_c_make_subr_with_generic (name, scm_tc7_lsubr_2, fcn, gf); create_subr: if (define) - scm_define (SCM_SUBR_ENTRY(subr).name, subr); + scm_define (SCM_SNAME (subr), subr); return subr; default: ; diff --git a/libguile/init.c b/libguile/init.c index 2d5c94340..56c34c8bc 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -1,4 +1,4 @@ -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc. +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2006, 2009 Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public @@ -446,7 +446,6 @@ scm_i_init_guile (SCM_STACKITEM *base) scm_struct_prehistory (); /* requires storage */ scm_symbols_prehistory (); /* requires storage */ - scm_init_subr_table (); #if 0 scm_environments_prehistory (); /* requires storage */ #endif diff --git a/libguile/inline.h b/libguile/inline.h index 7d2dabaad..ff8d2d4d1 100644 --- a/libguile/inline.h +++ b/libguile/inline.h @@ -54,7 +54,7 @@ C99 mode and doesn't define `__GNUC_STDC_INLINE__'. Fall back to "static inline" in that case. */ -# if (defined __GNUC__) && (!(__APPLE_CC__ > 5400 && __STDC_VERSION__ >= 199901L)) +# if (defined __GNUC__) && (!(((defined __APPLE_CC__) && (__APPLE_CC__ > 5400)) && __STDC_VERSION__ >= 199901L)) # define SCM_C_USE_EXTERN_INLINE 1 # if (defined __GNUC_STDC_INLINE__) || (__GNUC__ == 4 && __GNUC_MINOR__ == 2) # define SCM_C_EXTERN_INLINE \ diff --git a/libguile/procs.c b/libguile/procs.c index 8a4b42646..f99b524d0 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -37,45 +37,20 @@ /* {Procedures} */ -scm_t_subr_entry *scm_subr_table; -/* libguile contained approx. 700 primitive procedures on 24 Aug 1999. */ - -/* Increased to 800 on 2001-05-07 -- Guile now has 779 primitives on - startup, 786 with guile-readline. 'martin */ - -static unsigned long scm_subr_table_size = 0; -static unsigned long scm_subr_table_room = 800; - -/* Hint for `scm_gc_malloc ()' and friends. */ -static const char subr_table_gc_hint[] = "subr table"; - -SCM +SCM scm_c_make_subr (const char *name, long type, SCM (*fcn) ()) { register SCM z; - unsigned long entry; + SCM *meta_info; - if (scm_subr_table_size == scm_subr_table_room) - { - long new_size = scm_subr_table_room * 3 / 2; - void *new_table - = scm_gc_realloc (scm_subr_table, - sizeof (* scm_subr_table) * scm_subr_table_room, - sizeof (* scm_subr_table) * new_size, - subr_table_gc_hint); - scm_subr_table = new_table; - scm_subr_table_room = new_size; - } + meta_info = scm_gc_malloc (2 * sizeof (*meta_info), "subr meta-info"); + meta_info[0] = scm_from_locale_symbol (name); + meta_info[1] = SCM_EOL; /* properties */ + + z = scm_double_cell ((scm_t_bits) type, (scm_t_bits) fcn, + 0 /* generic */, (scm_t_bits) meta_info); - entry = scm_subr_table_size; - z = scm_cell ((entry << 8) + type, (scm_t_bits) fcn); - scm_subr_table[entry].handle = z; - scm_subr_table[entry].name = scm_from_locale_symbol (name); - scm_subr_table[entry].generic = 0; - scm_subr_table[entry].properties = SCM_EOL; - scm_subr_table_size++; - return z; } @@ -83,7 +58,7 @@ SCM scm_c_define_subr (const char *name, long type, SCM (*fcn) ()) { SCM subr = scm_c_make_subr (name, type, fcn); - scm_define (SCM_SUBR_ENTRY(subr).name, subr); + scm_define (SCM_SNAME (subr), subr); return subr; } @@ -92,7 +67,7 @@ scm_c_make_subr_with_generic (const char *name, long type, SCM (*fcn) (), SCM *gf) { SCM subr = scm_c_make_subr (name, type, fcn); - SCM_SUBR_ENTRY(subr).generic = gf; + SCM_SET_SUBR_GENERIC_LOC (subr, gf); return subr; } @@ -101,7 +76,7 @@ scm_c_define_subr_with_generic (const char *name, long type, SCM (*fcn) (), SCM *gf) { SCM subr = scm_c_make_subr_with_generic (name, type, fcn, gf); - scm_define (SCM_SUBR_ENTRY(subr).name, subr); + scm_define (SCM_SNAME (subr), subr); return subr; } @@ -327,16 +302,7 @@ scm_setter (SCM proc) return SCM_BOOL_F; /* not reached */ } - -void -scm_init_subr_table () -{ - scm_subr_table - = ((scm_t_subr_entry *) - scm_gc_malloc (sizeof (* scm_subr_table) * scm_subr_table_room, - subr_table_gc_hint)); -} - + void scm_init_procs () { diff --git a/libguile/procs.h b/libguile/procs.h index 122187cb9..354d27179 100644 --- a/libguile/procs.h +++ b/libguile/procs.h @@ -30,23 +30,14 @@ /* Subrs */ -typedef struct -{ - SCM handle; /* link back to procedure object */ - SCM name; - SCM *generic; /* 0 if no generic support - * *generic == 0 until first method - */ - SCM properties; /* procedure properties */ -} scm_t_subr_entry; - -#define SCM_SUBRNUM(subr) (SCM_CELL_WORD_0 (subr) >> 8) -#define SCM_SUBR_ENTRY(x) (scm_subr_table[SCM_SUBRNUM (x)]) -#define SCM_SNAME(x) (SCM_SUBR_ENTRY (x).name) +#define SCM_SUBR_META_INFO(x) ((SCM *) SCM_CELL_WORD_3 (x)) +#define SCM_SNAME(x) (SCM_SUBR_META_INFO (x) [0]) #define SCM_SUBRF(x) ((SCM (*)()) SCM_CELL_WORD_1 (x)) #define SCM_DSUBRF(x) ((double (*)()) SCM_CELL_WORD_1 (x)) -#define SCM_SUBR_PROPS(x) (SCM_SUBR_ENTRY (x).properties) -#define SCM_SUBR_GENERIC(x) (SCM_SUBR_ENTRY (x).generic) +#define SCM_SUBR_PROPS(x) (SCM_SUBR_META_INFO (x) [1]) +#define SCM_SUBR_GENERIC(x) ((SCM *) SCM_CELL_WORD_2 (x)) +#define SCM_SET_SUBR_GENERIC(x, g) (*((SCM *) SCM_CELL_WORD_2 (x)) = (g)) +#define SCM_SET_SUBR_GENERIC_LOC(x, g) (SCM_SET_CELL_WORD_2 (x, (scm_t_bits) g)) #define SCM_CCLO_LENGTH(x) (SCM_CELL_WORD_0 (x) >> 8) #define SCM_MAKE_CCLO_TAG(v) (((v) << 8) + scm_tc7_cclo) @@ -124,10 +115,6 @@ typedef struct #define SCM_PROCEDURE(obj) SCM_CELL_OBJECT_1 (obj) #define SCM_SETTER(obj) SCM_CELL_OBJECT_2 (obj) -SCM_API scm_t_subr_entry *scm_subr_table; - - - SCM_API SCM scm_c_make_subr (const char *name, long type, SCM (*fcn)()); SCM_API SCM scm_c_make_subr_with_generic (const char *name, long type, SCM (*fcn)(), SCM *gf); @@ -144,7 +131,6 @@ SCM_API SCM scm_procedure_with_setter_p (SCM obj); SCM_API SCM scm_make_procedure_with_setter (SCM procedure, SCM setter); SCM_API SCM scm_procedure (SCM proc); SCM_API SCM scm_setter (SCM proc); -SCM_INTERNAL void scm_init_subr_table (void); SCM_INTERNAL void scm_init_procs (void); #ifdef GUILE_DEBUG diff --git a/libguile/threads.h b/libguile/threads.h index 9ce04e1ff..59c7c2c60 100644 --- a/libguile/threads.h +++ b/libguile/threads.h @@ -210,7 +210,7 @@ SCM_API int scm_pthread_cond_wait (pthread_cond_t *cond, pthread_mutex_t *mutex); SCM_API int scm_pthread_cond_timedwait (pthread_cond_t *cond, pthread_mutex_t *mutex, - const struct timespec *abstime); + const scm_t_timespec *abstime); #endif /* More convenience functions. |