summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/ChangeLog24
-rw-r--r--libguile/eval.c126
-rw-r--r--libguile/numbers.c42
-rw-r--r--libguile/objects.c1
-rw-r--r--libguile/pairs.c82
-rw-r--r--libguile/procprop.c1
-rw-r--r--libguile/ramap.c8
-rw-r--r--libguile/tags.h18
8 files changed, 174 insertions, 128 deletions
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 8ca5464ac..22d4df0ef 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,27 @@
+2003-06-01 Dirk Herrmann <D.Herrmann@tu-bs.de>
+
+ This set of patches separates the representation of the cxr family
+ of functions (car, cdr etc.) from the dsubr family of functions
+ (i. e. functions that take a double precision floating point
+ argument). Further, the algorithm for handling the cxr function
+ is improved.
+
+ * eval.c (SCM_CEVAL, SCM_APPLY, scm_trampoline_1), numbers.c
+ (scm_asinh, scm_acosh, scm_atanh, scm_truncate, scm_round, floor,
+ ceil, sqrt, fabs, exp, log, sin, cos, tan, asin, acos, atan, sinh,
+ cosh, tanh), objects.c (scm_class_of), procprop.c
+ (scm_i_procedure_arity), ramap.c (scm_array_map_x), tags.h
+ (scm_tc7_dsubr, scm_tcs_subrs): Introduce scm_tc7_dsubr as new
+ typecode for the dsubr family of functions.
+
+ * ramap.c (ramap_cxr, ramap_dsubr): Renamed ramap_cxr to
+ ramap_dsubr.
+
+ * eval.c (SCM_CEVAL, SCM_APPLY, call_cxr_1), pairs.c
+ (scm_init_pairs): Make use of the (now usable) second cell element
+ of a scm_tc7_cxr function to implement the cxr family of functions
+ more efficiently.
+
2003-05-31 Dirk Herrmann <D.Herrmann@tu-bs.de>
* eval.c (SCM_CEVAL, SCM_APPLY, scm_trampoline_0,
diff --git a/libguile/eval.c b/libguile/eval.c
index 3910de8a2..66c53321c 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -2885,6 +2885,7 @@ evapply: /* inputs: x, proc */
case scm_tc7_subr_1:
case scm_tc7_subr_2:
case scm_tc7_subr_2o:
+ case scm_tc7_dsubr:
case scm_tc7_cxr:
case scm_tc7_subr_3:
case scm_tc7_lsubr_2:
@@ -2921,33 +2922,31 @@ evapply: /* inputs: x, proc */
case scm_tc7_subr_1:
case scm_tc7_subr_1o:
RETURN (SCM_SUBRF (proc) (arg1));
+ case scm_tc7_dsubr:
+ if (SCM_INUMP (arg1))
+ {
+ RETURN (scm_make_real (SCM_DSUBRF (proc) ((double) SCM_INUM (arg1))));
+ }
+ else if (SCM_REALP (arg1))
+ {
+ RETURN (scm_make_real (SCM_DSUBRF (proc) (SCM_REAL_VALUE (arg1))));
+ }
+ else if (SCM_BIGP (arg1))
+ {
+ RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_i_big2dbl (arg1))));
+ }
+ SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
+ SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
case scm_tc7_cxr:
- if (SCM_SUBRF (proc))
- {
- if (SCM_INUMP (arg1))
- {
- RETURN (scm_make_real (SCM_DSUBRF (proc) ((double) SCM_INUM (arg1))));
- }
- else if (SCM_REALP (arg1))
- {
- RETURN (scm_make_real (SCM_DSUBRF (proc) (SCM_REAL_VALUE (arg1))));
- }
- else if (SCM_BIGP (arg1))
- {
- RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_i_big2dbl (arg1))));
- }
- SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
- SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
- }
- proc = SCM_SNAME (proc);
{
- char *chrs = SCM_SYMBOL_CHARS (proc) + SCM_SYMBOL_LENGTH (proc) - 1;
- while ('c' != *--chrs)
- {
- SCM_ASSERT (SCM_CONSP (arg1),
- arg1, SCM_ARG1, SCM_SYMBOL_CHARS (proc));
- arg1 = ('a' == *chrs) ? SCM_CAR (arg1) : SCM_CDR (arg1);
- }
+ unsigned char pattern = (scm_t_bits) SCM_SUBRF (proc);
+ do
+ {
+ SCM_ASSERT (SCM_CONSP (arg1), arg1, SCM_ARG1,
+ SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
+ arg1 = (pattern & 1) ? SCM_CAR (arg1) : SCM_CDR (arg1);
+ pattern >>= 2;
+ } while (pattern);
RETURN (arg1);
}
case scm_tc7_rpsubr:
@@ -3119,6 +3118,7 @@ evapply: /* inputs: x, proc */
else
goto badfun;
case scm_tc7_subr_0:
+ case scm_tc7_dsubr:
case scm_tc7_cxr:
case scm_tc7_subr_1o:
case scm_tc7_subr_1:
@@ -3317,6 +3317,7 @@ evapply: /* inputs: x, proc */
case scm_tc7_subr_1o:
case scm_tc7_subr_2o:
case scm_tc7_subr_0:
+ case scm_tc7_dsubr:
case scm_tc7_cxr:
case scm_tc7_subr_1:
scm_wrong_num_args (proc);
@@ -3602,34 +3603,34 @@ tail:
scm_wrong_num_args (proc);
else
RETURN (SCM_SUBRF (proc) (arg1));
+ case scm_tc7_dsubr:
+ if (SCM_UNBNDP (arg1) || !SCM_NULLP (args))
+ scm_wrong_num_args (proc);
+ if (SCM_INUMP (arg1))
+ {
+ RETURN (scm_make_real (SCM_DSUBRF (proc) ((double) SCM_INUM (arg1))));
+ }
+ else if (SCM_REALP (arg1))
+ {
+ RETURN (scm_make_real (SCM_DSUBRF (proc) (SCM_REAL_VALUE (arg1))));
+ }
+ else if (SCM_BIGP (arg1))
+ RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_i_big2dbl (arg1))));
+ SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
+ SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
case scm_tc7_cxr:
if (SCM_UNBNDP (arg1) || !SCM_NULLP (args))
scm_wrong_num_args (proc);
- if (SCM_SUBRF (proc))
- {
- if (SCM_INUMP (arg1))
- {
- RETURN (scm_make_real (SCM_DSUBRF (proc) ((double) SCM_INUM (arg1))));
- }
- else if (SCM_REALP (arg1))
- {
- RETURN (scm_make_real (SCM_DSUBRF (proc) (SCM_REAL_VALUE (arg1))));
- }
- else if (SCM_BIGP (arg1))
- RETURN (scm_make_real (SCM_DSUBRF (proc) (scm_i_big2dbl (arg1))));
- SCM_WTA_DISPATCH_1 (*SCM_SUBR_GENERIC (proc), arg1,
- SCM_ARG1, SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
- }
- proc = SCM_SNAME (proc);
{
- char *chrs = SCM_SYMBOL_CHARS (proc) + SCM_SYMBOL_LENGTH (proc) - 1;
- while ('c' != *--chrs)
- {
- SCM_ASSERT (SCM_CONSP (arg1),
- arg1, SCM_ARG1, SCM_SYMBOL_CHARS (proc));
- arg1 = ('a' == *chrs) ? SCM_CAR (arg1) : SCM_CDR (arg1);
- }
- RETURN (arg1);
+ unsigned char pattern = (scm_t_bits) SCM_SUBRF (proc);
+ do
+ {
+ SCM_ASSERT (SCM_CONSP (arg1), arg1, SCM_ARG1,
+ SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
+ arg1 = (pattern & 1) ? SCM_CAR (arg1) : SCM_CDR (arg1);
+ pattern >>= 2;
+ } while (pattern);
+ RETURN (arg1);
}
case scm_tc7_subr_3:
if (SCM_NULLP (args)
@@ -3951,17 +3952,15 @@ call_dsubr_1 (SCM proc, SCM arg1)
static SCM
call_cxr_1 (SCM proc, SCM arg1)
{
- proc = SCM_SNAME (proc);
- {
- char *chrs = SCM_SYMBOL_CHARS (proc) + SCM_SYMBOL_LENGTH (proc) - 1;
- while ('c' != *--chrs)
- {
- SCM_ASSERT (SCM_CONSP (arg1),
- arg1, SCM_ARG1, SCM_SYMBOL_CHARS (proc));
- arg1 = ('a' == *chrs) ? SCM_CAR (arg1) : SCM_CDR (arg1);
- }
- return (arg1);
- }
+ unsigned char pattern = (scm_t_bits) SCM_SUBRF (proc);
+ do
+ {
+ SCM_ASSERT (SCM_CONSP (arg1), arg1, SCM_ARG1,
+ SCM_SYMBOL_CHARS (SCM_SNAME (proc)));
+ arg1 = (pattern & 1) ? SCM_CAR (arg1) : SCM_CDR (arg1);
+ pattern >>= 2;
+ } while (pattern);
+ return arg1;
}
static SCM
@@ -3990,11 +3989,10 @@ scm_trampoline_1 (SCM proc)
return call_subr2o_1;
case scm_tc7_lsubr:
return call_lsubr_1;
+ case scm_tc7_dsubr:
+ return call_dsubr_1;
case scm_tc7_cxr:
- if (SCM_SUBRF (proc))
- return call_dsubr_1;
- else
- return call_cxr_1;
+ return call_cxr_1;
case scm_tcs_closures:
{
SCM formals = SCM_CLOSURE_FORMALS (proc);
diff --git a/libguile/numbers.c b/libguile/numbers.c
index 0fd62c97c..86126626e 100644
--- a/libguile/numbers.c
+++ b/libguile/numbers.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002, 2003 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003 Free Software Foundation, Inc.
*
* Portions Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories
* and Bellcore. See scm_divide.
@@ -3613,7 +3613,7 @@ scm_divide (SCM x, SCM y)
}
#undef FUNC_NAME
-SCM_GPROC1 (s_asinh, "$asinh", scm_tc7_cxr, (SCM (*)()) scm_asinh, g_asinh);
+SCM_GPROC1 (s_asinh, "$asinh", scm_tc7_dsubr, (SCM (*)()) scm_asinh, g_asinh);
/* "Return the inverse hyperbolic sine of @var{x}."
*/
double
@@ -3623,7 +3623,7 @@ scm_asinh (double x)
}
-SCM_GPROC1 (s_acosh, "$acosh", scm_tc7_cxr, (SCM (*)()) scm_acosh, g_acosh);
+SCM_GPROC1 (s_acosh, "$acosh", scm_tc7_dsubr, (SCM (*)()) scm_acosh, g_acosh);
/* "Return the inverse hyperbolic cosine of @var{x}."
*/
double
@@ -3633,7 +3633,7 @@ scm_acosh (double x)
}
-SCM_GPROC1 (s_atanh, "$atanh", scm_tc7_cxr, (SCM (*)()) scm_atanh, g_atanh);
+SCM_GPROC1 (s_atanh, "$atanh", scm_tc7_dsubr, (SCM (*)()) scm_atanh, g_atanh);
/* "Return the inverse hyperbolic tangent of @var{x}."
*/
double
@@ -3643,7 +3643,7 @@ scm_atanh (double x)
}
-SCM_GPROC1 (s_truncate, "truncate", scm_tc7_cxr, (SCM (*)()) scm_truncate, g_truncate);
+SCM_GPROC1 (s_truncate, "truncate", scm_tc7_dsubr, (SCM (*)()) scm_truncate, g_truncate);
/* "Round the inexact number @var{x} towards zero."
*/
double
@@ -3655,7 +3655,7 @@ scm_truncate (double x)
}
-SCM_GPROC1 (s_round, "round", scm_tc7_cxr, (SCM (*)()) scm_round, g_round);
+SCM_GPROC1 (s_round, "round", scm_tc7_dsubr, (SCM (*)()) scm_round, g_round);
/* "Round the inexact number @var{x}. If @var{x} is halfway between two\n"
* "numbers, round towards even."
*/
@@ -3670,49 +3670,49 @@ scm_round (double x)
}
-SCM_GPROC1 (s_i_floor, "floor", scm_tc7_cxr, (SCM (*)()) floor, g_i_floor);
+SCM_GPROC1 (s_i_floor, "floor", scm_tc7_dsubr, (SCM (*)()) floor, g_i_floor);
/* "Round the number @var{x} towards minus infinity."
*/
-SCM_GPROC1 (s_i_ceil, "ceiling", scm_tc7_cxr, (SCM (*)()) ceil, g_i_ceil);
+SCM_GPROC1 (s_i_ceil, "ceiling", scm_tc7_dsubr, (SCM (*)()) ceil, g_i_ceil);
/* "Round the number @var{x} towards infinity."
*/
-SCM_GPROC1 (s_i_sqrt, "$sqrt", scm_tc7_cxr, (SCM (*)()) sqrt, g_i_sqrt);
+SCM_GPROC1 (s_i_sqrt, "$sqrt", scm_tc7_dsubr, (SCM (*)()) sqrt, g_i_sqrt);
/* "Return the square root of the real number @var{x}."
*/
-SCM_GPROC1 (s_i_abs, "$abs", scm_tc7_cxr, (SCM (*)()) fabs, g_i_abs);
+SCM_GPROC1 (s_i_abs, "$abs", scm_tc7_dsubr, (SCM (*)()) fabs, g_i_abs);
/* "Return the absolute value of the real number @var{x}."
*/
-SCM_GPROC1 (s_i_exp, "$exp", scm_tc7_cxr, (SCM (*)()) exp, g_i_exp);
+SCM_GPROC1 (s_i_exp, "$exp", scm_tc7_dsubr, (SCM (*)()) exp, g_i_exp);
/* "Return the @var{x}th power of e."
*/
-SCM_GPROC1 (s_i_log, "$log", scm_tc7_cxr, (SCM (*)()) log, g_i_log);
+SCM_GPROC1 (s_i_log, "$log", scm_tc7_dsubr, (SCM (*)()) log, g_i_log);
/* "Return the natural logarithm of the real number @var{x}."
*/
-SCM_GPROC1 (s_i_sin, "$sin", scm_tc7_cxr, (SCM (*)()) sin, g_i_sin);
+SCM_GPROC1 (s_i_sin, "$sin", scm_tc7_dsubr, (SCM (*)()) sin, g_i_sin);
/* "Return the sine of the real number @var{x}."
*/
-SCM_GPROC1 (s_i_cos, "$cos", scm_tc7_cxr, (SCM (*)()) cos, g_i_cos);
+SCM_GPROC1 (s_i_cos, "$cos", scm_tc7_dsubr, (SCM (*)()) cos, g_i_cos);
/* "Return the cosine of the real number @var{x}."
*/
-SCM_GPROC1 (s_i_tan, "$tan", scm_tc7_cxr, (SCM (*)()) tan, g_i_tan);
+SCM_GPROC1 (s_i_tan, "$tan", scm_tc7_dsubr, (SCM (*)()) tan, g_i_tan);
/* "Return the tangent of the real number @var{x}."
*/
-SCM_GPROC1 (s_i_asin, "$asin", scm_tc7_cxr, (SCM (*)()) asin, g_i_asin);
+SCM_GPROC1 (s_i_asin, "$asin", scm_tc7_dsubr, (SCM (*)()) asin, g_i_asin);
/* "Return the arc sine of the real number @var{x}."
*/
-SCM_GPROC1 (s_i_acos, "$acos", scm_tc7_cxr, (SCM (*)()) acos, g_i_acos);
+SCM_GPROC1 (s_i_acos, "$acos", scm_tc7_dsubr, (SCM (*)()) acos, g_i_acos);
/* "Return the arc cosine of the real number @var{x}."
*/
-SCM_GPROC1 (s_i_atan, "$atan", scm_tc7_cxr, (SCM (*)()) atan, g_i_atan);
+SCM_GPROC1 (s_i_atan, "$atan", scm_tc7_dsubr, (SCM (*)()) atan, g_i_atan);
/* "Return the arc tangent of the real number @var{x}."
*/
-SCM_GPROC1 (s_i_sinh, "$sinh", scm_tc7_cxr, (SCM (*)()) sinh, g_i_sinh);
+SCM_GPROC1 (s_i_sinh, "$sinh", scm_tc7_dsubr, (SCM (*)()) sinh, g_i_sinh);
/* "Return the hyperbolic sine of the real number @var{x}."
*/
-SCM_GPROC1 (s_i_cosh, "$cosh", scm_tc7_cxr, (SCM (*)()) cosh, g_i_cosh);
+SCM_GPROC1 (s_i_cosh, "$cosh", scm_tc7_dsubr, (SCM (*)()) cosh, g_i_cosh);
/* "Return the hyperbolic cosine of the real number @var{x}."
*/
-SCM_GPROC1 (s_i_tanh, "$tanh", scm_tc7_cxr, (SCM (*)()) tanh, g_i_tanh);
+SCM_GPROC1 (s_i_tanh, "$tanh", scm_tc7_dsubr, (SCM (*)()) tanh, g_i_tanh);
/* "Return the hyperbolic tangent of the real number @var{x}."
*/
diff --git a/libguile/objects.c b/libguile/objects.c
index 171f06fae..0f4443cd8 100644
--- a/libguile/objects.c
+++ b/libguile/objects.c
@@ -112,6 +112,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
case scm_tc7_asubr:
case scm_tc7_subr_0:
case scm_tc7_subr_1:
+ case scm_tc7_dsubr:
case scm_tc7_cxr:
case scm_tc7_subr_3:
case scm_tc7_subr_2:
diff --git a/libguile/pairs.c b/libguile/pairs.c
index a3baa743a..8d6d36e9b 100644
--- a/libguile/pairs.c
+++ b/libguile/pairs.c
@@ -106,39 +106,50 @@ SCM_DEFINE (scm_set_cdr_x, "set-cdr!", 2, 0, 0,
-static const char * cxrs[] =
+/* Every cxr-pattern is made up of pairs of bits, starting with the two least
+ * significant bits. If in a pair of bits the least significant of the two
+ * bits is 0, this means CDR, otherwise CAR. The most significant bits of the
+ * two bits is only needed to indicate when cxr-ing is ready. This is the
+ * case, when all remaining pairs of bits equal 00. */
+
+typedef struct {
+ const char *name;
+ unsigned char pattern;
+} t_cxr;
+
+static const t_cxr cxrs[] =
{
- "car",
- "cdr",
- "caar",
- "cadr",
- "cdar",
- "cddr",
- "caaar",
- "caadr",
- "cadar",
- "caddr",
- "cdaar",
- "cdadr",
- "cddar",
- "cdddr",
- "caaaar",
- "caaadr",
- "caadar",
- "caaddr",
- "cadaar",
- "cadadr",
- "caddar",
- "cadddr",
- "cdaaar",
- "cdaadr",
- "cdadar",
- "cdaddr",
- "cddaar",
- "cddadr",
- "cdddar",
- "cddddr",
- 0
+ {"cdr", 0x02}, /* 00000010 */
+ {"car", 0x03}, /* 00000011 */
+ {"cddr", 0x0a}, /* 00001010 */
+ {"cdar", 0x0b}, /* 00001011 */
+ {"cadr", 0x0e}, /* 00001110 */
+ {"caar", 0x0f}, /* 00001111 */
+ {"cdddr", 0x2a}, /* 00101010 */
+ {"cddar", 0x2b}, /* 00101011 */
+ {"cdadr", 0x2e}, /* 00101110 */
+ {"cdaar", 0x2f}, /* 00101111 */
+ {"caddr", 0x3a}, /* 00111010 */
+ {"cadar", 0x3b}, /* 00111011 */
+ {"caadr", 0x3e}, /* 00111110 */
+ {"caaar", 0x3f}, /* 00111111 */
+ {"cddddr", 0xaa}, /* 10101010 */
+ {"cdddar", 0xab}, /* 10101011 */
+ {"cddadr", 0xae}, /* 10101110 */
+ {"cddaar", 0xaf}, /* 10101111 */
+ {"cdaddr", 0xba}, /* 10111010 */
+ {"cdadar", 0xbb}, /* 10111011 */
+ {"cdaadr", 0xbe}, /* 10111110 */
+ {"cdaaar", 0xbf}, /* 10111111 */
+ {"cadddr", 0xea}, /* 11101010 */
+ {"caddar", 0xeb}, /* 11101011 */
+ {"cadadr", 0xee}, /* 11101110 */
+ {"cadaar", 0xef}, /* 11101111 */
+ {"caaddr", 0xfa}, /* 11111010 */
+ {"caadar", 0xfb}, /* 11111011 */
+ {"caaadr", 0xfe}, /* 11111110 */
+ {"caaaar", 0xff}, /* 11111111 */
+ {0, 0}
};
@@ -148,8 +159,11 @@ scm_init_pairs ()
{
unsigned int subnr = 0;
- for (subnr = 0; cxrs [subnr]; subnr++)
- scm_c_define_subr (cxrs [subnr], scm_tc7_cxr, NULL);
+ for (subnr = 0; cxrs[subnr].name; subnr++)
+ {
+ SCM (*pattern) () = (SCM (*) ()) (scm_t_bits) cxrs[subnr].pattern;
+ scm_c_define_subr (cxrs[subnr].name, scm_tc7_cxr, pattern);
+ }
#include "libguile/pairs.x"
}
diff --git a/libguile/procprop.c b/libguile/procprop.c
index 2a3177a6d..4632182d6 100644
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -52,6 +52,7 @@ scm_i_procedure_arity (SCM proc)
case scm_tc7_subr_2o:
o = 1;
case scm_tc7_subr_1:
+ case scm_tc7_dsubr:
case scm_tc7_cxr:
a += 1;
break;
diff --git a/libguile/ramap.c b/libguile/ramap.c
index 47ef69eb3..40034bb48 100644
--- a/libguile/ramap.c
+++ b/libguile/ramap.c
@@ -1247,7 +1247,7 @@ ramap (SCM ra0, SCM proc, SCM ras)
static int
-ramap_cxr (SCM ra0, SCM proc, SCM ras)
+ramap_dsubr (SCM ra0, SCM proc, SCM ras)
{
SCM ra1 = SCM_CAR (ras);
SCM e1 = SCM_UNDEFINED;
@@ -1514,10 +1514,8 @@ SCM_DEFINE (scm_array_map_x, "array-map!", 2, 0, 1,
case scm_tc7_subr_2o:
scm_ramapc (ramap_2o, proc, ra0, lra, FUNC_NAME);
return SCM_UNSPECIFIED;
- case scm_tc7_cxr:
- if (!SCM_SUBRF (proc))
- goto gencase;
- scm_ramapc (ramap_cxr, proc, ra0, lra, FUNC_NAME);
+ case scm_tc7_dsubr:
+ scm_ramapc (ramap_dsubr, proc, ra0, lra, FUNC_NAME);
return SCM_UNSPECIFIED;
case scm_tc7_rpsubr:
{
diff --git a/libguile/tags.h b/libguile/tags.h
index ef2aaf567..5e041114e 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -319,7 +319,7 @@ typedef unsigned long scm_t_bits;
#define scm_tc7_ivect 79
#endif
-/* free 61 */
+#define scm_tc7_dsubr 61
#define scm_tc7_cclo 63
#define scm_tc7_rpsubr 69
#define scm_tc7_subr_0 85
@@ -497,9 +497,19 @@ SCM_API char *scm_isymnames[]; /* defined in print.c */
/* For subrs
*/
-#define scm_tcs_subrs scm_tc7_asubr:case scm_tc7_subr_0:case scm_tc7_subr_1:case scm_tc7_cxr:\
- case scm_tc7_subr_3:case scm_tc7_subr_2:case scm_tc7_rpsubr:case scm_tc7_subr_1o:\
- case scm_tc7_subr_2o:case scm_tc7_lsubr_2:case scm_tc7_lsubr
+#define scm_tcs_subrs \
+ scm_tc7_asubr:\
+ case scm_tc7_subr_0:\
+ case scm_tc7_subr_1:\
+ case scm_tc7_dsubr:\
+ case scm_tc7_cxr:\
+ case scm_tc7_subr_3:\
+ case scm_tc7_subr_2:\
+ case scm_tc7_rpsubr:\
+ case scm_tc7_subr_1o:\
+ case scm_tc7_subr_2o:\
+ case scm_tc7_lsubr_2:\
+ case scm_tc7_lsubr