1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-15 08:10:17 +02:00

remove scm_tc7_dsubr

* libguile/tags.h: Remove scm_tc7_dsubr. There are no more users of
  this.

* libguile/array-map.c:
* libguile/eval.c:
* libguile/eval.i.c:
* libguile/goops.c:
* libguile/procprop.c:
* libguile/procs.h: Remove all dsubr cases.
This commit is contained in:
Andy Wingo 2009-09-06 13:51:31 +02:00
parent d84765da44
commit b04ab0c624
6 changed files with 1 additions and 43 deletions

View file

@ -697,27 +697,6 @@ ramap (SCM ra0, SCM proc, SCM ras)
} }
static int
ramap_dsubr (SCM ra0, SCM proc, SCM ras)
{
SCM ra1 = SCM_CAR (ras);
unsigned long i0 = SCM_I_ARRAY_BASE (ra0), i1 = SCM_I_ARRAY_BASE (ra1);
long inc0 = SCM_I_ARRAY_DIMS (ra0)->inc, inc1 = SCM_I_ARRAY_DIMS (ra1)->inc;
long n = SCM_I_ARRAY_DIMS (ra0)->ubnd - SCM_I_ARRAY_DIMS (ra1)->lbnd + 1;
ra0 = SCM_I_ARRAY_V (ra0);
ra1 = SCM_I_ARRAY_V (ra1);
switch (SCM_TYP7 (ra0))
{
default:
for (; n-- > 0; i0 += inc0, i1 += inc1)
GVSET (ra0, i0, scm_call_1 (proc, GVREF (ra1, i1)));
break;
}
return 1;
}
static int static int
ramap_rp (SCM ra0, SCM proc, SCM ras) ramap_rp (SCM ra0, SCM proc, SCM ras)
{ {
@ -817,11 +796,6 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
gencase: gencase:
scm_ramapc (ramap, proc, ra0, lra, FUNC_NAME); scm_ramapc (ramap, proc, ra0, lra, FUNC_NAME);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
case scm_tc7_dsubr:
if (! scm_is_pair (lra))
SCM_WRONG_NUM_ARGS (); /* need 1 source */
scm_ramapc (ramap_dsubr, proc, ra0, lra, FUNC_NAME);
return SCM_UNSPECIFIED;
case scm_tc7_rpsubr: case scm_tc7_rpsubr:
{ {
ra_iproc *p; ra_iproc *p;

View file

@ -226,7 +226,6 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
return scm_class_fraction; return scm_class_fraction;
} }
case scm_tc7_asubr: case scm_tc7_asubr:
case scm_tc7_dsubr:
case scm_tc7_cxr: case scm_tc7_cxr:
case scm_tc7_rpsubr: case scm_tc7_rpsubr:
case scm_tc7_gsubr: case scm_tc7_gsubr:

View file

@ -53,7 +53,6 @@ scm_i_procedure_arity (SCM proc)
loop: loop:
switch (SCM_TYP7 (proc)) switch (SCM_TYP7 (proc))
{ {
case scm_tc7_dsubr:
case scm_tc7_cxr: case scm_tc7_cxr:
a += 1; a += 1;
break; break;

View file

@ -34,7 +34,6 @@
#define SCM_SUBR_META_INFO(x) ((SCM *) SCM_CELL_WORD_3 (x)) #define SCM_SUBR_META_INFO(x) ((SCM *) SCM_CELL_WORD_3 (x))
#define SCM_SUBR_NAME(x) (SCM_SUBR_META_INFO (x) [0]) #define SCM_SUBR_NAME(x) (SCM_SUBR_META_INFO (x) [0])
#define SCM_SUBRF(x) ((SCM (*)()) SCM_CELL_WORD_1 (x)) #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_META_INFO (x) [1]) #define SCM_SUBR_PROPS(x) (SCM_SUBR_META_INFO (x) [1])
#define SCM_SUBR_GENERIC(x) ((SCM *) SCM_CELL_WORD_2 (x)) #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(x, g) (*((SCM *) SCM_CELL_WORD_2 (x)) = (g))

View file

@ -425,7 +425,7 @@ typedef scm_t_uintptr scm_t_bits;
#define scm_tc7_unused_6 55 #define scm_tc7_unused_6 55
#define scm_tc7_unused_7 71 #define scm_tc7_unused_7 71
#define scm_tc7_dsubr 61 #define scm_tc7_unused_17 61
#define scm_tc7_gsubr 63 #define scm_tc7_gsubr 63
#define scm_tc7_rpsubr 69 #define scm_tc7_rpsubr 69
#define scm_tc7_program 79 #define scm_tc7_program 79
@ -676,7 +676,6 @@ enum scm_tc8_tags
*/ */
#define scm_tcs_subrs \ #define scm_tcs_subrs \
scm_tc7_asubr:\ scm_tc7_asubr:\
case scm_tc7_dsubr:\
case scm_tc7_cxr:\ case scm_tc7_cxr:\
case scm_tc7_rpsubr:\ case scm_tc7_rpsubr:\
case scm_tc7_gsubr case scm_tc7_gsubr

View file

@ -296,18 +296,6 @@ apply_foreign (SCM proc, SCM *args, int nargs, int headroom)
arglist = scm_cons (args[nargs], arglist); arglist = scm_cons (args[nargs], arglist);
return scm_closure_apply (proc, arglist); return scm_closure_apply (proc, arglist);
} }
case scm_tc7_dsubr:
if (nargs != 1) scm_wrong_num_args (proc);
if (SCM_I_INUMP (arg1))
return scm_from_double (SCM_DSUBRF (proc) ((double) SCM_I_INUM (arg1)));
else if (SCM_REALP (arg1))
return scm_from_double (SCM_DSUBRF (proc) (SCM_REAL_VALUE (arg1)));
else if (SCM_BIGP (arg1))
return scm_from_double (SCM_DSUBRF (proc) (scm_i_big2dbl (arg1)));
else if (SCM_FRACTIONP (arg1))
return scm_from_double (SCM_DSUBRF (proc) (scm_i_fraction2double (arg1)));
SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
SCM_ARG1, scm_i_symbol_chars (SCM_SUBR_NAME (proc)));
case scm_tc7_cxr: case scm_tc7_cxr:
if (nargs != 1) scm_wrong_num_args (proc); if (nargs != 1) scm_wrong_num_args (proc);
return scm_i_chase_pairs (arg1, (scm_t_bits) SCM_SUBRF (proc)); return scm_i_chase_pairs (arg1, (scm_t_bits) SCM_SUBRF (proc));