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.

diff --git a/NEWS b/NEWS
index e35ac32..c322e3f 100644 (file)
--- 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 9681e9f..3c432ba 100644 (file)
--- 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 18a0c24..042deba 100644 (file)
--- 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 d147907..9be516e 100644 (file)
--- 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 da41981..7f34b74 100644 (file)
--- 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,
 
 \f
 
+/* {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);
+}
+
+\f
+
 /* 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 85fd783..4269c5a 100644 (file)
--- 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))
 
 \f
 
@@ -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 200aafa..12292f6 100644 (file)
--- 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 a2bdb73..21fcc81 100644 (file)
--- 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)