mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 11:50:28 +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, scm_mark_subr_table): Remove. (scm_c_make_subr): Simply return a double-cell, with the procedure name and properties stored in a two-element array. (scm_free_subr_entry): Free the meta-info slot. * 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_mark_subr_table, scm_init_subr_table): Remove.
This commit is contained in:
Ludovic Courtès
parent
feccd2d310
commit
ac51e74b95
4 changed files with 21 additions and 79 deletions
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2004, 2005, 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
|
||||
|
|
@ -99,8 +99,6 @@ scm_mark_all (void)
|
|||
}
|
||||
}
|
||||
}
|
||||
|
||||
scm_mark_subr_table ();
|
||||
|
||||
loops = 0;
|
||||
while (1)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -444,7 +444,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
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
/* Copyright (C) 1995,1996,1997,1999,2000,2001, 2006, 2008 Free Software Foundation, Inc.
|
||||
/* Copyright (C) 1995,1996,1997,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
|
||||
|
|
@ -37,40 +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;
|
||||
|
||||
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_realloc ((char *) scm_subr_table,
|
||||
sizeof (scm_t_subr_entry) * new_size);
|
||||
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;
|
||||
}
|
||||
|
||||
|
|
@ -87,11 +73,8 @@ scm_c_define_subr (const char *name, long type, SCM (*fcn) ())
|
|||
void
|
||||
scm_free_subr_entry (SCM subr)
|
||||
{
|
||||
long entry = SCM_SUBRNUM (subr);
|
||||
/* Move last entry in table to the free position */
|
||||
scm_subr_table[entry] = scm_subr_table[scm_subr_table_size - 1];
|
||||
SCM_SET_SUBRNUM (scm_subr_table[entry].handle, entry);
|
||||
scm_subr_table_size--;
|
||||
scm_gc_free (SCM_SUBR_META_INFO (subr), 2 * sizeof (SCM),
|
||||
"subr meta-info");
|
||||
}
|
||||
|
||||
SCM
|
||||
|
|
@ -112,20 +95,6 @@ scm_c_define_subr_with_generic (const char *name,
|
|||
return subr;
|
||||
}
|
||||
|
||||
void
|
||||
scm_mark_subr_table ()
|
||||
{
|
||||
long i;
|
||||
for (i = 0; i < scm_subr_table_size; ++i)
|
||||
{
|
||||
scm_gc_mark (scm_subr_table[i].name);
|
||||
if (scm_subr_table[i].generic && *scm_subr_table[i].generic)
|
||||
scm_gc_mark (*scm_subr_table[i].generic);
|
||||
if (SCM_NIMP (scm_subr_table[i].properties))
|
||||
scm_gc_mark (scm_subr_table[i].properties);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#ifdef CCLO
|
||||
SCM
|
||||
|
|
@ -348,15 +317,7 @@ scm_setter (SCM proc)
|
|||
return SCM_BOOL_F; /* not reached */
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
scm_init_subr_table ()
|
||||
{
|
||||
scm_subr_table
|
||||
= ((scm_t_subr_entry *)
|
||||
scm_malloc (sizeof (scm_t_subr_entry) * scm_subr_table_room));
|
||||
}
|
||||
|
||||
|
||||
void
|
||||
scm_init_procs ()
|
||||
{
|
||||
|
|
|
|||
|
|
@ -30,28 +30,15 @@
|
|||
/* 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_SET_SUBRNUM(subr, num) \
|
||||
SCM_SET_CELL_WORD_0 (subr, (num << 8) + SCM_TYP7 (subr))
|
||||
#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_SET_SUBRF(x, v) (SCM_SET_CELL_WORD_1 ((x), (v)))
|
||||
#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_SET_SUBR_GENERIC(x, g) (*SCM_SUBR_ENTRY (x).generic = (g))
|
||||
#define SCM_SET_SUBR_GENERIC_LOC(x, g) (SCM_SUBR_ENTRY (x).generic = (g))
|
||||
#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)
|
||||
|
|
@ -132,11 +119,9 @@ 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 void scm_mark_subr_table (void);
|
||||
SCM_API void scm_free_subr_entry (SCM subr);
|
||||
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,
|
||||
|
|
@ -154,7 +139,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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue