mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-18 17:50:29 +02:00
Code Activity

Hide the implementation of ilocs and isyms in eval.c.

Browse source 
* 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.
This commit is contained in:
Dirk Herrmann 2004-04-22 19:19:17 +00:00
parent 7aaf475850
commit 7e6e6b37ba
8 changed files with 172 additions and 107 deletions
Download patch file Download diff file Expand all files Collapse all files

9
NEWS
View file

@ -1046,10 +1046,13 @@ used these functions, switch to scm_eval or scm_eval_x.
** Deprecated functions for unmemoization: scm_unmemocar ** 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 SCM_ILOC00, SCM_IDINC, SCM_IDSTMSK, SCM_IFRINC, SCM_ICDR, SCM_IFRAME,
that they have been used by user code. 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, ** 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, scm_m_nil_ify, s_t_ify, scm_m_t_ify, s_0_cond, scm_m_0_cond, s_0_ify,

24
libguile/ChangeLog
View file

@ -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> 2004-04-22 Kevin Ryde <user42@zip.com.au>
* numbers.c (scm_bit_extract): Use SCM_SRS for signed right shift. * numbers.c (scm_bit_extract): Use SCM_SRS for signed right shift.

8
libguile/deprecated.c
View file

@ -47,6 +47,14 @@
#if (SCM_ENABLE_DEPRECATED == 1) #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 /* From eval.c: Error messages of the evaluator. These were deprecated in
* guile 1.7.0 on 2003-06-02. */ * guile 1.7.0 on 2003-06-02. */
const char scm_s_expression[] = "missing or extra expression"; const char scm_s_expression[] = "missing or extra expression";

17
libguile/deprecated.h
View file

@ -27,6 +27,23 @@
#if (SCM_ENABLE_DEPRECATED == 1) #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 /* 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. */ * only in the 's'-bit. Deprecated in guile 1.7.0 on 2003-09-21. */
#define SCM_TYP16S(x) (0xfeff & SCM_CELL_TYPE (x)) #define SCM_TYP16S(x) (0xfeff & SCM_CELL_TYPE (x))

160
libguile/eval.c
View file

