summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2004-04-22 19:19:17 +0000
committerDirk Herrmann <dirk@dirk-herrmanns-seiten.de>2004-04-22 19:19:17 +0000
commit7e6e6b37ba2d5cd289cbe3c52041be4af7b60368 (patch)
treefa7ae7cb3dc4cc74e49113025670a34fb9efe00a
parent7aaf475850c8aeabc90f9add69d027a934a577f0 (diff)
downloadguile-7e6e6b37ba2d5cd289cbe3c52041be4af7b60368.tar.gz
Hide the implementation of ilocs and isyms in eval.c.
* deprecated.h (SCM_IFRINC, SCM_ICDR, SCM_IFRAME, SCM_IDIST, SCM_ICDRP), eval.c (SCM_IFRINC, SCM_ICDR, SCM_IFRAME, SCM_IDIST, SCM_ICDRP), eval.h (SCM_ICDR, SCM_IFRINC, SCM_IFRAME, SCM_IDIST, SCM_ICDRP): Deprecated and added to deprecated.h. Moved from eval.h to eval.c. * deprecated.c (scm_isymnames), deprecated.h (scm_isymnames, SCM_ISYMNUM, SCM_ISYMCHARS), eval.c (SCM_ISYMNUM, isymnames, scm_unmemocopy, CEVAL), print.c (scm_isymnames), tags.h (SCM_ISYMNUM, scm_isymnames, SCM_ISYMCHARS): Deprecated scm_isymnames, SCM_ISYMNUM and SCM_ISYMCHARS and added to deprecated.[hc]. Moved scm_isymnames from print.c to eval.c and renamed to isymnames. Moved SCM_ISYMNUM from tags.h to eval.c and renamed to ISYMNUM. * eval.c (scm_i_print_iloc, scm_i_print_isym), eval.h (scm_i_print_iloc, scm_i_print_isym), print.c (scm_iprin1): Extracted printing of ilocs and isyms to guile internal functions scm_i_print_iloc, scm_i_print_isym of eval.c.
-rw-r--r--NEWS9
-rw-r--r--libguile/ChangeLog24
-rw-r--r--libguile/deprecated.c8
-rw-r--r--libguile/deprecated.h17
-rw-r--r--libguile/eval.c160
-rw-r--r--libguile/eval.h8
-rw-r--r--libguile/print.c49
-rw-r--r--libguile/tags.h4
8 files changed, 172 insertions, 107 deletions
diff --git a/NEWS b/NEWS
index e35ac326e..c322e3f99 100644
--- a/NEWS
+++ b/NEWS
@@ -1046,10 +1046,13 @@ used these functions, switch to scm_eval or scm_eval_x.
** Deprecated functions for unmemoization: scm_unmemocar
-** Deprecated macros for iloc handling: SCM_ILOC00, SCM_IDINC, SCM_IDSTMSK
+** Deprecated definitions for iloc and isym handling
-These macros were used in the implementation of the evaluator. It's unlikely
-that they have been used by user code.
+SCM_ILOC00, SCM_IDINC, SCM_IDSTMSK, SCM_IFRINC, SCM_ICDR, SCM_IFRAME,
+SCM_IDIST, SCM_ICDRP, SCM_ISYMNUM, SCM_ISYMCHARS, scm_isymnames.
+
+These definitions were used in the implementation of the evaluator. It's
+unlikely that they have been used by user code.
** Removed definitions: scm_lisp_nil, scm_lisp_t, s_nil_ify,
scm_m_nil_ify, s_t_ify, scm_m_t_ify, s_0_cond, scm_m_0_cond, s_0_ify,
diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 9681e9f20..3c432ba1e 100644
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,27 @@
+2004-04-22 Dirk Herrmann <dirk@dirk-herrmanns-seiten.de>
+
+ Hide the implementation of ilocs and isyms in eval.c.
+
+ * deprecated.h (SCM_IFRINC, SCM_ICDR, SCM_IFRAME, SCM_IDIST,
+ SCM_ICDRP), eval.c (SCM_IFRINC, SCM_ICDR, SCM_IFRAME, SCM_IDIST,
+ SCM_ICDRP), eval.h (SCM_ICDR, SCM_IFRINC, SCM_IFRAME, SCM_IDIST,
+ SCM_ICDRP): Deprecated and added to deprecated.h. Moved from
+ eval.h to eval.c.
+
+ * deprecated.c (scm_isymnames), deprecated.h (scm_isymnames,
+ SCM_ISYMNUM, SCM_ISYMCHARS), eval.c (SCM_ISYMNUM, isymnames,
+ scm_unmemocopy, CEVAL), print.c (scm_isymnames), tags.h
+ (SCM_ISYMNUM, scm_isymnames, SCM_ISYMCHARS): Deprecated
+ scm_isymnames, SCM_ISYMNUM and SCM_ISYMCHARS and added to
+ deprecated.[hc]. Moved scm_isymnames from print.c to eval.c and
+ renamed to isymnames. Moved SCM_ISYMNUM from tags.h to eval.c and
+ renamed to ISYMNUM.
+
+ * eval.c (scm_i_print_iloc, scm_i_print_isym), eval.h
+ (scm_i_print_iloc, scm_i_print_isym), print.c (scm_iprin1):
+ Extracted printing of ilocs and isyms to guile internal functions
+ scm_i_print_iloc, scm_i_print_isym of eval.c.
+
2004-04-22 Kevin Ryde <user42@zip.com.au>
* numbers.c (scm_bit_extract): Use SCM_SRS for signed right shift.
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index 18a0c24de..042debaa6 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -47,6 +47,14 @@
#if (SCM_ENABLE_DEPRECATED == 1)
+/* From print.c: Internal symbol names of isyms. Deprecated in guile 1.7.0 on
+ * 2004-04-22. */
+char *scm_isymnames[] =
+{
+ "#@<deprecated>"
+};
+
+
/* From eval.c: Error messages of the evaluator. These were deprecated in
* guile 1.7.0 on 2003-06-02. */
const char scm_s_expression[] = "missing or extra expression";
diff --git a/libguile/deprecated.h b/libguile/deprecated.h
index d14790740..9be516e5e 100644
--- a/libguile/deprecated.h
+++ b/libguile/deprecated.h
@@ -27,6 +27,23 @@
#if (SCM_ENABLE_DEPRECATED == 1)
+/* From eval.h: Macros for handling ilocs. These were deprecated in guile
+ * 1.7.0 on 2004-04-22. */
+#define SCM_IFRINC (0x00000100L)
+#define SCM_ICDR (0x00080000L)
+#define SCM_IFRAME(n) ((long)((SCM_ICDR-SCM_IFRINC)>>8) \
+ & (SCM_UNPACK (n) >> 8))
+#define SCM_IDIST(n) (SCM_UNPACK (n) >> 20)
+#define SCM_ICDRP(n) (SCM_ICDR & SCM_UNPACK (n))
+
+
+/* From tags.h: Macros to access internal symbol names of isyms. Deprecated
+ * in guile 1.7.0 on 2004-04-22. */
+SCM_API char *scm_isymnames[];
+#define SCM_ISYMNUM(n) 0
+#define SCM_ISYMCHARS(n) "#@<deprecated>"
+
+
/* From tags.h: Macro checking for two tc16 types that are allocated to differ
* only in the 's'-bit. Deprecated in guile 1.7.0 on 2003-09-21. */
#define SCM_TYP16S(x) (0xfeff & SCM_CELL_TYPE (x))
diff --git a/libguile/eval.c b/libguile/eval.c
index da41981b9..7f34b74e8 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -72,6 +72,7 @@ char *alloca ();
#include "libguile/modules.h"
#include "libguile/objects.h"
#include "libguile/ports.h"
+#include "libguile/print.h"
#include "libguile/procprop.h"
#include "libguile/root.h"
#include "libguile/smob.h"
@@ -324,8 +325,15 @@ syntax_error (const char* const msg, const SCM form, const SCM expr)
* boolean value indicating whether the binding is the last binding in the
* frame.
*/
+
#define SCM_ILOC00 SCM_MAKE_ITAG8(0L, scm_tc8_iloc)
+#define SCM_IFRINC (0x00000100L)
+#define SCM_ICDR (0x00080000L)
#define SCM_IDINC (0x00100000L)
+#define SCM_IFRAME(n) ((long)((SCM_ICDR-SCM_IFRINC)>>8) \
+ & (SCM_UNPACK (n) >> 8))
+#define SCM_IDIST(n) (SCM_UNPACK (n) >> 20)
+#define SCM_ICDRP(n) (SCM_ICDR & SCM_UNPACK (n))
#define SCM_IDSTMSK (-SCM_IDINC)
#define SCM_MAKE_ILOC(frame_nr, binding_nr, last_p) \
SCM_PACK ( \
@@ -334,6 +342,15 @@ syntax_error (const char* const msg, const SCM form, const SCM expr)
+ ((last_p) ? SCM_ICDR : 0) \
+ scm_tc8_iloc )
+void
+scm_i_print_iloc (SCM iloc, SCM port)
+{
+ scm_puts ("#@", port);
+ scm_intprint ((long) SCM_IFRAME (iloc), 10, port);
+ scm_putc (SCM_ICDRP (iloc) ? '-' : '+', port);
+ scm_intprint ((long) SCM_IDIST (iloc), 10, port);
+}
+
#if (SCM_DEBUG_DEBUGGING_SUPPORT == 1)
SCM scm_dbg_make_iloc (SCM frame, SCM binding, SCM cdrp);
@@ -365,6 +382,54 @@ SCM_DEFINE (scm_dbg_iloc_p, "dbg-iloc?", 1, 0, 0,
+/* {Evaluator byte codes (isyms)}
+ */
+
+#define ISYMNUM(n) (SCM_ITAG8_DATA (n))
+
+/* This table must agree with the list of SCM_IM_ constants in tags.h */
+static const char *const isymnames[] =
+{
+ "#@and",
+ "#@begin",
+ "#@case",
+ "#@cond",
+ "#@do",
+ "#@if",
+ "#@lambda",
+ "#@let",
+ "#@let*",
+ "#@letrec",
+ "#@or",
+ "#@quote",
+ "#@set!",
+ "#@define",
+ "#@apply",
+ "#@call-with-current-continuation",
+ "#@dispatch",
+ "#@slot-ref",
+ "#@slot-set!",
+ "#@delay",
+ "#@future",
+ "#@call-with-values",
+ "#@else",
+ "#@arrow",
+ "#@nil-cond",
+ "#@bind"
+};
+
+void
+scm_i_print_isym (SCM isym, SCM port)
+{
+ const size_t isymnum = ISYMNUM (isym);
+ if (isymnum < (sizeof isymnames / sizeof (char *)))
+ scm_puts (isymnames[isymnum], port);
+ else
+ scm_ipruk ("isym", isym, port);
+}
+
+
+
/* The function lookup_symbol is used during memoization: Lookup the symbol
* in the environment. If there is no binding for the symbol, SCM_UNDEFINED
* is returned. If the symbol is a syntactic keyword, the macro object to
@@ -2197,21 +2262,21 @@ scm_unmemocopy (SCM x, SCM env)
p = scm_whash_lookup (scm_source_whash, x);
if (SCM_ISYMP (SCM_CAR (x)))
{
- switch (SCM_ISYMNUM (SCM_CAR (x)))
+ switch (ISYMNUM (SCM_CAR (x)))
{
- case (SCM_ISYMNUM (SCM_IM_AND)):
+ case (ISYMNUM (SCM_IM_AND)):
ls = z = scm_cons (scm_sym_and, SCM_UNSPECIFIED);
break;
- case (SCM_ISYMNUM (SCM_IM_BEGIN)):
+ case (ISYMNUM (SCM_IM_BEGIN)):
ls = z = scm_cons (scm_sym_begin, SCM_UNSPECIFIED);
break;
- case (SCM_ISYMNUM (SCM_IM_CASE)):
+ case (ISYMNUM (SCM_IM_CASE)):
ls = z = scm_cons (scm_sym_case, SCM_UNSPECIFIED);
break;
- case (SCM_ISYMNUM (SCM_IM_COND)):
+ case (ISYMNUM (SCM_IM_COND)):
ls = z = scm_cons (scm_sym_cond, SCM_UNSPECIFIED);
break;
- case (SCM_ISYMNUM (SCM_IM_DO)):
+ case (ISYMNUM (SCM_IM_DO)):
{
/* format: (#@do (i1 ... ik) (nk ... n1) (test) (body) s1 ... sk),
* where ix is an initializer for a local variable, nx is the name
@@ -2253,10 +2318,10 @@ scm_unmemocopy (SCM x, SCM env)
x = scm_cons (SCM_BOOL_F, memoized_body);
break;
}
- case (SCM_ISYMNUM (SCM_IM_IF)):
+ case (ISYMNUM (SCM_IM_IF)):
ls = z = scm_cons (scm_sym_if, SCM_UNSPECIFIED);
break;
- case (SCM_ISYMNUM (SCM_IM_LET)):
+ case (ISYMNUM (SCM_IM_LET)):
{
/* format: (#@let (nk nk-1 ...) (i1 ... ik) b1 ...),
* where nx is the name of a local variable, ix is an initializer
@@ -2274,7 +2339,7 @@ scm_unmemocopy (SCM x, SCM env)
ls = scm_cons (scm_sym_let, z);
break;
}
- case (SCM_ISYMNUM (SCM_IM_LETREC)):
+ case (ISYMNUM (SCM_IM_LETREC)):
{
/* format: (#@letrec (vn ... v2 v1) (i1 i2 ... in) b1 ...),
* where vx is the name of a local variable, ix is an initializer
@@ -2292,7 +2357,7 @@ scm_unmemocopy (SCM x, SCM env)
ls = scm_cons (scm_sym_letrec, z);
break;
}
- case (SCM_ISYMNUM (SCM_IM_LETSTAR)):
+ case (ISYMNUM (SCM_IM_LETSTAR)):
{
SCM b, y;
x = SCM_CDR (x);
@@ -2334,39 +2399,39 @@ scm_unmemocopy (SCM x, SCM env)
ls = scm_cons (scm_sym_letstar, z);
break;
}
- case (SCM_ISYMNUM (SCM_IM_OR)):
+ case (ISYMNUM (SCM_IM_OR)):
ls = z = scm_cons (scm_sym_or, SCM_UNSPECIFIED);
break;
- case (SCM_ISYMNUM (SCM_IM_LAMBDA)):
+ case (ISYMNUM (SCM_IM_LAMBDA)):
x = SCM_CDR (x);
z = scm_cons (SCM_CAR (x), SCM_UNSPECIFIED);
ls = scm_cons (scm_sym_lambda, z);
env = SCM_EXTEND_ENV (SCM_CAR (x), SCM_EOL, env);
break;
- case (SCM_ISYMNUM (SCM_IM_QUOTE)):
+ case (ISYMNUM (SCM_IM_QUOTE)):
ls = z = scm_cons (scm_sym_quote, SCM_UNSPECIFIED);
break;
- case (SCM_ISYMNUM (SCM_IM_SET_X)):
+ case (ISYMNUM (SCM_IM_SET_X)):
ls = z = scm_cons (scm_sym_set_x, SCM_UNSPECIFIED);
break;
- case (SCM_ISYMNUM (SCM_IM_APPLY)):
+ case (ISYMNUM (SCM_IM_APPLY)):
ls = z = scm_cons (scm_sym_atapply, SCM_UNSPECIFIED);
break;
- case (SCM_ISYMNUM (SCM_IM_CONT)):
+ case (ISYMNUM (SCM_IM_CONT)):
ls = z = scm_cons (scm_sym_atcall_cc, SCM_UNSPECIFIED);
break;
- case (SCM_ISYMNUM (SCM_IM_DELAY)):
+ case (ISYMNUM (SCM_IM_DELAY)):
ls = z = scm_cons (scm_sym_delay, SCM_UNSPECIFIED);
x = SCM_CDR (x);
break;
- case (SCM_ISYMNUM (SCM_IM_FUTURE)):
+ case (ISYMNUM (SCM_IM_FUTURE)):
ls = z = scm_cons (scm_sym_future, SCM_UNSPECIFIED);
x = SCM_CDR (x);
break;
- case (SCM_ISYMNUM (SCM_IM_CALL_WITH_VALUES)):
+ case (ISYMNUM (SCM_IM_CALL_WITH_VALUES)):
ls = z = scm_cons (scm_sym_at_call_with_values, SCM_UNSPECIFIED);
break;
- case (SCM_ISYMNUM (SCM_IM_ELSE)):
+ case (ISYMNUM (SCM_IM_ELSE)):
ls = z = scm_cons (scm_sym_else, SCM_UNSPECIFIED);
break;
default:
@@ -2927,9 +2992,9 @@ dispatch:
SCM_TICK;
if (SCM_ISYMP (SCM_CAR (x)))
{
- switch (SCM_ISYMNUM (SCM_CAR (x)))
+ switch (ISYMNUM (SCM_CAR (x)))
{
- case (SCM_ISYMNUM (SCM_IM_AND)):
+ case (ISYMNUM (SCM_IM_AND)):
x = SCM_CDR (x);
while (!SCM_NULLP (SCM_CDR (x)))
{
@@ -2942,7 +3007,7 @@ dispatch:
PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
goto carloop;
- case (SCM_ISYMNUM (SCM_IM_BEGIN)):
+ case (ISYMNUM (SCM_IM_BEGIN)):
x = SCM_CDR (x);
if (SCM_NULLP (x))
RETURN (SCM_UNSPECIFIED);
@@ -3011,7 +3076,7 @@ dispatch:
}
- case (SCM_ISYMNUM (SCM_IM_CASE)):
+ case (ISYMNUM (SCM_IM_CASE)):
x = SCM_CDR (x);
{
const SCM key = EVALCAR (x, env);
@@ -3044,7 +3109,7 @@ dispatch:
RETURN (SCM_UNSPECIFIED);
- case (SCM_ISYMNUM (SCM_IM_COND)):
+ case (ISYMNUM (SCM_IM_COND)):
x = SCM_CDR (x);
while (!SCM_NULLP (x))
{
@@ -3083,7 +3148,7 @@ dispatch:
RETURN (SCM_UNSPECIFIED);
- case (SCM_ISYMNUM (SCM_IM_DO)):
+ case (ISYMNUM (SCM_IM_DO)):
x = SCM_CDR (x);
{
/* Compute the initialization values and the initial environment. */
@@ -3154,7 +3219,7 @@ dispatch:
goto nontoplevel_begin;
- case (SCM_ISYMNUM (SCM_IM_IF)):
+ case (ISYMNUM (SCM_IM_IF)):
x = SCM_CDR (x);
{
SCM test_result = EVALCAR (x, env);
@@ -3170,7 +3235,7 @@ dispatch:
goto carloop;
- case (SCM_ISYMNUM (SCM_IM_LET)):
+ case (ISYMNUM (SCM_IM_LET)):
x = SCM_CDR (x);
{
SCM init_forms = SCM_CADR (x);
@@ -3188,7 +3253,7 @@ dispatch:
goto nontoplevel_begin;
- case (SCM_ISYMNUM (SCM_IM_LETREC)):
+ case (ISYMNUM (SCM_IM_LETREC)):
x = SCM_CDR (x);
env = SCM_EXTEND_ENV (SCM_CAR (x), undefineds, env);
x = SCM_CDR (x);
@@ -3208,7 +3273,7 @@ dispatch:
goto nontoplevel_begin;
- case (SCM_ISYMNUM (SCM_IM_LETSTAR)):
+ case (ISYMNUM (SCM_IM_LETSTAR)):
x = SCM_CDR (x);
{
SCM bindings = SCM_CAR (x);
@@ -3231,7 +3296,7 @@ dispatch:
goto nontoplevel_begin;
- case (SCM_ISYMNUM (SCM_IM_OR)):
+ case (ISYMNUM (SCM_IM_OR)):
x = SCM_CDR (x);
while (!SCM_NULLP (SCM_CDR (x)))
{
@@ -3245,15 +3310,15 @@ dispatch:
goto carloop;
- case (SCM_ISYMNUM (SCM_IM_LAMBDA)):
+ case (ISYMNUM (SCM_IM_LAMBDA)):
RETURN (scm_closure (SCM_CDR (x), env));
- case (SCM_ISYMNUM (SCM_IM_QUOTE)):
+ case (ISYMNUM (SCM_IM_QUOTE)):
RETURN (SCM_CADR (x));
- case (SCM_ISYMNUM (SCM_IM_SET_X)):
+ case (ISYMNUM (SCM_IM_SET_X)):
x = SCM_CDR (x);
{
SCM *location;
@@ -3270,7 +3335,7 @@ dispatch:
RETURN (SCM_UNSPECIFIED);
- case (SCM_ISYMNUM (SCM_IM_APPLY)):
+ case (ISYMNUM (SCM_IM_APPLY)):
/* Evaluate the procedure to be applied. */
x = SCM_CDR (x);
proc = EVALCAR (x, env);
@@ -3321,7 +3386,7 @@ dispatch:
}
- case (SCM_ISYMNUM (SCM_IM_CONT)):
+ case (ISYMNUM (SCM_IM_CONT)):
{
int first;
SCM val = scm_make_continuation (&first);
@@ -3340,19 +3405,18 @@ dispatch:
}
- case (SCM_ISYMNUM (SCM_IM_DELAY)):
+ case (ISYMNUM (SCM_IM_DELAY)):
RETURN (scm_makprom (scm_closure (SCM_CDR (x), env)));
- case (SCM_ISYMNUM (SCM_IM_FUTURE)):
+ case (ISYMNUM (SCM_IM_FUTURE)):
RETURN (scm_i_make_future (scm_closure (SCM_CDR (x), env)));
- /* PLACEHOLDER for case (SCM_ISYMNUM (SCM_IM_DISPATCH)): The
- following code (type_dispatch) is intended to be the tail
- of the case clause for the internal macro
- SCM_IM_DISPATCH. Please don't remove it from this
- location without discussing it with Mikael
+ /* PLACEHOLDER for case (ISYMNUM (SCM_IM_DISPATCH)): The following
+ code (type_dispatch) is intended to be the tail of the case
+ clause for the internal macro SCM_IM_DISPATCH. Please don't
+ remove it from this location without discussing it with Mikael
<djurfeldt@nada.kth.se> */
/* The type dispatch code is duplicated below
@@ -3484,7 +3548,7 @@ dispatch:
}
- case (SCM_ISYMNUM (SCM_IM_SLOT_REF)):
+ case (ISYMNUM (SCM_IM_SLOT_REF)):
x = SCM_CDR (x);
{
SCM instance = EVALCAR (x, env);
@@ -3493,7 +3557,7 @@ dispatch:
}
- case (SCM_ISYMNUM (SCM_IM_SLOT_SET_X)):
+ case (ISYMNUM (SCM_IM_SLOT_SET_X)):
x = SCM_CDR (x);
{
SCM instance = EVALCAR (x, env);
@@ -3506,7 +3570,7 @@ dispatch:
#if SCM_ENABLE_ELISP
- case (SCM_ISYMNUM (SCM_IM_NIL_COND)):
+ case (ISYMNUM (SCM_IM_NIL_COND)):
{
SCM test_form = SCM_CDR (x);
x = SCM_CDR (test_form);
@@ -3534,7 +3598,7 @@ dispatch:
#endif /* SCM_ENABLE_ELISP */
- case (SCM_ISYMNUM (SCM_IM_BIND)):
+ case (ISYMNUM (SCM_IM_BIND)):
{
SCM vars, exps, vals;
@@ -3566,7 +3630,7 @@ dispatch:
}
- case (SCM_ISYMNUM (SCM_IM_CALL_WITH_VALUES)):
+ case (ISYMNUM (SCM_IM_CALL_WITH_VALUES)):
{
SCM producer;
diff --git a/libguile/eval.h b/libguile/eval.h
index 85fd78380..4269c5a71 100644
--- a/libguile/eval.h
+++ b/libguile/eval.h
@@ -60,12 +60,6 @@ SCM_API SCM scm_eval_options_interface (SCM setting);
*
*/
#define SCM_ILOCP(n) (SCM_ITAG8(n)==scm_tc8_iloc)
-#define SCM_ICDR (0x00080000L)
-#define SCM_IFRINC (0x00000100L)
-#define SCM_IFRAME(n) ((long)((SCM_ICDR-SCM_IFRINC)>>8) \
- & (SCM_UNPACK (n) >> 8))
-#define SCM_IDIST(n) (SCM_UNPACK (n) >> 20)
-#define SCM_ICDRP(n) (SCM_ICDR & SCM_UNPACK (n))
@@ -199,6 +193,8 @@ SCM_API SCM scm_primitive_eval_x (SCM exp);
SCM_API SCM scm_eval (SCM exp, SCM module);
SCM_API SCM scm_eval_x (SCM exp, SCM module);
+SCM_API void scm_i_print_iloc (SCM /*iloc*/, SCM /*port*/);
+SCM_API void scm_i_print_isym (SCM /*isym*/, SCM /*port*/);
SCM_API void scm_init_eval (void);
diff --git a/libguile/print.c b/libguile/print.c
index 200aafabe..12292f689 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -68,45 +68,6 @@ static const char *iflagnames[] =
"#nil"
};
-/* This table must agree with the list of SCM_IM_ constants in tags.h */
-char *scm_isymnames[] =
-{
- /* Short instructions */
-
- "#@and",
- "#@begin",
- "#@case",
- "#@cond",
- "#@do",
- "#@if",
- "#@lambda",
- "#@let",
- "#@let*",
- "#@letrec",
- "#@or",
- "#@quote",
- "#@set!",
-
-
- /* Long instructions */
-
- "#@define",
- "#@apply",
- "#@call-with-current-continuation",
- "#@dispatch",
- "#@slot-ref",
- "#@slot-set!",
- "#@delay",
- "#@future",
- "#@call-with-values",
- "#@else",
- "#@arrow",
-
- /* Multi-language support */
- "#@nil-cond",
- "#@bind"
-};
-
scm_t_option scm_print_opts[] = {
{ SCM_OPTION_SCM, "closure-hook", SCM_UNPACK (SCM_BOOL_F),
"Hook for printing closures (should handle macros as well)." },
@@ -434,17 +395,13 @@ scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
{
scm_puts (iflagnames [SCM_IFLAGNUM (exp)], port);
}
- else if (SCM_ISYMP (exp)
- && ((size_t) SCM_ISYMNUM (exp) < (sizeof scm_isymnames / sizeof (char *))))
+ else if (SCM_ISYMP (exp))
{
- scm_puts (SCM_ISYMCHARS (exp), port);
+ scm_i_print_isym (exp, port);
}
else if (SCM_ILOCP (exp))
{
- scm_puts ("#@", port);
- scm_intprint ((long) SCM_IFRAME (exp), 10, port);
- scm_putc (SCM_ICDRP (exp) ? '-' : '+', port);
- scm_intprint ((long) SCM_IDIST (exp), 10, port);
+ scm_i_print_iloc (exp, port);
}
else
{
diff --git a/libguile/tags.h b/libguile/tags.h
index a2bdb7328..21fcc8167 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -542,10 +542,6 @@ enum scm_tc8_tags
#define SCM_ISYMP(n) (SCM_ITAG8 (n) == scm_tc8_isym)
#define SCM_MAKISYM(n) SCM_MAKE_ITAG8 ((n), scm_tc8_isym)
-#define SCM_ISYMNUM(n) (SCM_ITAG8_DATA (n))
-
-SCM_API char *scm_isymnames[]; /* defined in print.c */
-#define SCM_ISYMCHARS(n) (scm_isymnames[SCM_ISYMNUM (n)])
#define SCM_IM_AND SCM_MAKISYM (0)
#define SCM_IM_BEGIN SCM_MAKISYM (1)