mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-05 15:10:27 +02:00
Merge branch 'master' into boehm-demers-weiser-gc
Conflicts: libguile/gc-mark.c libguile/procs.c libguile/procs.h libguile/threads.c libguile/threads.h
This commit is contained in:
Ludovic Courtès
commit
f7a1ab8b94
17 changed files with 143 additions and 387 deletions
|
|
@ -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"
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 \
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue