1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-06 15:40:29 +02:00

Use double-cells to store subrs.

* libguile/procs.c (scm_subr_table, scm_subr_table_size,
  scm_subr_table_room, subr_table_gc_hint, scm_init_subr_table): Remove.
  (scm_c_make_subr): Simply return a double-cell, with the procedure
  name and properties stored in a two-element array.

* libguile/init.c (scm_i_init_guile): Remove call to
  `scm_init_subr_table ()'.

* libguile/procs.h (SCM_SUBR_META_INFO): New macro.
  (SCM_SNAME, SCM_SUBR_PROPS): Use it.
  (SCM_SUBR_GENERIC, SCM_SET_SUBR_GENERIC, SCM_SET_SUBR_GENERIC_LOC):
  Update.
  (scm_t_subr_entry, SCM_SUBR_ENTRY, SCM_SUBRNUM, scm_subr_table,
  scm_init_subr_table): Remove.
This commit is contained in:
Ludovic Courtès 2009-01-21 00:24:44 +01:00
parent 499b5dfa3e
commit 2ee5aa25db
3 changed files with 17 additions and 59 deletions

View file

@ -37,45 +37,26 @@
/* {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;
}
@ -327,16 +308,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 ()
{