diff options
-rw-r--r-- | libguile/array-map.c | 26 | ||||
-rw-r--r-- | libguile/goops.c | 1 | ||||
-rw-r--r-- | libguile/procprop.c | 1 | ||||
-rw-r--r-- | libguile/procs.h | 1 | ||||
-rw-r--r-- | libguile/tags.h | 3 | ||||
-rw-r--r-- | libguile/vm.c | 12 |
6 files changed, 1 insertions, 43 deletions
diff --git a/libguile/array-map.c b/libguile/array-map.c index 89e6ec987..72009985c 100644 --- a/libguile/array-map.c +++ b/libguile/array-map.c @@ -698,27 +698,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 ramap_rp (SCM ra0, SCM proc, SCM ras) { SCM ra1 = SCM_CAR (ras), ra2 = SCM_CAR (SCM_CDR (ras)); @@ -817,11 +796,6 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1, gencase: scm_ramapc (ramap, proc, ra0, lra, FUNC_NAME); 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: { ra_iproc *p; diff --git a/libguile/goops.c b/libguile/goops.c index a9210149e..7ce5b3173 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -226,7 +226,6 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0, return scm_class_fraction; } case scm_tc7_asubr: - case scm_tc7_dsubr: case scm_tc7_cxr: case scm_tc7_rpsubr: case scm_tc7_gsubr: diff --git a/libguile/procprop.c b/libguile/procprop.c index 052e5a0c7..a92d31c22 100644 --- a/libguile/procprop.c +++ b/libguile/procprop.c @@ -53,7 +53,6 @@ scm_i_procedure_arity (SCM proc) loop: switch (SCM_TYP7 (proc)) { - case scm_tc7_dsubr: case scm_tc7_cxr: a += 1; break; diff --git a/libguile/procs.h b/libguile/procs.h index e993c8f09..369d9e142 100644 --- a/libguile/procs.h +++ b/libguile/procs.h @@ -34,7 +34,6 @@ #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_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_GENERIC(x) ((SCM *) SCM_CELL_WORD_2 (x)) #define SCM_SET_SUBR_GENERIC(x, g) (*((SCM *) SCM_CELL_WORD_2 (x)) = (g)) diff --git a/libguile/tags.h b/libguile/tags.h index 217aa1516..2a9fc4b2f 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -425,7 +425,7 @@ typedef scm_t_uintptr scm_t_bits; #define scm_tc7_unused_6 55 #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_rpsubr 69 #define scm_tc7_program 79 @@ -676,7 +676,6 @@ enum scm_tc8_tags */ #define scm_tcs_subrs \ scm_tc7_asubr:\ - case scm_tc7_dsubr:\ case scm_tc7_cxr:\ case scm_tc7_rpsubr:\ case scm_tc7_gsubr diff --git a/libguile/vm.c b/libguile/vm.c index a05494f5b..67b5614a8 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -296,18 +296,6 @@ apply_foreign (SCM proc, SCM *args, int nargs, int headroom) arglist = scm_cons (args[nargs], 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: if (nargs != 1) scm_wrong_num_args (proc); return scm_i_chase_pairs (arg1, (scm_t_bits) SCM_SUBRF (proc)); |