@ -72,6 +72,7 @@ char *alloca ();
#include "libguile/modules.h" #include "libguile/modules.h"
#include "libguile/objects.h" #include "libguile/objects.h"
#include "libguile/ports.h" #include "libguile/ports.h"
#include "libguile/print.h"
#include "libguile/procprop.h" #include "libguile/procprop.h"
#include "libguile/root.h" #include "libguile/root.h"
#include "libguile/smob.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 * boolean value indicating whether the binding is the last binding in the
* frame. * frame.
*/ */
#define SCM_ILOC00 SCM_MAKE_ITAG8(0L, scm_tc8_iloc) #define SCM_ILOC00 SCM_MAKE_ITAG8(0L, scm_tc8_iloc)
#define SCM_IFRINC (0x00000100L)
#define SCM_ICDR (0x00080000L)
#define SCM_IDINC (0x00100000L) #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_IDSTMSK (-SCM_IDINC)
#define SCM_MAKE_ILOC(frame_nr, binding_nr, last_p) \ #define SCM_MAKE_ILOC(frame_nr, binding_nr, last_p) \
SCM_PACK ( \ SCM_PACK ( \
@ -334,6 +342,15 @@ syntax_error (const char* const msg, const SCM form, const SCM expr)
+ ((last_p) ? SCM_ICDR : 0) \ + ((last_p) ? SCM_ICDR : 0) \
+ scm_tc8_iloc ) + 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) #if (SCM_DEBUG_DEBUGGING_SUPPORT == 1)
SCM scm_dbg_make_iloc (SCM frame, SCM binding, SCM cdrp); 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 /* The function lookup_symbol is used during memoization: Lookup the symbol
* in the environment. If there is no binding for the symbol, SCM_UNDEFINED * 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 * 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); p = scm_whash_lookup (scm_source_whash, x);
if (SCM_ISYMP (SCM_CAR (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); ls = z = scm_cons (scm_sym_and, SCM_UNSPECIFIED);
break; break;
case (SCM_ISYMNUM (SCM_IM_BEGIN)): case (ISYMNUM (SCM_IM_BEGIN)):
ls = z = scm_cons (scm_sym_begin, SCM_UNSPECIFIED); ls = z = scm_cons (scm_sym_begin, SCM_UNSPECIFIED);
break; break;
case (SCM_ISYMNUM (SCM_IM_CASE)): case (ISYMNUM (SCM_IM_CASE)):
ls = z = scm_cons (scm_sym_case, SCM_UNSPECIFIED); ls = z = scm_cons (scm_sym_case, SCM_UNSPECIFIED);
break; break;
case (SCM_ISYMNUM (SCM_IM_COND)): case (ISYMNUM (SCM_IM_COND)):
ls = z = scm_cons (scm_sym_cond, SCM_UNSPECIFIED); ls = z = scm_cons (scm_sym_cond, SCM_UNSPECIFIED);
break; break;
case (SCM_ISYMNUM (SCM_IM_DO)): case (ISYMNUM (SCM_IM_DO)):
{ {
/* format: (#@do (i1 ... ik) (nk ... n1) (test) (body) s1 ... sk), /* format: (#@do (i1 ... ik) (nk ... n1) (test) (body) s1 ... sk),
* where ix is an initializer for a local variable, nx is the name * 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); x = scm_cons (SCM_BOOL_F, memoized_body);
break; break;
} }
case (SCM_ISYMNUM (SCM_IM_IF)): case (ISYMNUM (SCM_IM_IF)):
ls = z = scm_cons (scm_sym_if, SCM_UNSPECIFIED); ls = z = scm_cons (scm_sym_if, SCM_UNSPECIFIED);
break; break;
case (SCM_ISYMNUM (SCM_IM_LET)): case (ISYMNUM (SCM_IM_LET)):
{ {
/* format: (#@let (nk nk-1 ...) (i1 ... ik) b1 ...), /* format: (#@let (nk nk-1 ...) (i1 ... ik) b1 ...),
* where nx is the name of a local variable, ix is an initializer * 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); ls = scm_cons (scm_sym_let, z);
break; break;
} }
case (SCM_ISYMNUM (SCM_IM_LETREC)): case (ISYMNUM (SCM_IM_LETREC)):
{ {
/* format: (#@letrec (vn ... v2 v1) (i1 i2 ... in) b1 ...), /* format: (#@letrec (vn ... v2 v1) (i1 i2 ... in) b1 ...),
* where vx is the name of a local variable, ix is an initializer * 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); ls = scm_cons (scm_sym_letrec, z);
break; break;
} }
case (SCM_ISYMNUM (SCM_IM_LETSTAR)): case (ISYMNUM (SCM_IM_LETSTAR)):
{ {
SCM b, y; SCM b, y;
x = SCM_CDR (x); x = SCM_CDR (x);
@ -2334,39 +2399,39 @@ scm_unmemocopy (SCM x, SCM env)
ls = scm_cons (scm_sym_letstar, z); ls = scm_cons (scm_sym_letstar, z);
break; break;
} }
case (SCM_ISYMNUM (SCM_IM_OR)): case (ISYMNUM (SCM_IM_OR)):
ls = z = scm_cons (scm_sym_or, SCM_UNSPECIFIED); ls = z = scm_cons (scm_sym_or, SCM_UNSPECIFIED);
break; break;
case (SCM_ISYMNUM (SCM_IM_LAMBDA)): case (ISYMNUM (SCM_IM_LAMBDA)):
x = SCM_CDR (x); x = SCM_CDR (x);
z = scm_cons (SCM_CAR (x), SCM_UNSPECIFIED); z = scm_cons (SCM_CAR (x), SCM_UNSPECIFIED);
ls = scm_cons (scm_sym_lambda, z); ls = scm_cons (scm_sym_lambda, z);
env = SCM_EXTEND_ENV (SCM_CAR (x), SCM_EOL, env); env = SCM_EXTEND_ENV (SCM_CAR (x), SCM_EOL, env);
break; break;
case (SCM_ISYMNUM (SCM_IM_QUOTE)): case (ISYMNUM (SCM_IM_QUOTE)):
ls = z = scm_cons (scm_sym_quote, SCM_UNSPECIFIED); ls = z = scm_cons (scm_sym_quote, SCM_UNSPECIFIED);
break; break;
case (SCM_ISYMNUM (SCM_IM_SET_X)): case (ISYMNUM (SCM_IM_SET_X)):
ls = z = scm_cons (scm_sym_set_x, SCM_UNSPECIFIED); ls = z = scm_cons (scm_sym_set_x, SCM_UNSPECIFIED);
break; break;
case (SCM_ISYMNUM (SCM_IM_APPLY)): case (ISYMNUM (SCM_IM_APPLY)):
ls = z = scm_cons (scm_sym_atapply, SCM_UNSPECIFIED); ls = z = scm_cons (scm_sym_atapply, SCM_UNSPECIFIED);
break; break;
case (SCM_ISYMNUM (SCM_IM_CONT)): case (ISYMNUM (SCM_IM_CONT)):
ls = z = scm_cons (scm_sym_atcall_cc, SCM_UNSPECIFIED); ls = z = scm_cons (scm_sym_atcall_cc, SCM_UNSPECIFIED);
break; break;
case (SCM_ISYMNUM (SCM_IM_DELAY)): case (ISYMNUM (SCM_IM_DELAY)):
ls = z = scm_cons (scm_sym_delay, SCM_UNSPECIFIED); ls = z = scm_cons (scm_sym_delay, SCM_UNSPECIFIED);
x = SCM_CDR (x); x = SCM_CDR (x);
break; break;
case (SCM_ISYMNUM (SCM_IM_FUTURE)): case (ISYMNUM (SCM_IM_FUTURE)):
ls = z = scm_cons (scm_sym_future, SCM_UNSPECIFIED); ls = z = scm_cons (scm_sym_future, SCM_UNSPECIFIED);
x = SCM_CDR (x); x = SCM_CDR (x);
break; 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); ls = z = scm_cons (scm_sym_at_call_with_values, SCM_UNSPECIFIED);
break; break;
case (SCM_ISYMNUM (SCM_IM_ELSE)): case (ISYMNUM (SCM_IM_ELSE)):
ls = z = scm_cons (scm_sym_else, SCM_UNSPECIFIED); ls = z = scm_cons (scm_sym_else, SCM_UNSPECIFIED);
break; break;
default: default:
@ -2927,9 +2992,9 @@ dispatch:
SCM_TICK; SCM_TICK;
if (SCM_ISYMP (SCM_CAR (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)):
x = SCM_CDR (x); x = SCM_CDR (x);
while (!SCM_NULLP (SCM_CDR (x))) while (!SCM_NULLP (SCM_CDR (x)))
{ {
@ -2942,7 +3007,7 @@ dispatch:
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
goto carloop; goto carloop;
case (SCM_ISYMNUM (SCM_IM_BEGIN)): case (ISYMNUM (SCM_IM_BEGIN)):
x = SCM_CDR (x); x = SCM_CDR (x);
if (SCM_NULLP (x)) if (SCM_NULLP (x))
RETURN (SCM_UNSPECIFIED); RETURN (SCM_UNSPECIFIED);
@ -3011,7 +3076,7 @@ dispatch:
} }
case (SCM_ISYMNUM (SCM_IM_CASE)): case (ISYMNUM (SCM_IM_CASE)):
x = SCM_CDR (x); x = SCM_CDR (x);
{ {
const SCM key = EVALCAR (x, env); const SCM key = EVALCAR (x, env);
@ -3044,7 +3109,7 @@ dispatch:
RETURN (SCM_UNSPECIFIED); RETURN (SCM_UNSPECIFIED);
case (SCM_ISYMNUM (SCM_IM_COND)): case (ISYMNUM (SCM_IM_COND)):
x = SCM_CDR (x); x = SCM_CDR (x);
while (!SCM_NULLP (x)) while (!SCM_NULLP (x))
{ {
@ -3083,7 +3148,7 @@ dispatch:
RETURN (SCM_UNSPECIFIED); RETURN (SCM_UNSPECIFIED);
case (SCM_ISYMNUM (SCM_IM_DO)): case (ISYMNUM (SCM_IM_DO)):
x = SCM_CDR (x); x = SCM_CDR (x);
{ {
/* Compute the initialization values and the initial environment. */ /* Compute the initialization values and the initial environment. */
@ -3154,7 +3219,7 @@ dispatch:
goto nontoplevel_begin; goto nontoplevel_begin;
case (SCM_ISYMNUM (SCM_IM_IF)): case (ISYMNUM (SCM_IM_IF)):
x = SCM_CDR (x); x = SCM_CDR (x);
{ {
SCM test_result = EVALCAR (x, env); SCM test_result = EVALCAR (x, env);
@ -3170,7 +3235,7 @@ dispatch:
goto carloop; goto carloop;
case (SCM_ISYMNUM (SCM_IM_LET)): case (ISYMNUM (SCM_IM_LET)):
x = SCM_CDR (x); x = SCM_CDR (x);
{ {
SCM init_forms = SCM_CADR (x); SCM init_forms = SCM_CADR (x);
@ -3188,7 +3253,7 @@ dispatch:
goto nontoplevel_begin; goto nontoplevel_begin;
case (SCM_ISYMNUM (SCM_IM_LETREC)): case (ISYMNUM (SCM_IM_LETREC)):
x = SCM_CDR (x); x = SCM_CDR (x);
env = SCM_EXTEND_ENV (SCM_CAR (x), undefineds, env); env = SCM_EXTEND_ENV (SCM_CAR (x), undefineds, env);
x = SCM_CDR (x); x = SCM_CDR (x);
@ -3208,7 +3273,7 @@ dispatch:
goto nontoplevel_begin; goto nontoplevel_begin;
case (SCM_ISYMNUM (SCM_IM_LETSTAR)): case (ISYMNUM (SCM_IM_LETSTAR)):
x = SCM_CDR (x); x = SCM_CDR (x);
{ {
SCM bindings = SCM_CAR (x); SCM bindings = SCM_CAR (x);
@ -3231,7 +3296,7 @@ dispatch:
goto nontoplevel_begin; goto nontoplevel_begin;
case (SCM_ISYMNUM (SCM_IM_OR)): case (ISYMNUM (SCM_IM_OR)):
x = SCM_CDR (x); x = SCM_CDR (x);
while (!SCM_NULLP (SCM_CDR (x))) while (!SCM_NULLP (SCM_CDR (x)))
{ {
@ -3245,15 +3310,15 @@ dispatch:
goto carloop; goto carloop;
case (SCM_ISYMNUM (SCM_IM_LAMBDA)): case (ISYMNUM (SCM_IM_LAMBDA)):
RETURN (scm_closure (SCM_CDR (x), env)); RETURN (scm_closure (SCM_CDR (x), env));
case (SCM_ISYMNUM (SCM_IM_QUOTE)): case (ISYMNUM (SCM_IM_QUOTE)):
RETURN (SCM_CADR (x)); RETURN (SCM_CADR (x));
case (SCM_ISYMNUM (SCM_IM_SET_X)): case (ISYMNUM (SCM_IM_SET_X)):
x = SCM_CDR (x); x = SCM_CDR (x);
{ {
SCM *location; SCM *location;
@ -3270,7 +3335,7 @@ dispatch:
RETURN (SCM_UNSPECIFIED); RETURN (SCM_UNSPECIFIED);
case (SCM_ISYMNUM (SCM_IM_APPLY)): case (ISYMNUM (SCM_IM_APPLY)):
/* Evaluate the procedure to be applied. */ /* Evaluate the procedure to be applied. */
x = SCM_CDR (x); x = SCM_CDR (x);
proc = EVALCAR (x, env); proc = EVALCAR (x, env);
@ -3321,7 +3386,7 @@ dispatch:
} }
case (SCM_ISYMNUM (SCM_IM_CONT)): case (ISYMNUM (SCM_IM_CONT)):
{ {
int first; int first;
SCM val = scm_make_continuation (&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))); 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))); RETURN (scm_i_make_future (scm_closure (SCM_CDR (x), env)));
/* PLACEHOLDER for case (SCM_ISYMNUM (SCM_IM_DISPATCH)): The /* PLACEHOLDER for case (ISYMNUM (SCM_IM_DISPATCH)): The following
following code (type_dispatch) is intended to be the tail code (type_dispatch) is intended to be the tail of the case
of the case clause for the internal macro clause for the internal macro SCM_IM_DISPATCH. Please don't
SCM_IM_DISPATCH. Please don't remove it from this remove it from this location without discussing it with Mikael
location without discussing it with Mikael
<djurfeldt@nada.kth.se> */ <djurfeldt@nada.kth.se> */
/* The type dispatch code is duplicated below /* 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); x = SCM_CDR (x);
{ {
SCM instance = EVALCAR (x, env); 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); x = SCM_CDR (x);
{ {
SCM instance = EVALCAR (x, env); SCM instance = EVALCAR (x, env);
@ -3506,7 +3570,7 @@ dispatch:
#if SCM_ENABLE_ELISP #if SCM_ENABLE_ELISP
case (SCM_ISYMNUM (SCM_IM_NIL_COND)): case (ISYMNUM (SCM_IM_NIL_COND)):
{ {
SCM test_form = SCM_CDR (x); SCM test_form = SCM_CDR (x);
x = SCM_CDR (test_form); x = SCM_CDR (test_form);
@ -3534,7 +3598,7 @@ dispatch:
#endif /* SCM_ENABLE_ELISP */ #endif /* SCM_ENABLE_ELISP */
case (SCM_ISYMNUM (SCM_IM_BIND)): case (ISYMNUM (SCM_IM_BIND)):
{ {
SCM vars, exps, vals; 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; SCM producer;

8
libguile/eval.h
View file

@ -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_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 (SCM exp, SCM module);
SCM_API SCM scm_eval_x (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); SCM_API void scm_init_eval (void);

49
libguile/print.c
View file

@ -68,45 +68,6 @@ static const char *iflagnames[] =
"#nil" "#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_t_option scm_print_opts[] = {
{ SCM_OPTION_SCM, "closure-hook", SCM_UNPACK (SCM_BOOL_F), { SCM_OPTION_SCM, "closure-hook", SCM_UNPACK (SCM_BOOL_F),
"Hook for printing closures (should handle macros as well)." }, "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); scm_puts (iflagnames [SCM_IFLAGNUM (exp)], port);
} }
else if (SCM_ISYMP (exp) else if (SCM_ISYMP (exp))
&& ((size_t) SCM_ISYMNUM (exp) < (sizeof scm_isymnames / sizeof (char *))))
{ {
scm_puts (SCM_ISYMCHARS (exp), port); scm_i_print_isym (exp, port);
} }
else if (SCM_ILOCP (exp)) else if (SCM_ILOCP (exp))
{ {
scm_puts ("#@", port); scm_i_print_iloc (exp, port);
scm_intprint ((long) SCM_IFRAME (exp), 10, port);
scm_putc (SCM_ICDRP (exp) ? '-' : '+', port);
scm_intprint ((long) SCM_IDIST (exp), 10, port);
} }
else else
{ {

4
libguile/tags.h
View file

@ -542,10 +542,6 @@ enum scm_tc8_tags
#define SCM_ISYMP(n) (SCM_ITAG8 (n) == scm_tc8_isym) #define SCM_ISYMP(n) (SCM_ITAG8 (n) == scm_tc8_isym)
#define SCM_MAKISYM(n) SCM_MAKE_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_AND SCM_MAKISYM (0)
#define SCM_IM_BEGIN SCM_MAKISYM (1) #define SCM_IM_BEGIN SCM_MAKISYM (1)