[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
guile/guile-core/libguile variable.h variable.c...
|
From: |
Marius Vollmer |
|
Subject: |
guile/guile-core/libguile variable.h variable.c... |
|
Date: |
Tue, 15 May 2001 07:57:24 -0700 |
CVSROOT: /cvs
Module name: guile
Changes by: Marius Vollmer <address@hidden> 01/05/15 07:57:22
Modified files:
guile-core/libguile: variable.h variable.c throw.c tag.c
symbols.h symbols.c struct.c stime.c
stacks.c srcprop.c socket.c snarf.h
script.c scmsigs.c root.h regex-posix.c
read.c random.c ramap.c procs.c print.c
posix.c ports.c objects.c numbers.c
modules.h modules.c macros.c load.c
keywords.c init.c hooks.c gsubr.c goops.c
gh_funcs.c gh_data.c gdbint.c gc.c fports.c
filesys.c feature.c evalext.c eval.h eval.c
dynwind.c deprecation.c debug.c
cpp_cnvt.awk backtrace.h backtrace.c _scm.h
__scm.h Makefile.am
Added files:
guile-core/libguile: symbols-deprecated.c
Log message:
Merge from mvo-vcell-cleanup-1-branch.
CVSWeb URLs:
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/symbols-deprecated.c.diff?cvsroot=OldCVS&tr1=1.1&tr2=1.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/variable.h.diff?cvsroot=OldCVS&tr1=1.17&tr2=1.18&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/variable.c.diff?cvsroot=OldCVS&tr1=1.34&tr2=1.35&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/throw.c.diff?cvsroot=OldCVS&tr1=1.80&tr2=1.81&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/tag.c.diff?cvsroot=OldCVS&tr1=1.24&tr2=1.25&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/symbols.h.diff?cvsroot=OldCVS&tr1=1.51&tr2=1.52&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/symbols.c.diff?cvsroot=OldCVS&tr1=1.85&tr2=1.86&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/struct.c.diff?cvsroot=OldCVS&tr1=1.75&tr2=1.76&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/stime.c.diff?cvsroot=OldCVS&tr1=1.65&tr2=1.66&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/stacks.c.diff?cvsroot=OldCVS&tr1=1.57&tr2=1.58&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/srcprop.c.diff?cvsroot=OldCVS&tr1=1.46&tr2=1.47&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/socket.c.diff?cvsroot=OldCVS&tr1=1.74&tr2=1.75&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/snarf.h.diff?cvsroot=OldCVS&tr1=1.44&tr2=1.45&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/script.c.diff?cvsroot=OldCVS&tr1=1.38&tr2=1.39&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/scmsigs.c.diff?cvsroot=OldCVS&tr1=1.56&tr2=1.57&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/root.h.diff?cvsroot=OldCVS&tr1=1.32&tr2=1.33&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/regex-posix.c.diff?cvsroot=OldCVS&tr1=1.50&tr2=1.51&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/read.c.diff?cvsroot=OldCVS&tr1=1.67&tr2=1.68&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/random.c.diff?cvsroot=OldCVS&tr1=1.40&tr2=1.41&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/ramap.c.diff?cvsroot=OldCVS&tr1=1.68&tr2=1.69&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/procs.c.diff?cvsroot=OldCVS&tr1=1.54&tr2=1.55&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/print.c.diff?cvsroot=OldCVS&tr1=1.121&tr2=1.122&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/posix.c.diff?cvsroot=OldCVS&tr1=1.88&tr2=1.89&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/ports.c.diff?cvsroot=OldCVS&tr1=1.143&tr2=1.144&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/objects.c.diff?cvsroot=OldCVS&tr1=1.56&tr2=1.57&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/numbers.c.diff?cvsroot=OldCVS&tr1=1.127&tr2=1.128&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/modules.h.diff?cvsroot=OldCVS&tr1=1.13&tr2=1.14&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/modules.c.diff?cvsroot=OldCVS&tr1=1.22&tr2=1.23&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/macros.c.diff?cvsroot=OldCVS&tr1=1.27&tr2=1.28&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/load.c.diff?cvsroot=OldCVS&tr1=1.58&tr2=1.59&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/keywords.c.diff?cvsroot=OldCVS&tr1=1.38&tr2=1.39&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/init.c.diff?cvsroot=OldCVS&tr1=1.121&tr2=1.122&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/hooks.c.diff?cvsroot=OldCVS&tr1=1.13&tr2=1.14&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/gsubr.c.diff?cvsroot=OldCVS&tr1=1.35&tr2=1.36&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/goops.c.diff?cvsroot=OldCVS&tr1=1.28&tr2=1.29&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/gh_funcs.c.diff?cvsroot=OldCVS&tr1=1.8&tr2=1.9&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/gh_data.c.diff?cvsroot=OldCVS&tr1=1.58&tr2=1.59&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/gdbint.c.diff?cvsroot=OldCVS&tr1=1.38&tr2=1.39&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/gc.c.diff?cvsroot=OldCVS&tr1=1.196&tr2=1.197&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/fports.c.diff?cvsroot=OldCVS&tr1=1.93&tr2=1.94&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/filesys.c.diff?cvsroot=OldCVS&tr1=1.96&tr2=1.97&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/feature.c.diff?cvsroot=OldCVS&tr1=1.45&tr2=1.46&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/evalext.c.diff?cvsroot=OldCVS&tr1=1.32&tr2=1.33&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/eval.h.diff?cvsroot=OldCVS&tr1=1.52&tr2=1.53&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/eval.c.diff?cvsroot=OldCVS&tr1=1.219&tr2=1.220&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/dynwind.c.diff?cvsroot=OldCVS&tr1=1.35&tr2=1.36&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/deprecation.c.diff?cvsroot=OldCVS&tr1=1.3&tr2=1.4&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/debug.c.diff?cvsroot=OldCVS&tr1=1.86&tr2=1.87&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/cpp_cnvt.awk.diff?cvsroot=OldCVS&tr1=1.1&tr2=1.2&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/backtrace.h.diff?cvsroot=OldCVS&tr1=1.13&tr2=1.14&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/backtrace.c.diff?cvsroot=OldCVS&tr1=1.62&tr2=1.63&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/_scm.h.diff?cvsroot=OldCVS&tr1=1.22&tr2=1.23&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/__scm.h.diff?cvsroot=OldCVS&tr1=1.68&tr2=1.69&r1=text&r2=text
http://savannah.gnu.org/cgi-bin/viewcvs/guile/guile-core/libguile/Makefile.am.diff?cvsroot=OldCVS&tr1=1.128&tr2=1.129&r1=text&r2=text
Patches:
Index: guile/guile-core/libguile/Makefile.am
diff -u guile/guile-core/libguile/Makefile.am:1.128
guile/guile-core/libguile/Makefile.am:1.129
--- guile/guile-core/libguile/Makefile.am:1.128 Tue May 1 17:45:45 2001
+++ guile/guile-core/libguile/Makefile.am Tue May 15 07:57:22 2001
@@ -49,7 +49,7 @@
random.c rdelim.c read.c root.c rw.c scmsigs.c script.c simpos.c smob.c \
sort.c srcprop.c stackchk.c stacks.c stime.c strings.c strop.c \
strorder.c strports.c struct.c symbols.c tag.c throw.c values.c \
- variable.c vectors.c version.c vports.c weaks.c
+ variable.c vectors.c version.c vports.c weaks.c symbols-deprecated.c
DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x \
continuations.x debug.x deprecation.x dynl.x dynwind.x \
@@ -62,23 +62,24 @@
scmsigs.x script.x simpos.x smob.x sort.x srcprop.x
\
stackchk.x stacks.x stime.x strings.x strop.x strorder.x strports.x
\
struct.x symbols.x tag.x throw.x values.x variable.x vectors.x \
- version.x vports.x weaks.x
+ version.x vports.x weaks.x symbols-deprecated.x
EXTRA_DOT_X_FILES = @EXTRA_DOT_X_FILES@
-DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc \
- boolean.doc chars.doc continuations.doc debug.doc dynl.doc \
- dynwind.doc environments.doc eq.doc error.doc eval.doc evalext.doc \
- feature.doc fluids.doc fports.doc gc.doc goops.doc gsubr.doc \
- guardians.doc hash.doc hashtab.doc hooks.doc init.doc ioext.doc \
- iselect.doc keywords.doc lang.doc list.doc load.doc macros.doc \
- mallocs.doc modules.doc numbers.doc objects.doc objprop.doc \
- options.doc pairs.doc ports.doc print.doc procprop.doc \
+DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.doc \
+ boolean.doc chars.doc continuations.doc debug.doc dynl.doc \
+ dynwind.doc environments.doc eq.doc error.doc eval.doc evalext.doc \
+ feature.doc fluids.doc fports.doc gc.doc goops.doc gsubr.doc \
+ guardians.doc hash.doc hashtab.doc hooks.doc init.doc ioext.doc \
+ iselect.doc keywords.doc lang.doc list.doc load.doc macros.doc \
+ mallocs.doc modules.doc numbers.doc objects.doc objprop.doc
\
+ options.doc pairs.doc ports.doc print.doc procprop.doc \
procs.doc properties.doc random.doc rdelim.doc read.doc root.doc rw.doc \
- scmsigs.doc script.doc simpos.doc smob.doc sort.doc \
- srcprop.doc stackchk.doc stacks.doc stime.doc strings.doc strop.doc
\
- strorder.doc strports.doc struct.doc symbols.doc tag.doc throw.doc \
- values.doc variable.doc vectors.doc version.doc vports.doc weaks.doc
+ scmsigs.doc script.doc simpos.doc smob.doc sort.doc
\
+ srcprop.doc stackchk.doc stacks.doc stime.doc strings.doc strop.doc
\
+ strorder.doc strports.doc struct.doc symbols.doc tag.doc throw.doc \
+ values.doc variable.doc vectors.doc version.doc vports.doc weaks.doc \
+ symbols-deprecated.doc
EXTRA_DOT_DOC_FILES = @EXTRA_DOT_DOC_FILES@
Index: guile/guile-core/libguile/__scm.h
diff -u guile/guile-core/libguile/__scm.h:1.68
guile/guile-core/libguile/__scm.h:1.69
--- guile/guile-core/libguile/__scm.h:1.68 Sat May 5 18:25:15 2001
+++ guile/guile-core/libguile/__scm.h Tue May 15 07:57:22 2001
@@ -195,6 +195,15 @@
#define SCM_DEBUG_TYPING_STRICTNESS 0
#endif
+/* If SCM_ENABLE_VCELLS is set to 1, a couple of functions that deal
+ * with vcells are defined for compatability reasons. Supporting
+ * vcells reduces performance however.
+ *
+ * We use a dedicated macro instead of just SCM_DEBUG_DEPRECATED so
+ * that code the belongs to the `vcell' feature is easier to find.
+ */
+#define SCM_ENABLE_VCELLS !SCM_DEBUG_DEPRECATED
+
#ifdef HAVE_LONG_LONGS
Index: guile/guile-core/libguile/_scm.h
diff -u guile/guile-core/libguile/_scm.h:1.22
guile/guile-core/libguile/_scm.h:1.23
--- guile/guile-core/libguile/_scm.h:1.22 Sat Mar 10 08:56:06 2001
+++ guile/guile-core/libguile/_scm.h Tue May 15 07:57:22 2001
@@ -75,6 +75,8 @@
switching at async ticks. */
#endif
#include "libguile/snarf.h" /* Everyone snarfs. */
+#include "libguile/variable.h"
+#include "libguile/modules.h"
/* SCM_SYSCALL retries system calls that have been interrupted (EINTR).
However this can be avoided if the operating system can restart
Index: guile/guile-core/libguile/backtrace.c
diff -u guile/guile-core/libguile/backtrace.c:1.62
guile/guile-core/libguile/backtrace.c:1.63
--- guile/guile-core/libguile/backtrace.c:1.62 Sat Mar 31 13:19:50 2001
+++ guile/guile-core/libguile/backtrace.c Tue May 15 07:57:22 2001
@@ -80,7 +80,7 @@
return SCM_BOOL_F;
#endif
-SCM scm_the_last_stack_fluid;
+SCM scm_the_last_stack_fluid_var;
static void
display_header (SCM source, SCM port)
@@ -634,7 +634,7 @@
}
#undef FUNC_NAME
-SCM_VCELL (scm_has_shown_backtrace_hint_p_var, "has-shown-backtrace-hint?");
+SCM_VARIABLE (scm_has_shown_backtrace_hint_p_var, "has-shown-backtrace-hint?");
SCM_DEFINE (scm_backtrace, "backtrace", 0, 0, 0,
(),
@@ -642,7 +642,8 @@
"to the current output port.")
#define FUNC_NAME s_scm_backtrace
{
- SCM the_last_stack = scm_fluid_ref (SCM_CDR (scm_the_last_stack_fluid));
+ SCM the_last_stack =
+ scm_fluid_ref (SCM_VARIABLE_REF (scm_the_last_stack_fluid_var));
if (SCM_NFALSEP (the_last_stack))
{
scm_newline (scm_cur_outp);
@@ -652,14 +653,14 @@
SCM_UNDEFINED,
SCM_UNDEFINED);
scm_newline (scm_cur_outp);
- if (SCM_FALSEP (SCM_CDR (scm_has_shown_backtrace_hint_p_var))
+ if (SCM_FALSEP (SCM_VARIABLE_REF (scm_has_shown_backtrace_hint_p_var))
&& !SCM_BACKTRACE_P)
{
scm_puts ("Type \"(debug-enable 'backtrace)\" if you would like "
"a backtrace\n"
"automatically if an error occurs in the future.\n",
scm_cur_outp);
- SCM_SETCDR (scm_has_shown_backtrace_hint_p_var, SCM_BOOL_T);
+ SCM_VARIABLE_SET (scm_has_shown_backtrace_hint_p_var, SCM_BOOL_T);
}
}
else
@@ -676,7 +677,7 @@
scm_init_backtrace ()
{
SCM f = scm_make_fluid ();
- scm_the_last_stack_fluid = scm_sysintern ("the-last-stack", f);
+ scm_the_last_stack_fluid_var = scm_c_define ("the-last-stack", f);
#ifndef SCM_MAGIC_SNARFER
#include "libguile/backtrace.x"
Index: guile/guile-core/libguile/backtrace.h
diff -u guile/guile-core/libguile/backtrace.h:1.13
guile/guile-core/libguile/backtrace.h:1.14
--- guile/guile-core/libguile/backtrace.h:1.13 Wed Jan 24 07:58:46 2001
+++ guile/guile-core/libguile/backtrace.h Tue May 15 07:57:22 2001
@@ -49,7 +49,7 @@
#include "libguile/__scm.h"
-extern SCM scm_the_last_stack_fluid;
+extern SCM scm_the_last_stack_fluid_var;
void scm_display_error_message (SCM message, SCM args, SCM port);
void scm_i_display_error (SCM stack, SCM port, SCM subr, SCM message, SCM
args, SCM rest);
Index: guile/guile-core/libguile/cpp_cnvt.awk
diff -u guile/guile-core/libguile/cpp_cnvt.awk:1.1
guile/guile-core/libguile/cpp_cnvt.awk:1.2
--- guile/guile-core/libguile/cpp_cnvt.awk:1.1 Sat Mar 29 10:42:26 1997
+++ guile/guile-core/libguile/cpp_cnvt.awk Tue May 15 07:57:22 2001
@@ -2,6 +2,6 @@
# in Guile.
{
print "#ifdef " $0;
-print "scm_sysintern (\""$0"\", SCM_MAKINUM ("$0"));";
+print "scm_c_define (\""$0"\", SCM_MAKINUM ("$0"));";
print "#endif"
}
Index: guile/guile-core/libguile/debug.c
diff -u guile/guile-core/libguile/debug.c:1.86
guile/guile-core/libguile/debug.c:1.87
--- guile/guile-core/libguile/debug.c:1.86 Thu Apr 19 08:20:27 2001
+++ guile/guile-core/libguile/debug.c Tue May 15 07:57:22 2001
@@ -260,17 +260,12 @@
"@var{env}.")
#define FUNC_NAME s_scm_make_gloc
{
-#if 1 /* Unsafe */
- if (SCM_CONSP (var))
- var = scm_cons (SCM_BOOL_F, var);
- else
-#endif
- SCM_VALIDATE_VARIABLE (1,var);
+ SCM_VALIDATE_VARIABLE (1,var);
if (SCM_UNBNDP (env))
env = scm_top_level_env (SCM_TOP_LEVEL_LOOKUP_CLOSURE);
else
SCM_VALIDATE_NULLORCONS (2,env);
- return scm_make_memoized (SCM_VARVCELL (var) + 1, env);
+ return scm_make_memoized (SCM_UNPACK (var) + scm_tc3_cons_gloc, env);
}
#undef FUNC_NAME
@@ -279,8 +274,9 @@
"Return @code{#t} if @var{obj} is a gloc.")
#define FUNC_NAME s_scm_gloc_p
{
- return SCM_BOOL((SCM_MEMOIZEDP (obj)
- && (SCM_UNPACK(SCM_MEMOIZED_EXP (obj)) & 7) == 1));
+ return
+ SCM_BOOL (SCM_MEMOIZEDP (obj)
+ && ((SCM_UNPACK(SCM_MEMOIZED_EXP(obj))&7) == scm_tc3_cons_gloc));
}
#undef FUNC_NAME
@@ -623,23 +619,23 @@
scm_set_smob_print (scm_tc16_debugobj, debugobj_print);
#ifdef GUILE_DEBUG
- scm_sysintern ("SCM_IM_AND", SCM_IM_AND);
- scm_sysintern ("SCM_IM_BEGIN", SCM_IM_BEGIN);
- scm_sysintern ("SCM_IM_CASE", SCM_IM_CASE);
- scm_sysintern ("SCM_IM_COND", SCM_IM_COND);
- scm_sysintern ("SCM_IM_DO", SCM_IM_DO);
- scm_sysintern ("SCM_IM_IF", SCM_IM_IF);
- scm_sysintern ("SCM_IM_LAMBDA", SCM_IM_LAMBDA);
- scm_sysintern ("SCM_IM_LET", SCM_IM_LET);
- scm_sysintern ("SCM_IM_LETSTAR", SCM_IM_LETSTAR);
- scm_sysintern ("SCM_IM_LETREC", SCM_IM_LETREC);
- scm_sysintern ("SCM_IM_OR", SCM_IM_OR);
- scm_sysintern ("SCM_IM_QUOTE", SCM_IM_QUOTE);
- scm_sysintern ("SCM_IM_SET_X", SCM_IM_SET_X);
- scm_sysintern ("SCM_IM_DEFINE", SCM_IM_DEFINE);
- scm_sysintern ("SCM_IM_APPLY", SCM_IM_APPLY);
- scm_sysintern ("SCM_IM_CONT", SCM_IM_CONT);
- scm_sysintern ("SCM_IM_DISPATCH", SCM_IM_DISPATCH);
+ scm_define ("SCM_IM_AND", SCM_IM_AND);
+ scm_define ("SCM_IM_BEGIN", SCM_IM_BEGIN);
+ scm_define ("SCM_IM_CASE", SCM_IM_CASE);
+ scm_define ("SCM_IM_COND", SCM_IM_COND);
+ scm_define ("SCM_IM_DO", SCM_IM_DO);
+ scm_define ("SCM_IM_IF", SCM_IM_IF);
+ scm_define ("SCM_IM_LAMBDA", SCM_IM_LAMBDA);
+ scm_define ("SCM_IM_LET", SCM_IM_LET);
+ scm_define ("SCM_IM_LETSTAR", SCM_IM_LETSTAR);
+ scm_define ("SCM_IM_LETREC", SCM_IM_LETREC);
+ scm_define ("SCM_IM_OR", SCM_IM_OR);
+ scm_define ("SCM_IM_QUOTE", SCM_IM_QUOTE);
+ scm_define ("SCM_IM_SET_X", SCM_IM_SET_X);
+ scm_define ("SCM_IM_DEFINE", SCM_IM_DEFINE);
+ scm_define ("SCM_IM_APPLY", SCM_IM_APPLY);
+ scm_define ("SCM_IM_CONT", SCM_IM_CONT);
+ scm_define ("SCM_IM_DISPATCH", SCM_IM_DISPATCH);
#endif
scm_add_feature ("debug-extensions");
Index: guile/guile-core/libguile/deprecation.c
diff -u guile/guile-core/libguile/deprecation.c:1.3
guile/guile-core/libguile/deprecation.c:1.4
--- guile/guile-core/libguile/deprecation.c:1.3 Mon May 14 09:38:08 2001
+++ guile/guile-core/libguile/deprecation.c Tue May 15 07:57:22 2001
@@ -116,8 +116,8 @@
SCM_DEFINE(scm_include_deprecated_features,
"include-deprecated-features", 0, 0, 0,
(),
- "Return @code{#t} iff deprecated features should be included\n"
- "in public interfaces.")
+ "Return @code{#t} iff deprecated features should be included
+ in public interfaces.")
#define FUNC_NAME s_scm_include_deprecated_features
{
#if SCM_DEBUG_DEPRECATED == 0
Index: guile/guile-core/libguile/dynwind.c
diff -u guile/guile-core/libguile/dynwind.c:1.35
guile/guile-core/libguile/dynwind.c:1.36
--- guile/guile-core/libguile/dynwind.c:1.35 Tue Apr 3 06:19:04 2001
+++ guile/guile-core/libguile/dynwind.c Tue May 15 07:57:22 2001
@@ -193,8 +193,7 @@
while (SCM_NIMP (vals))
{
tmp = SCM_GLOC_VAL (SCM_CAR (glocs));
- SCM_SETCDR (SCM_PACK (SCM_UNPACK (SCM_CAR (glocs)) - 1L),
- SCM_CAR (vals));
+ SCM_GLOC_SET_VAL (SCM_CAR (glocs), SCM_CAR (vals));
SCM_SETCAR (vals, tmp);
glocs = SCM_CDR (glocs);
vals = SCM_CDR (vals);
Index: guile/guile-core/libguile/eval.c
diff -u guile/guile-core/libguile/eval.c:1.219
guile/guile-core/libguile/eval.c:1.220
--- guile/guile-core/libguile/eval.c:1.219 Tue May 15 02:45:10 2001
+++ guile/guile-core/libguile/eval.c Tue May 15 07:57:21 2001
@@ -52,7 +52,6 @@
* marked with the string "SECTION:".
*/
-
/* SECTION: This code is compiled once.
*/
@@ -265,9 +264,6 @@
{
SCM env = genv;
register SCM *al, fl, var = SCM_CAR (vloc);
-#ifdef USE_THREADS
- register SCM var2 = var;
-#endif
#ifdef MEMOIZE_LOCALS
register SCM iloc = SCM_ILOC00;
#endif
@@ -322,69 +318,70 @@
#endif
}
{
- SCM top_thunk, vcell;
+ SCM top_thunk, real_var;
if (SCM_NIMP (env))
{
- top_thunk = SCM_CAR (env); /* env now refers to a top level env
thunk */
+ top_thunk = SCM_CAR (env); /* env now refers to a
+ top level env thunk */
env = SCM_CDR (env);
}
else
top_thunk = SCM_BOOL_F;
- vcell = scm_sym2vcell (var, top_thunk, SCM_BOOL_F);
- if (SCM_FALSEP (vcell))
+ real_var = scm_sym2var (var, top_thunk, SCM_BOOL_F);
+ if (SCM_FALSEP (real_var))
goto errout;
- else
- var = vcell;
- }
+
#ifndef SCM_RECKLESS
- if (SCM_NNULLP (env) || SCM_UNBNDP (SCM_CDR (var)))
- {
- var = SCM_CAR (var);
- errout:
- /* scm_everr (vloc, genv,...) */
- if (check)
- {
- if (SCM_NULLP (env))
- scm_error (scm_unbound_variable_key, NULL, "Unbound variable: ~S",
- scm_cons (var, SCM_EOL), SCM_BOOL_F);
- else
- scm_misc_error (NULL, "Damaged environment: ~S",
- scm_cons (var, SCM_EOL));
- }
- else {
- /* A variable could not be found, but we shall not throw an error. */
- static SCM undef_object = SCM_UNDEFINED;
- return &undef_object;
+ if (SCM_NNULLP (env) || SCM_UNBNDP (SCM_VARIABLE_REF (real_var)))
+ {
+ errout:
+ /* scm_everr (vloc, genv,...) */
+ if (check)
+ {
+ if (SCM_NULLP (env))
+ scm_error (scm_unbound_variable_key, NULL,
+ "Unbound variable: ~S",
+ scm_cons (var, SCM_EOL), SCM_BOOL_F);
+ else
+ scm_misc_error (NULL, "Damaged environment: ~S",
+ scm_cons (var, SCM_EOL));
+ }
+ else
+ {
+ /* A variable could not be found, but we shall
+ not throw an error. */
+ static SCM undef_object = SCM_UNDEFINED;
+ return &undef_object;
+ }
}
- }
#endif
+
#ifdef USE_THREADS
- if (SCM_CAR (vloc) != var2)
- {
- /* Some other thread has changed the very cell we are working
- on. In effect, it must have done our job or messed it up
- completely. */
- race:
- var = SCM_CAR (vloc);
- if (SCM_ITAG3 (var) == scm_tc3_cons_gloc)
- return SCM_GLOC_VAL_LOC (var);
+ if (SCM_CAR (vloc) != var)
+ {
+ /* Some other thread has changed the very cell we are working
+ on. In effect, it must have done our job or messed it up
+ completely. */
+ race:
+ var = SCM_CAR (vloc);
+ if (SCM_ITAG3 (var) == scm_tc3_cons_gloc)
+ return SCM_GLOC_VAL_LOC (var);
#ifdef MEMOIZE_LOCALS
- if (SCM_ITAG7 (var) == SCM_ITAG7 (SCM_ILOC00))
- return scm_ilookup (var, genv);
+ if (SCM_ITAG7 (var) == SCM_ITAG7 (SCM_ILOC00))
+ return scm_ilookup (var, genv);
#endif
- /* We can't cope with anything else than glocs and ilocs. When
- a special form has been memoized (i.e. `let' into address@hidden') we
- return NULL and expect the calling function to do the right
- thing. For the evaluator, this means going back and redoing
- the dispatch on the car of the form. */
- return NULL;
- }
+ /* We can't cope with anything else than glocs and ilocs. When
+ a special form has been memoized (i.e. `let' into address@hidden') we
+ return NULL and expect the calling function to do the right
+ thing. For the evaluator, this means going back and redoing
+ the dispatch on the car of the form. */
+ return NULL;
+ }
#endif /* USE_THREADS */
- SCM_SET_CELL_WORD_0 (vloc, SCM_UNPACK (var) + scm_tc3_cons_gloc);
- /* Except wait...what if the var is not a vcell,
- * but syntax or something.... */
- return SCM_CDRLOC (var);
+ SCM_SET_CELL_WORD_0 (vloc, SCM_UNPACK (real_var) + scm_tc3_cons_gloc);
+ return SCM_VARIABLE_LOC (real_var);
+ }
}
#ifdef USE_THREADS
@@ -400,6 +397,8 @@
#define unmemocar scm_unmemocar
+SCM_SYMBOL (sym_three_question_marks, "???");
+
SCM
scm_unmemocar (SCM form, SCM env)
{
@@ -409,7 +408,13 @@
return form;
c = SCM_CAR (form);
if (SCM_ITAG3 (c) == scm_tc3_cons_gloc)
- SCM_SETCAR (form, SCM_GLOC_SYM (c));
+ {
+ SCM sym =
+ scm_module_reverse_lookup (scm_env_module (env), SCM_GLOC_VAR (c));
+ if (sym == SCM_BOOL_F)
+ sym = sym_three_question_marks;
+ SCM_SETCAR (form, sym);
+ }
#ifdef MEMOIZE_LOCALS
#ifdef DEBUG_EXTENSIONS
else if (SCM_ILOCP (c))
@@ -885,10 +890,10 @@
}
}
#endif
- arg1 = scm_sym2vcell (proc, scm_env_top_level (env), SCM_BOOL_T);
- SCM_SETCDR (arg1, x);
+ arg1 = scm_sym2var (proc, scm_env_top_level (env), SCM_BOOL_T);
+ SCM_VARIABLE_SET (arg1, x);
#ifdef SICP
- return scm_cons2 (scm_sym_quote, SCM_CAR (arg1), SCM_EOL);
+ return scm_cons2 (scm_sym_quote, proc, SCM_EOL);
#else
return SCM_UNSPECIFIED;
#endif
@@ -1030,8 +1035,8 @@
/* Multi-language support */
-SCM scm_lisp_nil;
-SCM scm_lisp_t;
+SCM_GLOBAL_SYMBOL (scm_lisp_nil, "nil");
+SCM_GLOBAL_SYMBOL (scm_lisp_t, "t");
SCM_SYNTAX (s_nil_cond, "nil-cond", scm_makmmacro, scm_m_nil_cond);
@@ -1094,12 +1099,12 @@
SCM
scm_m_atfop (SCM xorig, SCM env)
{
- SCM x = SCM_CDR (xorig), vcell;
+ SCM x = SCM_CDR (xorig), var;
SCM_ASSYNT (scm_ilength (x) >= 1, scm_s_expression, "@fop");
- vcell = scm_symbol_fref (SCM_CAR (x));
- SCM_ASSYNT (SCM_CONSP (vcell),
+ var = scm_symbol_fref (SCM_CAR (x));
+ SCM_ASSYNT (SCM_VARIABLEP (var),
"Symbol's function definition is void", NULL);
- SCM_SET_CELL_WORD_0 (x, SCM_UNPACK (vcell) + scm_tc3_cons_gloc);
+ SCM_SET_CELL_WORD_0 (x, SCM_UNPACK (var) + scm_tc3_cons_gloc);
return x;
}
@@ -1125,7 +1130,7 @@
x = SCM_CAR (x);
while (SCM_NIMP (x))
{
- SCM_SET_CELL_WORD_0 (x, SCM_UNPACK (scm_sym2vcell (SCM_CAR (x), env,
SCM_BOOL_T)) + scm_tc3_cons_gloc);
+ SCM_SET_CELL_WORD_0 (x, SCM_UNPACK (scm_sym2var (SCM_CAR (x), env,
SCM_BOOL_T)) + scm_tc3_cons_gloc);
x = SCM_CDR (x);
}
return scm_cons (SCM_IM_BIND, SCM_CDR (xorig));
@@ -1202,13 +1207,14 @@
SCM
scm_macroexp (SCM x, SCM env)
{
- SCM res, proc;
+ SCM res, proc, orig_sym;
/* Don't bother to produce error messages here. We get them when we
eventually execute the code for real. */
macro_tail:
- if (!SCM_SYMBOLP (SCM_CAR (x)))
+ orig_sym = SCM_CAR (x);
+ if (!SCM_SYMBOLP (orig_sym))
return x;
#ifdef USE_THREADS
@@ -1231,7 +1237,7 @@
if (!SCM_MACROP (proc) || SCM_MACRO_TYPE (proc) != 2)
return x;
- unmemocar (x, env);
+ SCM_SETCAR (x, orig_sym); /* Undo memoizing effect of lookupcar */
res = scm_apply (SCM_MACRO_CODE (proc), x, scm_cons (env, scm_listofnull));
if (scm_ilength (res) <= 0)
@@ -1252,13 +1258,12 @@
* code of a closure, in scm_procedure_source, in display_frame when
* generating the source for a stackframe in a backtrace, and in
* display_expression.
- */
-
-/* We should introduce an anti-macro interface so that it is possible
- * to plug in transformers in both directions from other compilation
- * units. unmemocopy could then dispatch to anti-macro transformers.
- * (Those transformers could perhaps be written in slightly more
- * readable style... :)
+ *
+ * Unmemoizing is not a realiable process. You can not in general
+ * expect to get the original source back.
+ *
+ * However, GOOPS currently relies on this for method compilation.
+ * This ought to change.
*/
#define SCM_BIT8(x) (127 & SCM_UNPACK (x))
@@ -1519,11 +1524,12 @@
}
else if (SCM_TYP3 (l) == scm_tc3_cons_gloc)
{
- scm_bits_t vcell = SCM_STRUCT_VTABLE_DATA (l)
[scm_vtable_index_vcell];
+ scm_bits_t vcell =
+ SCM_STRUCT_VTABLE_DATA (l) [scm_vtable_index_vcell];
if (vcell == 0)
res = SCM_CAR (l); /* struct planted in code */
else
- res = SCM_PACK (vcell);
+ res = SCM_GLOC_VAL (SCM_CAR (l));
}
else
goto wrongnumargs;
@@ -1742,11 +1748,12 @@
}
else if (SCM_TYP3 (l) == scm_tc3_cons_gloc)
{
- scm_bits_t vcell = SCM_STRUCT_VTABLE_DATA (l)
[scm_vtable_index_vcell];
+ scm_bits_t vcell =
+ SCM_STRUCT_VTABLE_DATA (l) [scm_vtable_index_vcell];
if (vcell == 0)
res = SCM_CAR (l); /* struct planted in code */
else
- res = SCM_PACK (vcell);
+ res = SCM_GLOC_VAL (SCM_CAR (l));
}
else
goto wrongnumargs;
@@ -1814,7 +1821,7 @@
SCM *lloc;
SCM arg1;
} t;
- SCM proc, arg2;
+ SCM proc, arg2, orig_sym;
#ifdef DEVAL
scm_debug_frame debug;
scm_debug_info *debug_info_end;
@@ -2542,7 +2549,7 @@
/* This is a struct implanted in the code, not a gloc. */
RETURN (x);
} else {
- proc = SCM_PACK (vcell);
+ proc = SCM_GLOC_VAL (SCM_CAR (x));
SCM_ASRTGO (SCM_NIMP (proc), badfun);
#ifndef SCM_RECKLESS
#ifdef SCM_CAUTIOUS
@@ -2554,7 +2561,8 @@
}
case scm_tcs_cons_nimcar:
- if (SCM_SYMBOLP (SCM_CAR (x)))
+ orig_sym = SCM_CAR (x);
+ if (SCM_SYMBOLP (orig_sym))
{
#ifdef USE_THREADS
t.lloc = scm_lookupcar1 (x, env, 1);
@@ -2570,13 +2578,14 @@
if (SCM_IMP (proc))
{
- unmemocar (x, env);
+ SCM_SETCAR (x, orig_sym); /* Undo memoizing effect of
+ lookupcar */
goto badfun;
}
if (SCM_MACROP (proc))
{
- unmemocar (x, env);
-
+ SCM_SETCAR (x, orig_sym); /* Undo memoizing effect of
+ lookupcar */
handle_a_macro:
#ifdef DEVAL
/* Set a flag during macro expansion so that macro
@@ -2692,7 +2701,7 @@
x = SCM_CODE (proc);
env = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), SCM_EOL, SCM_ENV (proc));
goto nontoplevel_cdrxbegin;
- case scm_tcs_cons_gloc:
+ case scm_tcs_cons_gloc: /* really structs, not glocs */
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
{
x = SCM_ENTITY_PROCEDURE (proc);
@@ -2751,7 +2760,7 @@
if (vcell == 0)
t.arg1 = SCM_CAR (x); /* struct planted in code */
else
- t.arg1 = SCM_PACK (vcell);
+ t.arg1 = SCM_GLOC_VAL (SCM_CAR (x));
}
else
goto wrongnumargs;
@@ -2847,7 +2856,7 @@
env = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), scm_cons (t.arg1,
SCM_EOL), SCM_ENV (proc));
#endif
goto nontoplevel_cdrxbegin;
- case scm_tcs_cons_gloc:
+ case scm_tcs_cons_gloc: /* really structs, not glocs */
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
{
x = SCM_ENTITY_PROCEDURE (proc);
@@ -2901,7 +2910,7 @@
if (vcell == 0)
arg2 = SCM_CAR (x); /* struct planted in code */
else
- arg2 = SCM_PACK (vcell);
+ arg2 = SCM_GLOC_VAL (SCM_CAR (x));
}
else
goto wrongnumargs;
@@ -2951,7 +2960,7 @@
proc))),
SCM_EOL));
#endif
- case scm_tcs_cons_gloc:
+ case scm_tcs_cons_gloc: /* really structs, not glocs */
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
{
x = SCM_ENTITY_PROCEDURE (proc);
@@ -3165,7 +3174,7 @@
x = SCM_CODE (proc);
goto nontoplevel_cdrxbegin;
#endif /* DEVAL */
- case scm_tcs_cons_gloc:
+ case scm_tcs_cons_gloc: /* really structs, not glocs */
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
{
#ifdef DEVAL
@@ -3541,7 +3550,7 @@
debug.vect[0].a.proc = proc;
#endif
goto tail;
- case scm_tcs_cons_gloc:
+ case scm_tcs_cons_gloc: /* really structs, not glocs */
if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
{
#ifdef DEVAL
@@ -3752,6 +3761,7 @@
scm_closure (SCM code, SCM env)
{
register SCM z;
+
SCM_NEWCELL (z);
SCM_SETCODE (z, code);
SCM_SETENV (z, env);
@@ -4090,24 +4100,23 @@
scm_f_apply = scm_make_subr ("apply", scm_tc7_lsubr_2, scm_apply);
- scm_lisp_nil = scm_sysintern ("nil", SCM_UNDEFINED);
- SCM_SETCDR (scm_lisp_nil, SCM_CAR (scm_lisp_nil));
- scm_lisp_nil = SCM_CAR (scm_lisp_nil);
- scm_lisp_t = scm_sysintern ("t", SCM_UNDEFINED);
- SCM_SETCDR (scm_lisp_t, SCM_CAR (scm_lisp_t));
- scm_lisp_t = SCM_CAR (scm_lisp_t);
-
+ /* acros */
+ /* end of acros */
+
#if SCM_DEBUG_DEPRECATED == 0
scm_top_level_lookup_closure_var =
- scm_sysintern ("*top-level-lookup-closure*", scm_make_fluid ());
+ scm_c_define ("*top-level-lookup-closure*", scm_make_fluid ());
scm_system_transformer =
- scm_sysintern ("scm:eval-transformer", scm_make_fluid ());
+ scm_c_define ("scm:eval-transformer", scm_make_fluid ());
#endif
#ifndef SCM_MAGIC_SNARFER
#include "libguile/eval.x"
#endif
+ scm_c_define ("nil", scm_lisp_nil);
+ scm_c_define ("t", scm_lisp_t);
+
scm_add_feature ("delay");
}
Index: guile/guile-core/libguile/eval.h
diff -u guile/guile-core/libguile/eval.h:1.52
guile/guile-core/libguile/eval.h:1.53
--- guile/guile-core/libguile/eval.h:1.52 Tue Apr 24 16:27:13 2001
+++ guile/guile-core/libguile/eval.h Tue May 15 07:57:21 2001
@@ -46,8 +46,6 @@
#include "libguile/__scm.h"
-/* Needed by SCM_TOP_LEVEL_LOOKUP_CLOSURE below. */
-
#include "struct.h"
@@ -131,8 +129,7 @@
/*fixme* This should probably be removed throught the code. */
-#define SCM_TOP_LEVEL_LOOKUP_CLOSURE \
- SCM_MODULE_EVAL_CLOSURE (scm_current_module ())
+#define SCM_TOP_LEVEL_LOOKUP_CLOSURE (scm_current_module_lookup_closure())
#if SCM_DEBUG_DEPRECATED == 0
@@ -181,13 +178,14 @@
extern SCM scm_f_apply;
/* A resolved global variable reference in the CAR position
- * of a list is stored (in code only) as a pointer to a pair with a
+ * of a list is stored (in code only) as a pointer to a variable with a
* tag of 1. This is called a "gloc".
*/
-#define SCM_GLOC_SYM(x) (SCM_CAR (SCM_PACK (SCM_UNPACK (x) - 1L)))
-#define SCM_GLOC_VAL(x) (SCM_CDR (SCM_PACK (SCM_UNPACK (x) - 1L)))
-#define SCM_GLOC_VAL_LOC(x) (SCM_CDRLOC (SCM_PACK (SCM_UNPACK (x) - 1L)))
+#define SCM_GLOC_VAR(x) (SCM_PACK(SCM_UNPACK(x)-scm_tc3_cons_gloc))
+#define SCM_GLOC_VAL(x) (SCM_VARIABLE_REF (SCM_GLOC_VAR (x)))
+#define SCM_GLOC_SET_VAL(x, y) (SCM_VARIABLE_SET (SCM_GLOC_VAR (x), y))
+#define SCM_GLOC_VAL_LOC(x) (SCM_VARIABLE_LOC (SCM_GLOC_VAR (x)))
Index: guile/guile-core/libguile/evalext.c
diff -u guile/guile-core/libguile/evalext.c:1.32
guile/guile-core/libguile/evalext.c:1.33
--- guile/guile-core/libguile/evalext.c:1.32 Sat May 5 17:02:06 2001
+++ guile/guile-core/libguile/evalext.c Tue May 15 07:57:21 2001
@@ -77,16 +77,13 @@
"current module.")
#define FUNC_NAME s_scm_definedp
{
- SCM vcell;
+ SCM var;
SCM_VALIDATE_SYMBOL (1,sym);
if (SCM_UNBNDP (env))
- vcell = scm_sym2vcell(sym,
- scm_module_system_booted_p
- ? SCM_TOP_LEVEL_LOOKUP_CLOSURE
- : SCM_EOL,
- SCM_BOOL_F);
+ var = scm_sym2var (sym, scm_current_module_lookup_closure (),
+ SCM_BOOL_F);
else
{
SCM frames = env;
@@ -111,12 +108,12 @@
return SCM_BOOL_T;
}
}
- vcell = scm_sym2vcell (sym,
- SCM_NIMP (frames) ? SCM_CAR (frames) : SCM_BOOL_F,
- SCM_BOOL_F);
+ var = scm_sym2var (sym,
+ SCM_NIMP (frames) ? SCM_CAR (frames) : SCM_BOOL_F,
+ SCM_BOOL_F);
}
- return (SCM_FALSEP (vcell) || SCM_UNBNDP (SCM_CDR (vcell))
+ return (SCM_FALSEP (var) || SCM_UNBNDP (SCM_VARIABLE_REF (var))
? SCM_BOOL_F
: SCM_BOOL_T);
}
@@ -135,12 +132,12 @@
scm_s_expression, s_undefine);
x = SCM_CAR (x);
SCM_ASSYNT (SCM_SYMBOLP (x), scm_s_variable, s_undefine);
- arg1 = scm_sym2vcell (x, scm_env_top_level (env), SCM_BOOL_F);
- SCM_ASSYNT (SCM_NFALSEP (arg1) && !SCM_UNBNDP (SCM_CDR (arg1)),
+ arg1 = scm_sym2var (x, scm_env_top_level (env), SCM_BOOL_F);
+ SCM_ASSYNT (SCM_NFALSEP (arg1) && !SCM_UNBNDP (SCM_VARIABLE_REF (arg1)),
"variable already unbound ", s_undefine);
- SCM_SETCDR (arg1, SCM_UNDEFINED);
+ SCM_VARIABLE_SET (arg1, SCM_UNDEFINED);
#ifdef SICP
- return SCM_CAR (arg1);
+ return x;
#else
return SCM_UNSPECIFIED;
#endif
Index: guile/guile-core/libguile/feature.c
diff -u guile/guile-core/libguile/feature.c:1.45
guile/guile-core/libguile/feature.c:1.46
--- guile/guile-core/libguile/feature.c:1.45 Fri Mar 9 15:33:38 2001
+++ guile/guile-core/libguile/feature.c Tue May 15 07:57:21 2001
@@ -57,15 +57,15 @@
-static SCM features;
+static SCM features_var;
void
scm_add_feature (const char *str)
{
- SCM old = SCM_CDR (features);
+ SCM old = SCM_VARIABLE_REF (features_var);
SCM new = scm_cons (scm_str2symbol (str), old);
- SCM_SETCDR (features, new);
+ SCM_VARIABLE_SET (features_var, new);
}
@@ -103,7 +103,7 @@
void
scm_init_feature()
{
- features = scm_sysintern ("*features*", SCM_EOL);
+ features_var = scm_c_define ("*features*", SCM_EOL);
#ifdef SCM_RECKLESS
scm_add_feature("reckless");
#endif
@@ -126,7 +126,7 @@
scm_add_feature ("threads");
#endif
- scm_sysintern ("char-code-limit", SCM_MAKINUM (SCM_CHAR_CODE_LIMIT));
+ scm_c_define ("char-code-limit", SCM_MAKINUM (SCM_CHAR_CODE_LIMIT));
#ifndef SCM_MAGIC_SNARFER
#include "libguile/feature.x"
Index: guile/guile-core/libguile/filesys.c
diff -u guile/guile-core/libguile/filesys.c:1.96
guile/guile-core/libguile/filesys.c:1.97
--- guile/guile-core/libguile/filesys.c:1.96 Tue Apr 10 00:57:05 2001
+++ guile/guile-core/libguile/filesys.c Tue May 15 07:57:21 2001
@@ -1440,62 +1440,62 @@
scm_dot_string = scm_permanent_object (scm_makfrom0str ("."));
#ifdef O_RDONLY
-scm_sysintern ("O_RDONLY", scm_long2num (O_RDONLY));
+ scm_c_define ("O_RDONLY", scm_long2num (O_RDONLY));
#endif
#ifdef O_WRONLY
-scm_sysintern ("O_WRONLY", scm_long2num (O_WRONLY));
+ scm_c_define ("O_WRONLY", scm_long2num (O_WRONLY));
#endif
#ifdef O_RDWR
-scm_sysintern ("O_RDWR", scm_long2num (O_RDWR));
+ scm_c_define ("O_RDWR", scm_long2num (O_RDWR));
#endif
#ifdef O_CREAT
-scm_sysintern ("O_CREAT", scm_long2num (O_CREAT));
+ scm_c_define ("O_CREAT", scm_long2num (O_CREAT));
#endif
#ifdef O_EXCL
-scm_sysintern ("O_EXCL", scm_long2num (O_EXCL));
+ scm_c_define ("O_EXCL", scm_long2num (O_EXCL));
#endif
#ifdef O_NOCTTY
-scm_sysintern ("O_NOCTTY", scm_long2num (O_NOCTTY));
+ scm_c_define ("O_NOCTTY", scm_long2num (O_NOCTTY));
#endif
#ifdef O_TRUNC
-scm_sysintern ("O_TRUNC", scm_long2num (O_TRUNC));
+ scm_c_define ("O_TRUNC", scm_long2num (O_TRUNC));
#endif
#ifdef O_APPEND
-scm_sysintern ("O_APPEND", scm_long2num (O_APPEND));
+ scm_c_define ("O_APPEND", scm_long2num (O_APPEND));
#endif
#ifdef O_NONBLOCK
-scm_sysintern ("O_NONBLOCK", scm_long2num (O_NONBLOCK));
+ scm_c_define ("O_NONBLOCK", scm_long2num (O_NONBLOCK));
#endif
#ifdef O_NDELAY
-scm_sysintern ("O_NDELAY", scm_long2num (O_NDELAY));
+ scm_c_define ("O_NDELAY", scm_long2num (O_NDELAY));
#endif
#ifdef O_SYNC
-scm_sysintern ("O_SYNC", scm_long2num (O_SYNC));
+ scm_c_define ("O_SYNC", scm_long2num (O_SYNC));
#endif
#ifdef F_DUPFD
-scm_sysintern ("F_DUPFD", scm_long2num (F_DUPFD));
+ scm_c_define ("F_DUPFD", scm_long2num (F_DUPFD));
#endif
#ifdef F_GETFD
-scm_sysintern ("F_GETFD", scm_long2num (F_GETFD));
+ scm_c_define ("F_GETFD", scm_long2num (F_GETFD));
#endif
#ifdef F_SETFD
-scm_sysintern ("F_SETFD", scm_long2num (F_SETFD));
+ scm_c_define ("F_SETFD", scm_long2num (F_SETFD));
#endif
#ifdef F_GETFL
-scm_sysintern ("F_GETFL", scm_long2num (F_GETFL));
+ scm_c_define ("F_GETFL", scm_long2num (F_GETFL));
#endif
#ifdef F_SETFL
-scm_sysintern ("F_SETFL", scm_long2num (F_SETFL));
+ scm_c_define ("F_SETFL", scm_long2num (F_SETFL));
#endif
#ifdef F_GETOWN
-scm_sysintern ("F_GETOWN", scm_long2num (F_GETOWN));
+ scm_c_define ("F_GETOWN", scm_long2num (F_GETOWN));
#endif
#ifdef F_SETOWN
-scm_sysintern ("F_SETOWN", scm_long2num (F_SETOWN));
+ scm_c_define ("F_SETOWN", scm_long2num (F_SETOWN));
#endif
#ifdef FD_CLOEXEC
-scm_sysintern ("FD_CLOEXEC", scm_long2num (FD_CLOEXEC));
+ scm_c_define ("FD_CLOEXEC", scm_long2num (FD_CLOEXEC));
#endif
#ifndef SCM_MAGIC_SNARFER
Index: guile/guile-core/libguile/fports.c
diff -u guile/guile-core/libguile/fports.c:1.93
guile/guile-core/libguile/fports.c:1.94
--- guile/guile-core/libguile/fports.c:1.93 Tue Apr 3 06:19:04 2001
+++ guile/guile-core/libguile/fports.c Tue May 15 07:57:21 2001
@@ -802,9 +802,9 @@
{
scm_tc16_fport = scm_make_fptob ();
- scm_sysintern ("_IOFBF", SCM_MAKINUM (_IOFBF));
- scm_sysintern ("_IOLBF", SCM_MAKINUM (_IOLBF));
- scm_sysintern ("_IONBF", SCM_MAKINUM (_IONBF));
+ scm_c_define ("_IOFBF", SCM_MAKINUM (_IOFBF));
+ scm_c_define ("_IOLBF", SCM_MAKINUM (_IOLBF));
+ scm_c_define ("_IONBF", SCM_MAKINUM (_IONBF));
#ifndef SCM_MAGIC_SNARFER
#include "libguile/fports.x"
Index: guile/guile-core/libguile/gc.c
diff -u guile/guile-core/libguile/gc.c:1.196
guile/guile-core/libguile/gc.c:1.197
--- guile/guile-core/libguile/gc.c:1.196 Tue May 15 02:45:10 2001
+++ guile/guile-core/libguile/gc.c Tue May 15 07:57:21 2001
@@ -1145,6 +1145,17 @@
goto gc_mark_loop_first_time;
#endif
+/* A simple hack for debugging. Chose the second branch to get a
+ meaningful backtrace for crashes inside the GC.
+*/
+#if 1
+#define goto_gc_mark_loop goto gc_mark_loop
+#define goto_gc_mark_nimp goto gc_mark_nimp
+#else
+#define goto_gc_mark_loop RECURSE(ptr); return
+#define goto_gc_mark_nimp RECURSE(ptr); return
+#endif
+
gc_mark_loop:
if (SCM_IMP (ptr))
return;
@@ -1187,26 +1198,31 @@
if (SCM_IMP (SCM_CDR (ptr)))
{
ptr = SCM_CAR (ptr);
- goto gc_mark_nimp;
+ goto_gc_mark_nimp;
}
RECURSE (SCM_CAR (ptr));
ptr = SCM_CDR (ptr);
- goto gc_mark_nimp;
+ goto_gc_mark_nimp;
case scm_tcs_cons_imcar:
ptr = SCM_CDR (ptr);
- goto gc_mark_loop;
+ goto_gc_mark_loop;
case scm_tc7_pws:
RECURSE (SCM_SETTER (ptr));
ptr = SCM_PROCEDURE (ptr);
- goto gc_mark_loop;
+ goto_gc_mark_loop;
case scm_tcs_cons_gloc:
{
- /* Dirk:FIXME:: The following code is super ugly: ptr may be a struct
- * or a gloc. If it is a gloc, the cell word #0 of ptr is a pointer
- * to a heap cell. If it is a struct, the cell word #0 of ptr is a
- * pointer to a struct vtable data region. The fact that these are
- * accessed in the same way restricts the possibilites to change the
- * data layout of structs or heap cells.
+ /* Dirk:FIXME:: The following code is super ugly: ptr may be a
+ * struct or a gloc. If it is a gloc, the cell word #0 of ptr
+ * is the address of a scm_tc16_variable smob. If it is a
+ * struct, the cell word #0 of ptr is a pointer to a struct
+ * vtable data region. (The fact that these are accessed in
+ * the same way restricts the possibilites to change the data
+ * layout of structs or heap cells.) To discriminate between
+ * the two, it is guaranteed that the scm_vtable_index_vcell
+ * element of the prospective vtable is always zero. For a
+ * gloc, this location has the CDR of the variable smob, which
+ * is guaranteed to be non-zero.
*/
scm_bits_t word0 = SCM_CELL_WORD_0 (ptr) - scm_tc3_cons_gloc;
scm_bits_t * vtable_data = (scm_bits_t *) word0; /* access as struct */
@@ -1249,7 +1265,7 @@
}
/* mark vtable */
ptr = SCM_PACK (vtable_data [scm_vtable_index_vtable]);
- goto gc_mark_loop;
+ goto_gc_mark_loop;
}
}
break;
@@ -1257,11 +1273,11 @@
if (SCM_IMP (SCM_ENV (ptr)))
{
ptr = SCM_CLOSCAR (ptr);
- goto gc_mark_nimp;
+ goto_gc_mark_nimp;
}
RECURSE (SCM_CLOSCAR (ptr));
ptr = SCM_ENV (ptr);
- goto gc_mark_nimp;
+ goto_gc_mark_nimp;
case scm_tc7_vector:
i = SCM_VECTOR_LENGTH (ptr);
if (i == 0)
@@ -1270,7 +1286,7 @@
if (SCM_NIMP (SCM_VELTS (ptr)[i]))
RECURSE (SCM_VELTS (ptr)[i]);
ptr = SCM_VELTS (ptr)[0];
- goto gc_mark_loop;
+ goto_gc_mark_loop;
#ifdef CCLO
case scm_tc7_cclo:
{
@@ -1283,7 +1299,7 @@
RECURSE (obj);
}
ptr = SCM_CCLO_REF (ptr, 0);
- goto gc_mark_loop;
+ goto_gc_mark_loop;
}
#endif
#ifdef HAVE_ARRAYS
@@ -1304,7 +1320,7 @@
case scm_tc7_substring:
ptr = SCM_CDR (ptr);
- goto gc_mark_loop;
+ goto_gc_mark_loop;
case scm_tc7_wvect:
SCM_WVECT_GC_CHAIN (ptr) = scm_weak_vectors;
@@ -1367,7 +1383,7 @@
case scm_tc7_symbol:
ptr = SCM_PROP_SLOTS (ptr);
- goto gc_mark_loop;
+ goto_gc_mark_loop;
case scm_tcs_subrs:
break;
case scm_tc7_port:
@@ -1381,7 +1397,7 @@
if (scm_ptobs[i].mark)
{
ptr = (scm_ptobs[i].mark) (ptr);
- goto gc_mark_loop;
+ goto_gc_mark_loop;
}
else
return;
@@ -1404,7 +1420,7 @@
if (scm_smobs[i].mark)
{
ptr = (scm_smobs[i].mark) (ptr);
- goto gc_mark_loop;
+ goto_gc_mark_loop;
}
else
return;
@@ -2307,50 +2323,6 @@
}
#undef FUNC_NAME
-
-SCM_DEFINE (scm_unhash_name, "unhash-name", 1, 0, 0,
- (SCM name),
- "Flushes the glocs for @var{name}, or all glocs if @var{name}\n"
- "is @code{#t}.")
-#define FUNC_NAME s_scm_unhash_name
-{
- int x;
- int bound;
- SCM_VALIDATE_SYMBOL (1,name);
- SCM_DEFER_INTS;
- bound = scm_n_heap_segs;
- for (x = 0; x < bound; ++x)
- {
- SCM_CELLPTR p;
- SCM_CELLPTR pbound;
- p = scm_heap_table[x].bounds[0];
- pbound = scm_heap_table[x].bounds[1];
- while (p < pbound)
- {
- SCM cell = PTR2SCM (p);
- if (SCM_TYP3 (cell) == scm_tc3_cons_gloc)
- {
- /* Dirk:FIXME:: Again, super ugly code: cell may be a gloc or a
- * struct cell. See the corresponding comment in scm_gc_mark.
- */
- scm_bits_t word0 = SCM_CELL_WORD_0 (cell) - scm_tc3_cons_gloc;
- SCM gloc_car = SCM_PACK (word0); /* access as gloc */
- SCM vcell = SCM_CELL_OBJECT_1 (gloc_car);
- if ((SCM_EQ_P (name, SCM_BOOL_T) || SCM_EQ_P (SCM_CAR (gloc_car),
name))
- && (SCM_UNPACK (vcell) != 0) && (SCM_UNPACK (vcell) != 1))
- {
- SCM_SET_CELL_OBJECT_0 (cell, name);
- }
- }
- ++p;
- }
- }
- SCM_ALLOW_INTS;
- return name;
-}
-#undef FUNC_NAME
-
-
/* {GC Protection Helper Functions}
*/
@@ -2652,10 +2624,6 @@
on_exit (cleanup, 0);
#endif
#endif
-
-#define DEFAULT_SYMHASH_SIZE 277
- scm_symhash = scm_c_make_hash_table (DEFAULT_SYMHASH_SIZE);
- scm_symhash_vars = scm_c_make_hash_table (DEFAULT_SYMHASH_SIZE);
scm_stand_in_procs = SCM_EOL;
scm_permobjs = SCM_EOL;
Index: guile/guile-core/libguile/gdbint.c
diff -u guile/guile-core/libguile/gdbint.c:1.38
guile/guile-core/libguile/gdbint.c:1.39
--- guile/guile-core/libguile/gdbint.c:1.38 Thu Mar 22 04:52:02 2001
+++ guile/guile-core/libguile/gdbint.c Tue May 15 07:57:21 2001
@@ -300,10 +300,8 @@
}
SCM_BEGIN_FOREIGN_BLOCK;
{
- SCM vcell = scm_sym2vcell (name,
- SCM_TOP_LEVEL_LOOKUP_CLOSURE,
- SCM_BOOL_T);
- SCM_SETCDR (vcell, value);
+ SCM var = scm_sym2var (name, SCM_TOP_LEVEL_LOOKUP_CLOSURE, SCM_BOOL_T);
+ SCM_VARIABLE_SET (var, value);
}
SCM_END_FOREIGN_BLOCK;
return 0;
Index: guile/guile-core/libguile/gh_data.c
diff -u guile/guile-core/libguile/gh_data.c:1.58
guile/guile-core/libguile/gh_data.c:1.59
--- guile/guile-core/libguile/gh_data.c:1.58 Mon May 7 11:11:20 2001
+++ guile/guile-core/libguile/gh_data.c Tue May 15 07:57:21 2001
@@ -708,14 +708,14 @@
gh_module_lookup (SCM module, const char *sname)
#define FUNC_NAME "gh_module_lookup"
{
- SCM sym, cell;
+ SCM sym, var;
SCM_VALIDATE_MODULE (SCM_ARG1, module);
sym = gh_symbol2scm (sname);
- cell = scm_sym2vcell (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
- if (cell != SCM_BOOL_F)
- return SCM_CDR (cell);
+ var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
+ if (var != SCM_BOOL_F)
+ return SCM_VARIABLE_REF (var);
else
return SCM_UNDEFINED;
}
Index: guile/guile-core/libguile/gh_funcs.c
diff -u guile/guile-core/libguile/gh_funcs.c:1.8
guile/guile-core/libguile/gh_funcs.c:1.9
--- guile/guile-core/libguile/gh_funcs.c:1.8 Fri Mar 9 15:33:39 2001
+++ guile/guile-core/libguile/gh_funcs.c Tue May 15 07:57:21 2001
@@ -130,7 +130,8 @@
SCM
gh_define (const char *name, SCM val)
{
- return scm_sysintern (name, val);
+ scm_c_define (name, val);
+ return SCM_UNSPECIFIED;
}
Index: guile/guile-core/libguile/goops.c
diff -u guile/guile-core/libguile/goops.c:1.28
guile/guile-core/libguile/goops.c:1.29
--- guile/guile-core/libguile/goops.c:1.28 Thu Apr 19 07:46:01 2001
+++ guile/guile-core/libguile/goops.c Tue May 15 07:57:21 2001
@@ -79,7 +79,7 @@
scm_module_goops); }
/* Temporary hack until we get the new module system */
/*fixme* Should optimize by keeping track of the variable object itself */
-#define GETVAR(v) (SCM_CDDR (scm_apply (scm_goops_lookup_closure, \
+#define GETVAR(v) (SCM_VARIABLE_REF (scm_apply (scm_goops_lookup_closure, \
SCM_LIST2 ((v), SCM_BOOL_F), \
SCM_EOL)))
@@ -1861,7 +1861,8 @@
}
#undef FUNC_NAME
-SCM_VCELL_INIT (var_compute_applicable_methods, "compute-applicable-methods",
scm_make_gsubr (s_sys_compute_applicable_methods, 2, 0, 0,
scm_sys_compute_applicable_methods));
+SCM_SYMBOL (sym_compute_applicable_methods, "compute-applicable-methods");
+SCM_VARIABLE_INIT (var_compute_applicable_methods,
"compute-applicable-methods", scm_make_gsubr (s_sys_compute_applicable_methods,
2, 0, 0, scm_sys_compute_applicable_methods));
SCM_SYNTAX (s_atslot_ref, "@slot-ref", scm_makmmacro, scm_m_atslot_ref);
@@ -2635,11 +2636,9 @@
#define FUNC_NAME s_scm_sys_goops_loaded
{
goops_loaded_p = 1;
- var_compute_applicable_methods
- = SCM_CDR (scm_apply (scm_goops_lookup_closure,
- SCM_LIST2 (SCM_CAR (var_compute_applicable_methods),
- SCM_BOOL_F),
- SCM_EOL));
+ var_compute_applicable_methods =
+ scm_sym2var (sym_compute_applicable_methods, scm_goops_lookup_closure,
+ SCM_BOOL_F);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
Index: guile/guile-core/libguile/gsubr.c
diff -u guile/guile-core/libguile/gsubr.c:1.35
guile/guile-core/libguile/gsubr.c:1.36
--- guile/guile-core/libguile/gsubr.c:1.35 Mon Dec 11 06:48:23 2000
+++ guile/guile-core/libguile/gsubr.c Tue May 15 07:57:21 2001
@@ -77,7 +77,9 @@
case SCM_GSUBR_MAKTYPE(2, 0, 1): return scm_make_subr(name, scm_tc7_lsubr_2,
fcn);
default:
{
- SCM symcell = scm_sysintern (name, SCM_UNDEFINED);
+ SCM sym = scm_str2symbol (name);
+ SCM var = scm_sym2var (sym, scm_current_module_lookup_closure (),
+ SCM_BOOL_T);
SCM cclo = scm_makcclo (scm_f_gsubr_apply, 3L);
if (SCM_GSUBR_MAX < req + opt + rst) {
fputs("ERROR in scm_make_gsubr: too many args\n", stderr);
@@ -85,10 +87,10 @@
}
SCM_SET_GSUBR_PROC (cclo, scm_make_subr_opt (name, scm_tc7_subr_0, fcn,
0));
SCM_SET_GSUBR_TYPE (cclo, SCM_MAKINUM (SCM_GSUBR_MAKTYPE (req, opt,
rst)));
- SCM_SETCDR (symcell, cclo);
+ SCM_VARIABLE_SET (var, cclo);
#ifdef DEBUG_EXTENSIONS
if (SCM_REC_PROCNAMES_P)
- scm_set_procedure_property_x (cclo, scm_sym_name, SCM_CAR (symcell));
+ scm_set_procedure_property_x (cclo, scm_sym_name, sym);
#endif
return cclo;
}
Index: guile/guile-core/libguile/hooks.c
diff -u guile/guile-core/libguile/hooks.c:1.13
guile/guile-core/libguile/hooks.c:1.14
--- guile/guile-core/libguile/hooks.c:1.13 Tue May 8 03:30:32 2001
+++ guile/guile-core/libguile/hooks.c Tue May 15 07:57:21 2001
@@ -198,7 +198,7 @@
scm_create_hook (const char* name, int n_args)
{
SCM hook = make_hook (SCM_MAKINUM (n_args), "scm_create_hook");
- scm_sysintern (name, hook);
+ scm_c_define (name, hook);
scm_protect_object (hook);
return hook;
}
Index: guile/guile-core/libguile/init.c
diff -u guile/guile-core/libguile/init.c:1.121
guile/guile-core/libguile/init.c:1.122
--- guile/guile-core/libguile/init.c:1.121 Tue May 15 02:45:10 2001
+++ guile/guile-core/libguile/init.c Tue May 15 07:57:21 2001
@@ -366,8 +366,6 @@
/* Load the init.scm file. */
if (SCM_NFALSEP (init_path))
scm_primitive_load (init_path);
-
- scm_post_boot_init_modules ();
}
}
@@ -477,6 +475,8 @@
scm_weaks_prehistory (); /* requires storage */
scm_init_subr_table ();
scm_environments_prehistory (); /* requires storage */
+ scm_modules_prehistory (); /* requires storage */
+ scm_init_variable (); /* all bindings need variables */
scm_init_continuations ();
scm_init_root (); /* requires continuations */
#ifdef USE_THREADS
@@ -555,7 +555,6 @@
scm_init_strorder ();
scm_init_strop ();
scm_init_throw ();
- scm_init_variable ();
scm_init_vectors ();
scm_init_version ();
scm_init_weaks ();
Index: guile/guile-core/libguile/keywords.c
diff -u guile/guile-core/libguile/keywords.c:1.38
guile/guile-core/libguile/keywords.c:1.39
--- guile/guile-core/libguile/keywords.c:1.38 Tue Apr 3 06:19:04 2001
+++ guile/guile-core/libguile/keywords.c Tue May 15 07:57:21 2001
@@ -71,24 +71,21 @@
"Make a keyword object from a @var{symbol} that starts with a
dash.")
#define FUNC_NAME s_scm_make_keyword_from_dash_symbol
{
- SCM vcell;
+ SCM keyword;
SCM_ASSERT (SCM_SYMBOLP (symbol)
&& ('-' == SCM_SYMBOL_CHARS(symbol)[0]),
symbol, SCM_ARG1, FUNC_NAME);
SCM_DEFER_INTS;
- vcell = scm_sym2ovcell_soft (symbol, scm_keyword_obarray);
- if (SCM_FALSEP (vcell))
+ keyword = scm_hashq_ref (scm_keyword_obarray, symbol, SCM_BOOL_F);
+ if (SCM_FALSEP (keyword))
{
- SCM keyword;
SCM_NEWSMOB (keyword, scm_tc16_keyword, SCM_UNPACK (symbol));
- scm_intern_symbol (scm_keyword_obarray, symbol);
- vcell = scm_sym2ovcell_soft (symbol, scm_keyword_obarray);
- SCM_SETCDR (vcell, keyword);
+ scm_hashq_set_x (scm_keyword_obarray, symbol, keyword);
}
SCM_ALLOW_INTS;
- return SCM_CDR (vcell);
+ return keyword;
}
#undef FUNC_NAME
Index: guile/guile-core/libguile/load.c
diff -u guile/guile-core/libguile/load.c:1.58
guile/guile-core/libguile/load.c:1.59
--- guile/guile-core/libguile/load.c:1.58 Tue May 15 02:45:10 2001
+++ guile/guile-core/libguile/load.c Tue May 15 07:57:21 2001
@@ -494,7 +494,7 @@
init_build_info ()
{
static struct { char *name; char *value; } info[] = SCM_BUILD_INFO;
- SCM *loc = SCM_CDRLOC (scm_sysintern ("%guile-build-info", SCM_EOL));
+ SCM *loc = SCM_VARIABLE_LOC (scm_c_define ("%guile-build-info", SCM_EOL));
unsigned int i;
for (i = 0; i < (sizeof (info) / sizeof (info[0])); i++)
@@ -509,12 +509,12 @@
scm_init_load ()
{
scm_listofnullstr = scm_permanent_object (SCM_LIST1 (scm_nullstr));
- scm_loc_load_path = SCM_CDRLOC (scm_sysintern ("%load-path", SCM_EOL));
+ scm_loc_load_path = SCM_VARIABLE_LOC (scm_c_define ("%load-path", SCM_EOL));
scm_loc_load_extensions
- = SCM_CDRLOC (scm_sysintern ("%load-extensions",
- SCM_LIST2 (scm_makfrom0str (".scm"),
- scm_nullstr)));
- scm_loc_load_hook = SCM_CDRLOC (scm_sysintern ("%load-hook", SCM_BOOL_F));
+ = SCM_VARIABLE_LOC (scm_c_define ("%load-extensions",
+ SCM_LIST2 (scm_makfrom0str (".scm"),
+ scm_nullstr)));
+ scm_loc_load_hook = SCM_VARIABLE_LOC (scm_c_define ("%load-hook",
SCM_BOOL_F));
init_build_info ();
Index: guile/guile-core/libguile/macros.c
diff -u guile/guile-core/libguile/macros.c:1.27
guile/guile-core/libguile/macros.c:1.28
--- guile/guile-core/libguile/macros.c:1.27 Thu Apr 19 07:46:01 2001
+++ guile/guile-core/libguile/macros.c Tue May 15 07:57:21 2001
@@ -220,10 +220,10 @@
SCM
scm_make_synt (const char *name, SCM (*macroizer) (), SCM (*fcn)() )
{
- SCM symcell = scm_sysintern (name, SCM_UNDEFINED);
+ SCM var = scm_c_define (name, SCM_UNDEFINED);
SCM transformer = scm_make_subr_opt (name, scm_tc7_subr_2, fcn, 0);
- SCM_SETCDR (symcell, macroizer (transformer));
- return SCM_CAR (symcell);
+ SCM_VARIABLE_SET (var, macroizer (transformer));
+ return SCM_UNSPECIFIED;
}
void
Index: guile/guile-core/libguile/modules.c
diff -u guile/guile-core/libguile/modules.c:1.22
guile/guile-core/libguile/modules.c:1.23
--- guile/guile-core/libguile/modules.c:1.22 Tue Apr 24 16:40:18 2001
+++ guile/guile-core/libguile/modules.c Tue May 15 07:57:21 2001
@@ -57,18 +57,20 @@
#include "libguile/modules.h"
-SCM scm_module_system_booted_p = 0;
+int scm_module_system_booted_p = 0;
SCM scm_module_tag;
-SCM scm_module_type;
-static SCM the_root_module;
+static SCM the_root_module_var;
static SCM root_module_lookup_closure;
SCM
scm_the_root_module ()
{
- return SCM_CDR (the_root_module);
+ if (scm_module_system_booted_p)
+ return SCM_VARIABLE_REF (the_root_module_var);
+ else
+ return SCM_BOOL_F;
}
static SCM the_module;
@@ -82,12 +84,7 @@
}
#undef FUNC_NAME
-#define SCM_VALIDATE_STRUCT_TYPE(pos, v, type) \
- do { \
- SCM_ASSERT (SCM_NIMP (v) && SCM_NFALSEP (SCM_STRUCTP (v)) \
- && SCM_STRUCT_VTABLE (v) == (type), \
- v, pos, FUNC_NAME); \
- } while (0)
+static void scm_post_boot_init_modules (void);
SCM_DEFINE (scm_set_current_module, "set-current-module", 1, 0, 0,
(SCM module),
@@ -97,21 +94,18 @@
{
SCM old;
- /* XXX - we can not validate our argument when the module system
- hasn't been booted yet since we don't know the type. This
- should be fixed when we have a cleaner way of booting
- Guile.
- */
- if (scm_module_system_booted_p)
- SCM_VALIDATE_STRUCT_TYPE (SCM_ARG1, module, scm_module_type);
+ if (!scm_module_system_booted_p)
+ scm_post_boot_init_modules ();
+
+ SCM_VALIDATE_MODULE (SCM_ARG1, module);
old = scm_current_module ();
scm_fluid_set_x (the_module, module);
#if SCM_DEBUG_DEPRECATED == 0
- scm_fluid_set_x (SCM_CDR (scm_top_level_lookup_closure_var),
+ scm_fluid_set_x (SCM_VARIABLE_REF (scm_top_level_lookup_closure_var),
scm_current_module_lookup_closure ());
- scm_fluid_set_x (SCM_CDR (scm_system_transformer),
+ scm_fluid_set_x (SCM_VARIABLE_REF (scm_system_transformer),
scm_current_module_transformer ());
#endif
@@ -145,13 +139,13 @@
return scm_append (SCM_LIST2 (module_prefix, name));
}
-static SCM make_modules_in;
-static SCM beautify_user_module_x;
+static SCM make_modules_in_var;
+static SCM beautify_user_module_x_var;
SCM
scm_make_module (SCM name)
{
- return scm_apply (SCM_CDR (make_modules_in),
+ return scm_apply (SCM_VARIABLE_REF (make_modules_in_var),
SCM_LIST2 (scm_the_root_module (),
scm_module_full_name (name)),
SCM_EOL);
@@ -160,14 +154,18 @@
SCM
scm_ensure_user_module (SCM module)
{
- scm_apply (SCM_CDR (beautify_user_module_x), SCM_LIST1 (module), SCM_EOL);
+ scm_apply (SCM_VARIABLE_REF (beautify_user_module_x_var),
+ SCM_LIST1 (module), SCM_EOL);
return SCM_UNSPECIFIED;
}
SCM
scm_module_lookup_closure (SCM module)
{
- return SCM_MODULE_EVAL_CLOSURE (module);
+ if (module == SCM_BOOL_F)
+ return SCM_BOOL_F;
+ else
+ return SCM_MODULE_EVAL_CLOSURE (module);
}
SCM
@@ -182,7 +180,10 @@
SCM
scm_module_transformer (SCM module)
{
- return SCM_MODULE_TRANSFORMER (module);
+ if (module == SCM_BOOL_F)
+ return SCM_BOOL_F;
+ else
+ return SCM_MODULE_TRANSFORMER (module);
}
SCM
@@ -194,20 +195,22 @@
return SCM_BOOL_F;
}
-static SCM resolve_module;
+static SCM resolve_module_var;
SCM
scm_resolve_module (SCM name)
{
- return scm_apply (SCM_CDR (resolve_module), SCM_LIST1 (name), SCM_EOL);
+ return scm_apply (SCM_VARIABLE_REF (resolve_module_var),
+ SCM_LIST1 (name), SCM_EOL);
}
-static SCM try_module_autoload;
+static SCM try_module_autoload_var;
SCM
scm_load_scheme_module (SCM name)
{
- return scm_apply (SCM_CDR (try_module_autoload), SCM_LIST1 (name), SCM_EOL);
+ return scm_apply (SCM_VARIABLE_REF (try_module_autoload_var),
+ SCM_LIST1 (name), SCM_EOL);
}
/* Environments */
@@ -234,6 +237,30 @@
return SCM_BOOL_F;
}
+SCM_SYMBOL (sym_module, "module");
+
+SCM
+scm_lookup_closure_module (SCM proc)
+{
+ if (SCM_FALSEP (proc))
+ return scm_the_root_module ();
+ else if (SCM_EVAL_CLOSURE_P (proc))
+ return SCM_PACK (SCM_SMOB_DATA (proc));
+ else
+ {
+ SCM mod = scm_procedure_property (proc, sym_module);
+ if (mod == SCM_BOOL_F)
+ mod = scm_the_root_module ();
+ return mod;
+ }
+}
+
+SCM
+scm_env_module (SCM env)
+{
+ return scm_lookup_closure_module (scm_env_top_level (env));
+}
+
SCM_SYMBOL (scm_sym_system_module, "system-module");
@@ -256,7 +283,7 @@
* The code will be replaced by the low-level environments in next release.
*/
-static SCM module_make_local_var_x;
+static SCM module_make_local_var_x_var;
static SCM
module_variable (SCM module, SCM sym)
@@ -293,6 +320,10 @@
scm_bits_t scm_tc16_eval_closure;
+#define SCM_F_EVAL_CLOSURE_INTERFACE (1<<16)
+#define SCM_EVAL_CLOSURE_INTERFACE_P(e) \
+ (SCM_CELL_WORD_0 (e) & SCM_F_EVAL_CLOSURE_INTERFACE)
+
/* NOTE: This function may be called by a smob application
or from another C function directly. */
SCM
@@ -300,9 +331,13 @@
{
SCM module = SCM_PACK (SCM_SMOB_DATA (eclo));
if (SCM_NFALSEP (definep))
- return scm_apply (SCM_CDR (module_make_local_var_x),
- SCM_LIST2 (module, sym),
- SCM_EOL);
+ {
+ if (SCM_EVAL_CLOSURE_INTERFACE_P (eclo))
+ return SCM_BOOL_F;
+ return scm_apply (SCM_VARIABLE_REF (module_make_local_var_x_var),
+ SCM_LIST2 (module, sym),
+ SCM_EOL);
+ }
else
return module_variable (module, sym);
}
@@ -316,14 +351,222 @@
}
#undef FUNC_NAME
+SCM_DEFINE (scm_standard_interface_eval_closure,
+ "standard-interface-eval-closure", 1, 0, 0,
+ (SCM module),
+ "Return a interface eval closure for the module @var{module}. "
+ "Such a closure does not allow new bindings to be added.")
+#define FUNC_NAME s_scm_standard_interface_eval_closure
+{
+ SCM_RETURN_NEWSMOB (scm_tc16_eval_closure | SCM_F_EVAL_CLOSURE_INTERFACE,
+ SCM_UNPACK (module));
+}
+#undef FUNC_NAME
+
+/* scm_sym2var
+ *
+ * looks up the variable bound to SYM according to PROC. PROC should be
+ * a `eval closure' of some module.
+ *
+ * When no binding exists, and DEFINEP is true, create a new binding
+ * with a initial value of SCM_UNDEFINED. Return `#f' when DEFINEP as
+ * false and no binding exists.
+ *
+ * When PROC is `#f', it is ignored and the binding is searched for in
+ * the scm_pre_modules_obarray (a `eq' hash table).
+ */
+
+SCM scm_pre_modules_obarray;
+
+SCM
+scm_sym2var (SCM sym, SCM proc, SCM definep)
+#define FUNC_NAME "scm_sym2var"
+{
+ SCM var;
+
+ if (SCM_NIMP (proc))
+ {
+ if (SCM_EVAL_CLOSURE_P (proc))
+ {
+ /* Bypass evaluator in the standard case. */
+ var = scm_eval_closure_lookup (proc, sym, definep);
+ }
+ else
+ var = scm_apply (proc, sym, scm_cons (definep, scm_listofnull));
+ }
+ else
+ {
+ SCM handle;
+
+ if (definep == SCM_BOOL_F)
+ var = scm_hashq_ref (scm_pre_modules_obarray, sym, SCM_BOOL_F);
+ else
+ {
+ handle = scm_hashq_create_handle_x (scm_pre_modules_obarray,
+ sym, SCM_BOOL_F);
+ var = SCM_CDR (handle);
+ if (var == SCM_BOOL_F)
+ {
+ var = scm_make_variable (SCM_UNDEFINED);
+#if SCM_ENABLE_VCELLS
+ scm_variable_set_name_hint (var, sym);
+#endif
+ SCM_SETCDR (handle, var);
+ }
+ }
+ }
+
+ if (var != SCM_BOOL_F && !SCM_VARIABLEP (var))
+ SCM_MISC_ERROR ("~S is not bound to a variable", SCM_LIST1 (sym));
+
+ return var;
+}
+#undef FUNC_NAME
+
+SCM
+scm_c_module_lookup (SCM module, const char *name)
+{
+ return scm_module_lookup (module, scm_str2symbol (name));
+}
+
+SCM
+scm_module_lookup (SCM module, SCM sym)
+#define FUNC_NAME "module-lookup"
+{
+ SCM var;
+ SCM_VALIDATE_MODULE (1, module);
+
+ var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
+ if (SCM_FALSEP (var))
+ SCM_MISC_ERROR ("unbound variable: ~S", SCM_LIST1 (sym));
+ return var;
+}
+#undef FUNC_NAME
+
+SCM
+scm_c_lookup (const char *name)
+{
+ return scm_lookup (scm_str2symbol (name));
+}
+
+SCM
+scm_lookup (SCM sym)
+{
+ SCM var =
+ scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_F);
+ if (SCM_FALSEP (var))
+ scm_misc_error ("scm_lookup", "unbound variable: ~S", SCM_LIST1 (sym));
+ return var;
+}
+
+SCM
+scm_c_module_define (SCM module, const char *name, SCM value)
+{
+ return scm_module_define (module, scm_str2symbol (name), value);
+}
+
+SCM
+scm_module_define (SCM module, SCM sym, SCM value)
+#define FUNC_NAME "module-define"
+{
+ SCM var;
+ SCM_VALIDATE_MODULE (1, module);
+
+ var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_T);
+ SCM_VARIABLE_SET (var, value);
+ return var;
+}
+#undef FUNC_NAME
+
+SCM
+scm_c_define (const char *name, SCM value)
+{
+ return scm_define (scm_str2symbol (name), value);
+}
+
+SCM
+scm_define (SCM sym, SCM value)
+{
+ SCM var =
+ scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_T);
+ SCM_VARIABLE_SET (var, value);
+ return var;
+}
+
+SCM
+scm_module_reverse_lookup (SCM module, SCM variable)
+#define FUNC_NAME "module-reverse-lookup"
+{
+ SCM obarray;
+ int i, n;
+
+ if (module == SCM_BOOL_F)
+ obarray = scm_pre_modules_obarray;
+ else
+ {
+ SCM_VALIDATE_MODULE (1, module);
+ obarray = SCM_MODULE_OBARRAY (module);
+ }
+
+ /* XXX - We do not use scm_hash_fold here to avoid searching the
+ whole obarray. We should have a scm_hash_find procedure. */
+
+ n = SCM_VECTOR_LENGTH (obarray);
+ for (i = 0; i < n; ++i)
+ {
+ SCM ls = SCM_VELTS (obarray)[i], handle;
+ while (!SCM_NULLP (ls))
+ {
+ handle = SCM_CAR (ls);
+ if (SCM_CDR (handle) == variable)
+ return SCM_CAR (handle);
+ ls = SCM_CDR (ls);
+ }
+ }
+
+ /* Try the `uses' list.
+ */
+ {
+ SCM uses = SCM_MODULE_USES (module);
+ while (SCM_CONSP (uses))
+ {
+ SCM sym = scm_module_reverse_lookup (SCM_CAR (uses), variable);
+ if (sym != SCM_BOOL_F)
+ return sym;
+ uses = SCM_CDR (uses);
+ }
+ }
+
+ return SCM_BOOL_F;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_get_pre_modules_obarray, "%get-pre-modules-obarray", 0, 0, 0,
+ (),
+ "Return the obarray that is used for all new bindings before "
+ "the module system is booted. The first call to "
+ "@code{set-current-module} will boot the module system.")
+#define FUNC_NAME s_scm_get_pre_modules_obarray
+{
+ return scm_pre_modules_obarray;
+}
+#undef FUNC_NAME
+
+void
+scm_modules_prehistory ()
+{
+ scm_pre_modules_obarray
+ = scm_permanent_object (scm_c_make_hash_table (2001));
+}
+
void
scm_init_modules ()
{
#ifndef SCM_MAGIC_SNARFER
#include "libguile/modules.x"
#endif
- module_make_local_var_x = scm_sysintern ("module-make-local-var!",
- SCM_UNDEFINED);
+ module_make_local_var_x_var = scm_c_define ("module-make-local-var!",
+ SCM_UNDEFINED);
scm_tc16_eval_closure = scm_make_smob_type ("eval-closure", 0);
scm_set_smob_mark (scm_tc16_eval_closure, scm_markcdr);
scm_set_smob_apply (scm_tc16_eval_closure, scm_eval_closure_lookup, 2, 0, 0);
@@ -331,21 +574,21 @@
the_module = scm_permanent_object (scm_make_fluid ());
}
-void
+static void
scm_post_boot_init_modules ()
{
- scm_module_type =
- scm_permanent_object (SCM_CDR (scm_intern0 ("module-type")));
- scm_module_tag = (SCM_CELL_WORD_1 (scm_module_type) + scm_tc3_cons_gloc);
- module_prefix = scm_permanent_object (SCM_LIST2 (scm_sym_app,
- scm_sym_modules));
- make_modules_in = scm_intern0 ("make-modules-in");
- beautify_user_module_x = scm_intern0 ("beautify-user-module!");
- the_root_module = scm_intern0 ("the-root-module");
- root_module_lookup_closure = scm_permanent_object
- (scm_module_lookup_closure (SCM_CDR (the_root_module)));
- resolve_module = scm_intern0 ("resolve-module");
- try_module_autoload = scm_intern0 ("try-module-autoload");
+#define PERM(x) scm_permanent_object(x)
+
+ SCM module_type = SCM_VARIABLE_REF (scm_c_lookup ("module-type"));
+ scm_module_tag = (SCM_CELL_WORD_1 (module_type) + scm_tc3_cons_gloc);
+ module_prefix = PERM (SCM_LIST2 (scm_sym_app, scm_sym_modules));
+ make_modules_in_var = PERM (scm_c_lookup ("make-modules-in"));
+ beautify_user_module_x_var = PERM (scm_c_lookup ("beautify-user-module!"));
+ the_root_module_var = PERM (scm_c_lookup ("the-root-module"));
+ root_module_lookup_closure =
+ PERM (scm_module_lookup_closure (SCM_VARIABLE_REF (the_root_module_var)));
+ resolve_module_var = PERM (scm_c_lookup ("resolve-module"));
+ try_module_autoload_var = PERM (scm_c_lookup ("try-module-autoload"));
scm_module_system_booted_p = 1;
}
Index: guile/guile-core/libguile/modules.h
diff -u guile/guile-core/libguile/modules.h:1.13
guile/guile-core/libguile/modules.h:1.14
--- guile/guile-core/libguile/modules.h:1.13 Tue Apr 24 16:40:18 2001
+++ guile/guile-core/libguile/modules.h Tue May 15 07:57:21 2001
@@ -82,7 +82,7 @@
-extern SCM scm_module_system_booted_p;
+extern int scm_module_system_booted_p;
extern SCM scm_module_tag;
extern SCM scm_the_root_module (void);
@@ -102,8 +102,27 @@
extern SCM scm_system_module_env_p (SCM env);
extern SCM scm_eval_closure_lookup (SCM eclo, SCM sym, SCM definep);
extern SCM scm_standard_eval_closure (SCM module);
+extern SCM scm_standard_interface_eval_closure (SCM module);
+extern SCM scm_get_pre_modules_obarray (void);
+
+extern SCM scm_lookup_closure_module (SCM proc);
+extern SCM scm_env_module (SCM env);
+
+extern SCM scm_c_lookup (const char *name);
+extern SCM scm_c_define (const char *name, SCM val);
+extern SCM scm_lookup (SCM symbol);
+extern SCM scm_define (SCM symbol, SCM val);
+
+extern SCM scm_c_module_lookup (SCM module, const char *name);
+extern SCM scm_c_module_define (SCM module, const char *name, SCM val);
+extern SCM scm_module_lookup (SCM module, SCM symbol);
+extern SCM scm_module_define (SCM module, SCM symbol, SCM val);
+extern SCM scm_module_reverse_lookup (SCM module, SCM variable);
+
+extern SCM scm_sym2var (SCM sym, SCM thunk, SCM definep);
+
+extern void scm_modules_prehistory (void);
extern void scm_init_modules (void);
-extern void scm_post_boot_init_modules (void);
#endif /* MODULESH */
Index: guile/guile-core/libguile/numbers.c
diff -u guile/guile-core/libguile/numbers.c:1.127
guile/guile-core/libguile/numbers.c:1.128
--- guile/guile-core/libguile/numbers.c:1.127 Tue May 8 03:23:17 2001
+++ guile/guile-core/libguile/numbers.c Tue May 15 07:57:21 2001
@@ -4546,8 +4546,10 @@
* the following constants to avoid the creation of bignums. Please, before
* using these values, remember the two rules of program optimization:
* 1st Rule: Don't do it. 2nd Rule (experts only): Don't do it yet. */
- scm_sysintern ("most-positive-fixnum", SCM_MAKINUM
(SCM_MOST_POSITIVE_FIXNUM));
- scm_sysintern ("most-negative-fixnum", SCM_MAKINUM
(SCM_MOST_NEGATIVE_FIXNUM));
+ scm_c_define ("most-positive-fixnum",
+ SCM_MAKINUM (SCM_MOST_POSITIVE_FIXNUM));
+ scm_c_define ("most-negative-fixnum",
+ SCM_MAKINUM (SCM_MOST_NEGATIVE_FIXNUM));
scm_add_feature ("complex");
scm_add_feature ("inexact");
Index: guile/guile-core/libguile/objects.c
diff -u guile/guile-core/libguile/objects.c:1.56
guile/guile-core/libguile/objects.c:1.57
--- guile/guile-core/libguile/objects.c:1.56 Sat May 5 12:05:47 2001
+++ guile/guile-core/libguile/objects.c Tue May 15 07:57:21 2001
@@ -509,13 +509,13 @@
SCM et = scm_make_struct (mt, SCM_INUM0,
SCM_LIST4 (el, SCM_BOOL_F, SCM_EOL, SCM_EOL));
- scm_sysintern ("<class>", mt);
+ scm_c_define ("<class>", mt);
scm_metaclass_standard = mt;
- scm_sysintern ("<operator-class>", ot);
+ scm_c_define ("<operator-class>", ot);
scm_metaclass_operator = ot;
SCM_SET_CLASS_FLAGS (et, SCM_CLASSF_OPERATOR | SCM_CLASSF_ENTITY);
SCM_SET_CLASS_DESTRUCTOR (et, scm_struct_free_entity);
- scm_sysintern ("<entity>", et);
+ scm_c_define ("<entity>", et);
#ifndef SCM_MAGIC_SNARFER
#include "libguile/objects.x"
Index: guile/guile-core/libguile/ports.c
diff -u guile/guile-core/libguile/ports.c:1.143
guile/guile-core/libguile/ports.c:1.144
--- guile/guile-core/libguile/ports.c:1.143 Thu May 10 15:31:13 2001
+++ guile/guile-core/libguile/ports.c Tue May 15 07:57:21 2001
@@ -1564,9 +1564,9 @@
scm_init_ports ()
{
/* lseek() symbols. */
- scm_sysintern ("SEEK_SET", SCM_MAKINUM (SEEK_SET));
- scm_sysintern ("SEEK_CUR", SCM_MAKINUM (SEEK_CUR));
- scm_sysintern ("SEEK_END", SCM_MAKINUM (SEEK_END));
+ scm_c_define ("SEEK_SET", SCM_MAKINUM (SEEK_SET));
+ scm_c_define ("SEEK_CUR", SCM_MAKINUM (SEEK_CUR));
+ scm_c_define ("SEEK_END", SCM_MAKINUM (SEEK_END));
scm_tc16_void_port = scm_make_port_type ("void", fill_input_void_port,
write_void_port);
Index: guile/guile-core/libguile/posix.c
diff -u guile/guile-core/libguile/posix.c:1.88
guile/guile-core/libguile/posix.c:1.89
--- guile/guile-core/libguile/posix.c:1.88 Tue Apr 10 00:57:05 2001
+++ guile/guile-core/libguile/posix.c Tue May 15 07:57:21 2001
@@ -1572,70 +1572,70 @@
scm_add_feature ("EIDs");
#endif
#ifdef WAIT_ANY
- scm_sysintern ("WAIT_ANY", SCM_MAKINUM (WAIT_ANY));
+ scm_c_define ("WAIT_ANY", SCM_MAKINUM (WAIT_ANY));
#endif
#ifdef WAIT_MYPGRP
- scm_sysintern ("WAIT_MYPGRP", SCM_MAKINUM (WAIT_MYPGRP));
+ scm_c_define ("WAIT_MYPGRP", SCM_MAKINUM (WAIT_MYPGRP));
#endif
#ifdef WNOHANG
- scm_sysintern ("WNOHANG", SCM_MAKINUM (WNOHANG));
+ scm_c_define ("WNOHANG", SCM_MAKINUM (WNOHANG));
#endif
#ifdef WUNTRACED
- scm_sysintern ("WUNTRACED", SCM_MAKINUM (WUNTRACED));
+ scm_c_define ("WUNTRACED", SCM_MAKINUM (WUNTRACED));
#endif
/* access() symbols. */
- scm_sysintern ("R_OK", SCM_MAKINUM (R_OK));
- scm_sysintern ("W_OK", SCM_MAKINUM (W_OK));
- scm_sysintern ("X_OK", SCM_MAKINUM (X_OK));
- scm_sysintern ("F_OK", SCM_MAKINUM (F_OK));
+ scm_c_define ("R_OK", SCM_MAKINUM (R_OK));
+ scm_c_define ("W_OK", SCM_MAKINUM (W_OK));
+ scm_c_define ("X_OK", SCM_MAKINUM (X_OK));
+ scm_c_define ("F_OK", SCM_MAKINUM (F_OK));
#ifdef LC_COLLATE
- scm_sysintern ("LC_COLLATE", SCM_MAKINUM (LC_COLLATE));
+ scm_c_define ("LC_COLLATE", SCM_MAKINUM (LC_COLLATE));
#endif
#ifdef LC_CTYPE
- scm_sysintern ("LC_CTYPE", SCM_MAKINUM (LC_CTYPE));
+ scm_c_define ("LC_CTYPE", SCM_MAKINUM (LC_CTYPE));
#endif
#ifdef LC_MONETARY
- scm_sysintern ("LC_MONETARY", SCM_MAKINUM (LC_MONETARY));
+ scm_c_define ("LC_MONETARY", SCM_MAKINUM (LC_MONETARY));
#endif
#ifdef LC_NUMERIC
- scm_sysintern ("LC_NUMERIC", SCM_MAKINUM (LC_NUMERIC));
+ scm_c_define ("LC_NUMERIC", SCM_MAKINUM (LC_NUMERIC));
#endif
#ifdef LC_TIME
- scm_sysintern ("LC_TIME", SCM_MAKINUM (LC_TIME));
+ scm_c_define ("LC_TIME", SCM_MAKINUM (LC_TIME));
#endif
#ifdef LC_MESSAGES
- scm_sysintern ("LC_MESSAGES", SCM_MAKINUM (LC_MESSAGES));
+ scm_c_define ("LC_MESSAGES", SCM_MAKINUM (LC_MESSAGES));
#endif
#ifdef LC_ALL
- scm_sysintern ("LC_ALL", SCM_MAKINUM (LC_ALL));
+ scm_c_define ("LC_ALL", SCM_MAKINUM (LC_ALL));
#endif
#ifdef PIPE_BUF
-scm_sysintern ("PIPE_BUF", scm_long2num (PIPE_BUF));
+ scm_c_define ("PIPE_BUF", scm_long2num (PIPE_BUF));
#endif
#ifdef PRIO_PROCESS
- scm_sysintern ("PRIO_PROCESS", SCM_MAKINUM (PRIO_PROCESS));
+ scm_c_define ("PRIO_PROCESS", SCM_MAKINUM (PRIO_PROCESS));
#endif
#ifdef PRIO_PGRP
- scm_sysintern ("PRIO_PGRP", SCM_MAKINUM (PRIO_PGRP));
+ scm_c_define ("PRIO_PGRP", SCM_MAKINUM (PRIO_PGRP));
#endif
#ifdef PRIO_USER
- scm_sysintern ("PRIO_USER", SCM_MAKINUM (PRIO_USER));
+ scm_c_define ("PRIO_USER", SCM_MAKINUM (PRIO_USER));
#endif
#ifdef LOCK_SH
- scm_sysintern ("LOCK_SH", SCM_MAKINUM (LOCK_SH));
+ scm_c_define ("LOCK_SH", SCM_MAKINUM (LOCK_SH));
#endif
#ifdef LOCK_EX
- scm_sysintern ("LOCK_EX", SCM_MAKINUM (LOCK_EX));
+ scm_c_define ("LOCK_EX", SCM_MAKINUM (LOCK_EX));
#endif
#ifdef LOCK_UN
- scm_sysintern ("LOCK_UN", SCM_MAKINUM (LOCK_UN));
+ scm_c_define ("LOCK_UN", SCM_MAKINUM (LOCK_UN));
#endif
#ifdef LOCK_NB
- scm_sysintern ("LOCK_NB", SCM_MAKINUM (LOCK_NB));
+ scm_c_define ("LOCK_NB", SCM_MAKINUM (LOCK_NB));
#endif
#include "libguile/cpp_sig_symbols.c"
Index: guile/guile-core/libguile/print.c
diff -u guile/guile-core/libguile/print.c:1.121
guile/guile-core/libguile/print.c:1.122
--- guile/guile-core/libguile/print.c:1.121 Sat Apr 21 14:50:08 2001
+++ guile/guile-core/libguile/print.c Tue May 15 07:57:21 2001
@@ -371,7 +371,8 @@
case scm_tc3_cons_gloc:
/* gloc */
scm_puts ("#@", port);
- exp = SCM_GLOC_SYM (exp);
+ exp = scm_module_reverse_lookup (scm_current_module (),
+ SCM_GLOC_VAR (exp));
goto taloop;
case scm_tc3_cons:
switch (SCM_TYP7 (exp))
Index: guile/guile-core/libguile/procs.c
diff -u guile/guile-core/libguile/procs.c:1.54
guile/guile-core/libguile/procs.c:1.55
--- guile/guile-core/libguile/procs.c:1.54 Wed May 9 14:50:43 2001
+++ guile/guile-core/libguile/procs.c Tue May 15 07:57:21 2001
@@ -73,7 +73,7 @@
scm_make_subr_opt (const char *name, int type, SCM (*fcn) (), int set)
{
SCM symbol;
- SCM symcell;
+ SCM var;
register SCM z;
int entry;
@@ -89,17 +89,14 @@
scm_subr_table_room = new_size;
}
+ symbol = scm_str2symbol (name);
+
SCM_NEWCELL (z);
if (set)
- {
- symcell = scm_sysintern (name, SCM_UNDEFINED);
- symbol = SCM_CAR (symcell);
- }
+ var = scm_sym2var (symbol, scm_current_module_lookup_closure (),
+ SCM_BOOL_T);
else
- {
- symcell = SCM_BOOL_F; /* to avoid warning */
- symbol = scm_str2symbol (name);
- }
+ var = SCM_BOOL_F;
entry = scm_subr_table_size;
scm_subr_table[entry].handle = z;
@@ -112,7 +109,7 @@
scm_subr_table_size++;
if (set)
- SCM_SETCDR (symcell, z);
+ SCM_VARIABLE_SET (var, z);
return z;
}
Index: guile/guile-core/libguile/ramap.c
diff -u guile/guile-core/libguile/ramap.c:1.68
guile/guile-core/libguile/ramap.c:1.69
--- guile/guile-core/libguile/ramap.c:1.68 Sun May 6 15:14:09 2001
+++ guile/guile-core/libguile/ramap.c Tue May 15 07:57:21 2001
@@ -2043,12 +2043,19 @@
}
-
static void
init_raprocs (ra_iproc *subra)
{
for (; subra->name; subra++)
- subra->sproc = scm_symbol_binding (SCM_BOOL_F, scm_str2symbol
(subra->name));
+ {
+ SCM sym = scm_str2symbol (subra->name);
+ SCM var =
+ scm_sym2var (sym, scm_current_module_lookup_closure (), SCM_BOOL_F);
+ if (var != SCM_BOOL_F)
+ subra->sproc = SCM_VARIABLE_REF (var);
+ else
+ subra->sproc = SCM_BOOL_F;
+ }
}
Index: guile/guile-core/libguile/random.c
diff -u guile/guile-core/libguile/random.c:1.40
guile/guile-core/libguile/random.c:1.41
--- guile/guile-core/libguile/random.c:1.40 Tue Apr 3 06:19:04 2001
+++ guile/guile-core/libguile/random.c Tue May 15 07:57:21 2001
@@ -352,7 +352,7 @@
* Scheme level interface.
*/
-SCM_GLOBAL_VCELL_INIT (scm_var_random_state, "*random-state*",
scm_seed_to_random_state (scm_makfrom0str
("URL:http://stat.fsu.edu/~geo/diehard.html";)));
+SCM_GLOBAL_VARIABLE_INIT (scm_var_random_state, "*random-state*",
scm_seed_to_random_state (scm_makfrom0str
("URL:http://stat.fsu.edu/~geo/diehard.html";)));
SCM_DEFINE (scm_random, "random", 1, 1, 0,
(SCM n, SCM state),
@@ -371,7 +371,7 @@
#define FUNC_NAME s_scm_random
{
if (SCM_UNBNDP (state))
- state = SCM_CDR (scm_var_random_state);
+ state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (2,state);
if (SCM_INUMP (n))
{
@@ -394,7 +394,7 @@
#define FUNC_NAME s_scm_copy_random_state
{
if (SCM_UNBNDP (state))
- state = SCM_CDR (scm_var_random_state);
+ state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (1,state);
return make_rstate (scm_the_rng.copy_rstate (SCM_RSTATE (state)));
}
@@ -420,7 +420,7 @@
#define FUNC_NAME s_scm_random_uniform
{
if (SCM_UNBNDP (state))
- state = SCM_CDR (scm_var_random_state);
+ state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (1,state);
return scm_make_real (scm_c_uniform01 (SCM_RSTATE (state)));
}
@@ -435,7 +435,7 @@
#define FUNC_NAME s_scm_random_normal
{
if (SCM_UNBNDP (state))
- state = SCM_CDR (scm_var_random_state);
+ state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (1,state);
return scm_make_real (scm_c_normal01 (SCM_RSTATE (state)));
}
@@ -492,7 +492,7 @@
{
SCM_VALIDATE_VECTOR_OR_DVECTOR (1,v);
if (SCM_UNBNDP (state))
- state = SCM_CDR (scm_var_random_state);
+ state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (2,state);
scm_random_normal_vector_x (v, state);
vector_scale (v,
@@ -515,7 +515,7 @@
{
SCM_VALIDATE_VECTOR_OR_DVECTOR (1,v);
if (SCM_UNBNDP (state))
- state = SCM_CDR (scm_var_random_state);
+ state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (2,state);
scm_random_normal_vector_x (v, state);
vector_scale (v, 1 / sqrt (vector_sum_squares (v)));
@@ -534,7 +534,7 @@
int n;
SCM_VALIDATE_VECTOR_OR_DVECTOR (1,v);
if (SCM_UNBNDP (state))
- state = SCM_CDR (scm_var_random_state);
+ state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (2,state);
n = SCM_INUM (scm_uniform_vector_length (v));
if (SCM_VECTORP (v))
@@ -557,7 +557,7 @@
#define FUNC_NAME s_scm_random_exp
{
if (SCM_UNBNDP (state))
- state = SCM_CDR (scm_var_random_state);
+ state = SCM_VARIABLE_REF (scm_var_random_state);
SCM_VALIDATE_RSTATE (1,state);
return scm_make_real (scm_c_exp1 (SCM_RSTATE (state)));
}
Index: guile/guile-core/libguile/read.c
diff -u guile/guile-core/libguile/read.c:1.67
guile/guile-core/libguile/read.c:1.68
--- guile/guile-core/libguile/read.c:1.67 Thu Mar 22 04:52:02 2001
+++ guile/guile-core/libguile/read.c Tue May 15 07:57:21 2001
@@ -819,7 +819,7 @@
scm_init_read ()
{
scm_read_hash_procedures =
- SCM_CDRLOC (scm_sysintern ("read-hash-procedures", SCM_EOL));
+ SCM_VARIABLE_LOC (scm_c_define ("read-hash-procedures", SCM_EOL));
scm_init_opts (scm_read_options, scm_read_opts, SCM_N_READ_OPTIONS);
#ifndef SCM_MAGIC_SNARFER
Index: guile/guile-core/libguile/regex-posix.c
diff -u guile/guile-core/libguile/regex-posix.c:1.50
guile/guile-core/libguile/regex-posix.c:1.51
--- guile/guile-core/libguile/regex-posix.c:1.50 Sat May 5 17:39:01 2001
+++ guile/guile-core/libguile/regex-posix.c Tue May 15 07:57:20 2001
@@ -303,14 +303,14 @@
scm_set_smob_free (scm_tc16_regex, regex_free);
/* Compilation flags. */
- scm_sysintern ("regexp/basic", scm_long2num (REG_BASIC));
- scm_sysintern ("regexp/extended", scm_long2num (REG_EXTENDED));
- scm_sysintern ("regexp/icase", scm_long2num (REG_ICASE));
- scm_sysintern ("regexp/newline", scm_long2num (REG_NEWLINE));
+ scm_c_define ("regexp/basic", scm_long2num (REG_BASIC));
+ scm_c_define ("regexp/extended", scm_long2num (REG_EXTENDED));
+ scm_c_define ("regexp/icase", scm_long2num (REG_ICASE));
+ scm_c_define ("regexp/newline", scm_long2num (REG_NEWLINE));
/* Execution flags. */
- scm_sysintern ("regexp/notbol", scm_long2num (REG_NOTBOL));
- scm_sysintern ("regexp/noteol", scm_long2num (REG_NOTEOL));
+ scm_c_define ("regexp/notbol", scm_long2num (REG_NOTBOL));
+ scm_c_define ("regexp/noteol", scm_long2num (REG_NOTEOL));
#ifndef SCM_MAGIC_SNARFER
#include "libguile/regex-posix.x"
Index: guile/guile-core/libguile/root.h
diff -u guile/guile-core/libguile/root.h:1.32
guile/guile-core/libguile/root.h:1.33
--- guile/guile-core/libguile/root.h:1.32 Wed Dec 13 03:38:30 2000
+++ guile/guile-core/libguile/root.h Tue May 15 07:57:20 2001
@@ -61,20 +61,18 @@
#define scm_undefineds scm_sys_protects[2]
#define scm_nullvect scm_sys_protects[3]
#define scm_nullstr scm_sys_protects[4]
-#define scm_symhash scm_sys_protects[5]
-#define scm_symhash_vars scm_sys_protects[6]
-#define scm_keyword_obarray scm_sys_protects[7]
-#define scm_stand_in_procs scm_sys_protects[8]
-#define scm_object_whash scm_sys_protects[9]
-#define scm_permobjs scm_sys_protects[10]
-#define scm_asyncs scm_sys_protects[11]
-#define scm_protects scm_sys_protects[12]
-#define scm_properties_whash scm_sys_protects[13]
+#define scm_keyword_obarray scm_sys_protects[5]
+#define scm_stand_in_procs scm_sys_protects[6]
+#define scm_object_whash scm_sys_protects[7]
+#define scm_permobjs scm_sys_protects[8]
+#define scm_asyncs scm_sys_protects[9]
+#define scm_protects scm_sys_protects[10]
+#define scm_properties_whash scm_sys_protects[11]
#ifdef DEBUG_EXTENSIONS
-#define scm_source_whash scm_sys_protects[14]
-#define SCM_NUM_PROTECTS 15
+#define scm_source_whash scm_sys_protects[12]
+#define SCM_NUM_PROTECTS 13
#else
-#define SCM_NUM_PROTECTS 14
+#define SCM_NUM_PROTECTS 12
#endif
extern SCM scm_sys_protects[];
Index: guile/guile-core/libguile/scmsigs.c
diff -u guile/guile-core/libguile/scmsigs.c:1.56
guile/guile-core/libguile/scmsigs.c:1.57
--- guile/guile-core/libguile/scmsigs.c:1.56 Fri May 4 14:54:00 2001
+++ guile/guile-core/libguile/scmsigs.c Tue May 15 07:57:20 2001
@@ -492,8 +492,8 @@
int i;
signal_handlers =
- SCM_CDRLOC (scm_sysintern ("signal-handlers",
- scm_c_make_vector (NSIG, SCM_BOOL_F)));
+ SCM_VARIABLE_LOC (scm_c_define ("signal-handlers",
+ scm_c_make_vector (NSIG, SCM_BOOL_F)));
thunk = scm_make_gsubr ("%deliver-signals", 0, 0, 0,
sys_deliver_signals);
signal_async = scm_system_async (thunk);
@@ -532,14 +532,14 @@
#endif
}
- scm_sysintern ("NSIG", scm_long2num (NSIG));
- scm_sysintern ("SIG_IGN", scm_long2num ((long) SIG_IGN));
- scm_sysintern ("SIG_DFL", scm_long2num ((long) SIG_DFL));
+ scm_c_define ("NSIG", scm_long2num (NSIG));
+ scm_c_define ("SIG_IGN", scm_long2num ((long) SIG_IGN));
+ scm_c_define ("SIG_DFL", scm_long2num ((long) SIG_DFL));
#ifdef SA_NOCLDSTOP
- scm_sysintern ("SA_NOCLDSTOP", scm_long2num (SA_NOCLDSTOP));
+ scm_c_define ("SA_NOCLDSTOP", scm_long2num (SA_NOCLDSTOP));
#endif
#ifdef SA_RESTART
- scm_sysintern ("SA_RESTART", scm_long2num (SA_RESTART));
+ scm_c_define ("SA_RESTART", scm_long2num (SA_RESTART));
#endif
#ifndef SCM_MAGIC_SNARFER
Index: guile/guile-core/libguile/script.c
diff -u guile/guile-core/libguile/script.c:1.38
guile/guile-core/libguile/script.c:1.39
--- guile/guile-core/libguile/script.c:1.38 Mon Apr 16 17:43:18 2001
+++ guile/guile-core/libguile/script.c Tue May 15 07:57:20 2001
@@ -571,7 +571,7 @@
scm_set_program_arguments (argc ? argc - i : 0, argv + i, argv0);
/* If the --emacs switch was set, now is when we process it. */
- scm_sysintern ("use-emacs-interface", SCM_BOOL (use_emacs_interface));
+ scm_c_define ("use-emacs-interface", SCM_BOOL (use_emacs_interface));
/* Handle the `-e' switch, if it was specified. */
if (!SCM_NULLP (entry_point))
Index: guile/guile-core/libguile/snarf.h
diff -u guile/guile-core/libguile/snarf.h:1.44
guile/guile-core/libguile/snarf.h:1.45
--- guile/guile-core/libguile/snarf.h:1.44 Sun May 6 14:19:53 2001
+++ guile/guile-core/libguile/snarf.h Tue May 15 07:57:20 2001
@@ -172,6 +172,27 @@
SCM_SNARF_HERE(SCM c_name) \
SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_make_keyword
(scheme_name)))
+#define SCM_VARIABLE(c_name, scheme_name) \
+SCM_SNARF_HERE(static SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_define (scheme_name,
SCM_BOOL_F));)
+
+#define SCM_GLOBAL_VARIABLE(c_name, scheme_name) \
+SCM_SNARF_HERE(SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_define (scheme_name,
SCM_BOOL_F));)
+
+#define SCM_VARIABLE_INIT(c_name, scheme_name, init_val) \
+SCM_SNARF_HERE(static SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_define (scheme_name,
init_val));)
+
+#define SCM_GLOBAL_VARIABLE_INIT(c_name, scheme_name, init_val) \
+SCM_SNARF_HERE(SCM c_name) \
+SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_define (scheme_name,
init_val));)
+
+#if (SCM_DEBUG_DEPRECATED == 0)
+
+#define SCM_CONST_LONG(c_name, scheme_name,value) \
+SCM_VARIABLE_INIT(c_name, scheme_name, scm_long2num(value))
+
#define SCM_VCELL(c_name, scheme_name) \
SCM_SNARF_HERE(static SCM c_name) \
SCM_SNARF_INIT(c_name = scm_permanent_object (scm_sysintern (scheme_name,
SCM_BOOL_F));)
@@ -187,11 +208,6 @@
#define SCM_GLOBAL_VCELL_INIT(c_name, scheme_name, init_val) \
SCM_SNARF_HERE(SCM c_name) \
SCM_SNARF_INIT(c_name = scm_permanent_object (scm_sysintern (scheme_name,
init_val));)
-
-#if (SCM_DEBUG_DEPRECATED == 0)
-
-#define SCM_CONST_LONG(c_name, scheme_name,value) \
-SCM_VCELL_INIT(c_name, scheme_name, scm_long2num(value))
#endif /* (SCM_DEBUG_DEPRECATED == 0) */
Index: guile/guile-core/libguile/socket.c
diff -u guile/guile-core/libguile/socket.c:1.74
guile/guile-core/libguile/socket.c:1.75
--- guile/guile-core/libguile/socket.c:1.74 Sat May 5 01:31:00 2001
+++ guile/guile-core/libguile/socket.c Tue May 15 07:57:20 2001
@@ -1264,123 +1264,123 @@
{
/* protocol families. */
#ifdef AF_UNSPEC
- scm_sysintern ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC));
+ scm_c_define ("AF_UNSPEC", SCM_MAKINUM (AF_UNSPEC));
#endif
#ifdef AF_UNIX
- scm_sysintern ("AF_UNIX", SCM_MAKINUM (AF_UNIX));
+ scm_c_define ("AF_UNIX", SCM_MAKINUM (AF_UNIX));
#endif
#ifdef AF_INET
- scm_sysintern ("AF_INET", SCM_MAKINUM (AF_INET));
+ scm_c_define ("AF_INET", SCM_MAKINUM (AF_INET));
#endif
#ifdef AF_INET6
- scm_sysintern ("AF_INET6", SCM_MAKINUM (AF_INET6));
+ scm_c_define ("AF_INET6", SCM_MAKINUM (AF_INET6));
#endif
#ifdef PF_UNSPEC
- scm_sysintern ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC));
+ scm_c_define ("PF_UNSPEC", SCM_MAKINUM (PF_UNSPEC));
#endif
#ifdef PF_UNIX
- scm_sysintern ("PF_UNIX", SCM_MAKINUM (PF_UNIX));
+ scm_c_define ("PF_UNIX", SCM_MAKINUM (PF_UNIX));
#endif
#ifdef PF_INET
- scm_sysintern ("PF_INET", SCM_MAKINUM (PF_INET));
+ scm_c_define ("PF_INET", SCM_MAKINUM (PF_INET));
#endif
#ifdef PF_INET6
- scm_sysintern ("PF_INET6", SCM_MAKINUM (PF_INET6));
+ scm_c_define ("PF_INET6", SCM_MAKINUM (PF_INET6));
#endif
/* standard addresses. */
#ifdef INADDR_ANY
- scm_sysintern ("INADDR_ANY", scm_ulong2num (INADDR_ANY));
+ scm_c_define ("INADDR_ANY", scm_ulong2num (INADDR_ANY));
#endif
#ifdef INADDR_BROADCAST
- scm_sysintern ("INADDR_BROADCAST", scm_ulong2num (INADDR_BROADCAST));
+ scm_c_define ("INADDR_BROADCAST", scm_ulong2num (INADDR_BROADCAST));
#endif
#ifdef INADDR_NONE
- scm_sysintern ("INADDR_NONE", scm_ulong2num (INADDR_NONE));
+ scm_c_define ("INADDR_NONE", scm_ulong2num (INADDR_NONE));
#endif
#ifdef INADDR_LOOPBACK
- scm_sysintern ("INADDR_LOOPBACK", scm_ulong2num (INADDR_LOOPBACK));
+ scm_c_define ("INADDR_LOOPBACK", scm_ulong2num (INADDR_LOOPBACK));
#endif
/* socket types. */
#ifdef SOCK_STREAM
- scm_sysintern ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM));
+ scm_c_define ("SOCK_STREAM", SCM_MAKINUM (SOCK_STREAM));
#endif
#ifdef SOCK_DGRAM
- scm_sysintern ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM));
+ scm_c_define ("SOCK_DGRAM", SCM_MAKINUM (SOCK_DGRAM));
#endif
#ifdef SOCK_RAW
- scm_sysintern ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW));
+ scm_c_define ("SOCK_RAW", SCM_MAKINUM (SOCK_RAW));
#endif
/* setsockopt level. */
#ifdef SOL_SOCKET
- scm_sysintern ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET));
+ scm_c_define ("SOL_SOCKET", SCM_MAKINUM (SOL_SOCKET));
#endif
#ifdef SOL_IP
- scm_sysintern ("SOL_IP", SCM_MAKINUM (SOL_IP));
+ scm_c_define ("SOL_IP", SCM_MAKINUM (SOL_IP));
#endif
#ifdef SOL_TCP
- scm_sysintern ("SOL_TCP", SCM_MAKINUM (SOL_TCP));
+ scm_c_define ("SOL_TCP", SCM_MAKINUM (SOL_TCP));
#endif
#ifdef SOL_UDP
- scm_sysintern ("SOL_UDP", SCM_MAKINUM (SOL_UDP));
+ scm_c_define ("SOL_UDP", SCM_MAKINUM (SOL_UDP));
#endif
/* setsockopt names. */
#ifdef SO_DEBUG
- scm_sysintern ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG));
+ scm_c_define ("SO_DEBUG", SCM_MAKINUM (SO_DEBUG));
#endif
#ifdef SO_REUSEADDR
- scm_sysintern ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR));
+ scm_c_define ("SO_REUSEADDR", SCM_MAKINUM (SO_REUSEADDR));
#endif
#ifdef SO_STYLE
- scm_sysintern ("SO_STYLE", SCM_MAKINUM (SO_STYLE));
+ scm_c_define ("SO_STYLE", SCM_MAKINUM (SO_STYLE));
#endif
#ifdef SO_TYPE
- scm_sysintern ("SO_TYPE", SCM_MAKINUM (SO_TYPE));
+ scm_c_define ("SO_TYPE", SCM_MAKINUM (SO_TYPE));
#endif
#ifdef SO_ERROR
- scm_sysintern ("SO_ERROR", SCM_MAKINUM (SO_ERROR));
+ scm_c_define ("SO_ERROR", SCM_MAKINUM (SO_ERROR));
#endif
#ifdef SO_DONTROUTE
- scm_sysintern ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE));
+ scm_c_define ("SO_DONTROUTE", SCM_MAKINUM (SO_DONTROUTE));
#endif
#ifdef SO_BROADCAST
- scm_sysintern ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST));
+ scm_c_define ("SO_BROADCAST", SCM_MAKINUM (SO_BROADCAST));
#endif
#ifdef SO_SNDBUF
- scm_sysintern ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF));
+ scm_c_define ("SO_SNDBUF", SCM_MAKINUM (SO_SNDBUF));
#endif
#ifdef SO_RCVBUF
- scm_sysintern ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF));
+ scm_c_define ("SO_RCVBUF", SCM_MAKINUM (SO_RCVBUF));
#endif
#ifdef SO_KEEPALIVE
- scm_sysintern ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE));
+ scm_c_define ("SO_KEEPALIVE", SCM_MAKINUM (SO_KEEPALIVE));
#endif
#ifdef SO_OOBINLINE
- scm_sysintern ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE));
+ scm_c_define ("SO_OOBINLINE", SCM_MAKINUM (SO_OOBINLINE));
#endif
#ifdef SO_NO_CHECK
- scm_sysintern ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK));
+ scm_c_define ("SO_NO_CHECK", SCM_MAKINUM (SO_NO_CHECK));
#endif
#ifdef SO_PRIORITY
- scm_sysintern ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY));
+ scm_c_define ("SO_PRIORITY", SCM_MAKINUM (SO_PRIORITY));
#endif
#ifdef SO_LINGER
- scm_sysintern ("SO_LINGER", SCM_MAKINUM (SO_LINGER));
+ scm_c_define ("SO_LINGER", SCM_MAKINUM (SO_LINGER));
#endif
/* recv/send options. */
#ifdef MSG_OOB
- scm_sysintern ("MSG_OOB", SCM_MAKINUM (MSG_OOB));
+ scm_c_define ("MSG_OOB", SCM_MAKINUM (MSG_OOB));
#endif
#ifdef MSG_PEEK
- scm_sysintern ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK));
+ scm_c_define ("MSG_PEEK", SCM_MAKINUM (MSG_PEEK));
#endif
#ifdef MSG_DONTROUTE
- scm_sysintern ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE));
+ scm_c_define ("MSG_DONTROUTE", SCM_MAKINUM (MSG_DONTROUTE));
#endif
scm_add_feature ("socket");
Index: guile/guile-core/libguile/srcprop.c
diff -u guile/guile-core/libguile/srcprop.c:1.46
guile/guile-core/libguile/srcprop.c:1.47
--- guile/guile-core/libguile/srcprop.c:1.46 Tue Apr 17 02:15:39 2001
+++ guile/guile-core/libguile/srcprop.c Tue May 15 07:57:20 2001
@@ -334,7 +334,7 @@
scm_set_smob_print (scm_tc16_srcprops, srcprops_print);
scm_source_whash = scm_make_weak_key_hash_table (SCM_MAKINUM (2047));
- scm_sysintern ("source-whash", scm_source_whash);
+ scm_c_define ("source-whash", scm_source_whash);
#ifndef SCM_MAGIC_SNARFER
#include "libguile/srcprop.x"
Index: guile/guile-core/libguile/stacks.c
diff -u guile/guile-core/libguile/stacks.c:1.57
guile/guile-core/libguile/stacks.c:1.58
--- guile/guile-core/libguile/stacks.c:1.57 Sat Apr 28 01:59:48 2001
+++ guile/guile-core/libguile/stacks.c Tue May 15 07:57:20 2001
@@ -221,9 +221,9 @@
static SCM
get_applybody ()
{
- SCM cell = scm_sym2vcell (scm_sym_apply, SCM_BOOL_F, SCM_BOOL_F);
- if (SCM_CONSP (cell) && SCM_CLOSUREP (SCM_CDR (cell)))
- return SCM_CADR (SCM_CODE (SCM_CDR (cell)));
+ SCM var = scm_sym2var (scm_sym_apply, SCM_BOOL_F, SCM_BOOL_F);
+ if (SCM_VARIABLEP (var) && SCM_CLOSUREP (SCM_VARIABLE_REF (var)))
+ return SCM_CADR (SCM_CODE (SCM_VARIABLE_REF (var)));
else
return SCM_UNDEFINED;
}
Index: guile/guile-core/libguile/stime.c
diff -u guile/guile-core/libguile/stime.c:1.65
guile/guile-core/libguile/stime.c:1.66
--- guile/guile-core/libguile/stime.c:1.65 Tue Apr 10 00:57:05 2001
+++ guile/guile-core/libguile/stime.c Tue May 15 07:57:20 2001
@@ -706,7 +706,7 @@
void
scm_init_stime()
{
- scm_sysintern("internal-time-units-per-second",
+ scm_c_define ("internal-time-units-per-second",
scm_long2num((long)CLKTCK));
#ifdef HAVE_FTIME
Index: guile/guile-core/libguile/struct.c
diff -u guile/guile-core/libguile/struct.c:1.75
guile/guile-core/libguile/struct.c:1.76
--- guile/guile-core/libguile/struct.c:1.75 Fri Apr 20 00:55:19 2001
+++ guile/guile-core/libguile/struct.c Tue May 15 07:57:20 2001
@@ -820,10 +820,11 @@
= scm_permanent_object (scm_make_weak_key_hash_table (SCM_MAKINUM (31)));
required_vtable_fields = scm_makfrom0str ("pruosrpw");
scm_permanent_object (required_vtable_fields);
- scm_sysintern ("vtable-index-layout", SCM_MAKINUM (scm_vtable_index_layout));
- scm_sysintern ("vtable-index-vtable", SCM_MAKINUM (scm_vtable_index_vtable));
- scm_sysintern ("vtable-index-printer", SCM_MAKINUM
(scm_vtable_index_printer));
- scm_sysintern ("vtable-offset-user", SCM_MAKINUM (scm_vtable_offset_user));
+ scm_c_define ("vtable-index-layout", SCM_MAKINUM (scm_vtable_index_layout));
+ scm_c_define ("vtable-index-vtable", SCM_MAKINUM (scm_vtable_index_vtable));
+ scm_c_define ("vtable-index-printer",
+ SCM_MAKINUM (scm_vtable_index_printer));
+ scm_c_define ("vtable-offset-user", SCM_MAKINUM (scm_vtable_offset_user));
#ifndef SCM_MAGIC_SNARFER
#include "libguile/struct.x"
#endif
Index: guile/guile-core/libguile/symbols.c
diff -u guile/guile-core/libguile/symbols.c:1.85
guile/guile-core/libguile/symbols.c:1.86
--- guile/guile-core/libguile/symbols.c:1.85 Fri May 4 14:54:00 2001
+++ guile/guile-core/libguile/symbols.c Tue May 15 07:57:20 2001
@@ -158,264 +158,6 @@
return scm_mem2symbol (str, strlen (str));
}
-
-/* scm_sym2vcell
- * looks up the symbol in the symhash table.
- */
-
-SCM
-scm_sym2vcell (SCM sym, SCM thunk, SCM definep)
-#define FUNC_NAME "scm_sym2vcell"
-{
- if (SCM_NIMP (thunk))
- {
- SCM var;
-
- if (SCM_EVAL_CLOSURE_P (thunk))
- /* Bypass evaluator in the standard case. */
- var = scm_eval_closure_lookup (thunk, sym, definep);
- else
- var = scm_apply (thunk, sym, scm_cons (definep, scm_listofnull));
-
- if (SCM_FALSEP (var))
- return SCM_BOOL_F;
- else if (SCM_VARIABLEP (var))
- return SCM_VARVCELL (var);
- else
- SCM_MISC_ERROR ("strangely interned symbol: ~S", SCM_LIST1 (sym));
- }
- else
- {
- SCM lsym;
- scm_sizet hash;
-
- SCM_DEFER_INTS;
- hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (scm_symhash);
- for (lsym = SCM_VELTS (scm_symhash)[hash]; SCM_NIMP (lsym); lsym =
SCM_CDR (lsym))
- {
- SCM z = SCM_CAR (lsym);
- if (SCM_EQ_P (SCM_CAR (z), sym))
- {
- SCM_ALLOW_INTS;
- return z;
- }
- }
-
- if (!SCM_FALSEP (definep))
- {
- SCM cell = scm_cons (sym, SCM_UNDEFINED);
- SCM slot = SCM_VELTS (scm_symhash) [hash];
-
- SCM_VELTS (scm_symhash) [hash] = scm_cons (cell, slot);
-
- SCM_ALLOW_INTS;
- return cell;
- }
- else
- {
- SCM_ALLOW_INTS;
- return SCM_BOOL_F;
- }
- }
-}
-#undef FUNC_NAME
-
-
-/* scm_sym2ovcell
- * looks up the symbol in an arbitrary obarray.
- */
-
-SCM
-scm_sym2ovcell_soft (SCM sym, SCM obarray)
-{
- SCM lsym, z;
- scm_sizet hash = SCM_SYMBOL_HASH (sym) % SCM_VECTOR_LENGTH (obarray);
- SCM_REDEFER_INTS;
- for (lsym = SCM_VELTS (obarray)[hash];
- SCM_NIMP (lsym);
- lsym = SCM_CDR (lsym))
- {
- z = SCM_CAR (lsym);
- if (SCM_EQ_P (SCM_CAR (z), sym))
- {
- SCM_REALLOW_INTS;
- return z;
- }
- }
- SCM_REALLOW_INTS;
- return SCM_BOOL_F;
-}
-
-
-SCM
-scm_sym2ovcell (SCM sym, SCM obarray)
-#define FUNC_NAME "scm_sym2ovcell"
-{
- SCM answer;
- answer = scm_sym2ovcell_soft (sym, obarray);
- if (!SCM_FALSEP (answer))
- return answer;
- SCM_MISC_ERROR ("uninterned symbol: ~S", SCM_LIST1 (sym));
- return SCM_UNSPECIFIED; /* not reached */
-}
-#undef FUNC_NAME
-
-
-/* Intern a symbol whose name is the LEN characters at NAME in OBARRAY.
-
- OBARRAY should be a vector of lists, indexed by the name's hash
- value, modulo OBARRAY's length. Each list has the form
- ((SYMBOL . VALUE) ...), where SYMBOL is a symbol, and VALUE is the
- value associated with that symbol (in the current module? in the
- system module?)
-
- To "intern" a symbol means: if OBARRAY already contains a symbol by
- that name, return its (SYMBOL . VALUE) pair; otherwise, create a
- new symbol, add the pair (SYMBOL . SCM_UNDEFINED) to the
- appropriate list of the OBARRAY, and return the pair.
-
- If softness is non-zero, don't create a symbol if it isn't already
- in OBARRAY; instead, just return #f.
-
- If OBARRAY is SCM_BOOL_F, create a symbol listed in no obarray and
- return (SYMBOL . SCM_UNDEFINED). */
-
-
-SCM
-scm_intern_obarray_soft (const char *name,scm_sizet len,SCM obarray,unsigned
int softness)
-{
- SCM symbol = scm_mem2symbol (name, len);
- scm_sizet raw_hash = SCM_SYMBOL_HASH (symbol);
- scm_sizet hash;
- SCM lsym;
-
- if (SCM_FALSEP (obarray))
- {
- if (softness)
- return SCM_BOOL_F;
- else
- return scm_cons (symbol, SCM_UNDEFINED);
- }
-
- hash = raw_hash % SCM_VECTOR_LENGTH (obarray);
-
- for (lsym = SCM_VELTS (obarray)[hash]; SCM_NIMP (lsym); lsym = SCM_CDR
(lsym))
- {
- SCM a = SCM_CAR (lsym);
- SCM z = SCM_CAR (a);
- if (SCM_EQ_P (z, symbol))
- return a;
- }
-
- if (softness)
- {
- return SCM_BOOL_F;
- }
- else
- {
- SCM cell = scm_cons (symbol, SCM_UNDEFINED);
- SCM slot = SCM_VELTS (obarray) [hash];
-
- SCM_VELTS (obarray) [hash] = scm_cons (cell, slot);
-
- return cell;
- }
-}
-
-
-SCM
-scm_intern_obarray (const char *name,scm_sizet len,SCM obarray)
-{
- return scm_intern_obarray_soft (name, len, obarray, 0);
-}
-
-
-SCM
-scm_intern (const char *name,scm_sizet len)
-{
- return scm_intern_obarray (name, len, scm_symhash);
-}
-
-
-SCM
-scm_intern0 (const char * name)
-{
- return scm_intern (name, strlen (name));
-}
-
-
-/* Intern the symbol named NAME in scm_symhash, NAME is null-terminated. */
-SCM
-scm_sysintern0_no_module_lookup (const char *name)
-{
- scm_sizet len = strlen (name);
- SCM easy_answer;
- SCM_DEFER_INTS;
- easy_answer = scm_intern_obarray_soft (name, len, scm_symhash, 1);
- if (SCM_NIMP (easy_answer))
- {
- SCM_ALLOW_INTS;
- return easy_answer;
- }
- else
- {
- SCM symbol = scm_mem2symbol (name, len);
- scm_sizet raw_hash = SCM_SYMBOL_HASH (symbol);
- scm_sizet hash = raw_hash % SCM_VECTOR_LENGTH (scm_symhash);
- SCM cell = scm_cons (symbol, SCM_UNDEFINED);
- SCM slot = SCM_VELTS (scm_symhash) [hash];
-
- SCM_VELTS (scm_symhash) [hash] = scm_cons (cell, slot);
- SCM_ALLOW_INTS;
- return cell;
- }
-}
-
-/* Intern the symbol named NAME in scm_symhash, and give it the value
- VAL. NAME is null-terminated. Use the current top_level lookup
- closure to give NAME its value.
- */
-SCM
-scm_sysintern (const char *name, SCM val)
-{
- SCM vcell = scm_sysintern0 (name);
- SCM_SETCDR (vcell, val);
- return vcell;
-}
-
-SCM
-scm_sysintern0 (const char *name)
-{
- SCM lookup_proc;
- if (scm_module_system_booted_p
- && SCM_NIMP (lookup_proc = SCM_TOP_LEVEL_LOOKUP_CLOSURE))
- {
- SCM sym = scm_str2symbol (name);
- SCM vcell = scm_sym2vcell (sym, lookup_proc, SCM_BOOL_T);
- if (SCM_FALSEP (vcell))
- scm_misc_error ("sysintern0", "can't define variable", sym);
- return vcell;
- }
- else
- return scm_sysintern0_no_module_lookup (name);
-}
-
-/* Lookup the value of the symbol named by the nul-terminated string
- NAME in the current module. */
-SCM
-scm_symbol_value0 (const char *name)
-{
- /* This looks silly - we look up the symbol twice. But it is in
- fact necessary given the current module system because the module
- lookup closures are written in scheme which needs real symbols. */
- SCM symbol = scm_str2symbol (name);
- SCM vcell = scm_sym2vcell (symbol, SCM_TOP_LEVEL_LOOKUP_CLOSURE, SCM_BOOL_F);
- if (SCM_FALSEP (vcell))
- return SCM_UNDEFINED;
- return SCM_CDR (vcell);
-}
-
-
SCM_DEFINE (scm_symbol_p, "symbol?", 1, 0, 0,
(SCM obj),
"Return @code{#t} if @var{obj} is a symbol, otherwise return\n"
@@ -489,202 +231,55 @@
}
#undef FUNC_NAME
+#define MAX_PREFIX_LENGTH 30
-SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0,
- (SCM o, SCM s, SCM softp),
- "Intern a new symbol in @var{obarray}, a symbol table, with name\n"
- "@var{string}.\n\n"
- "If @var{obarray} is @code{#f}, use the default system symbol
table. If\n"
- "@var{obarray} is @code{#t}, the symbol should not be interned in
any\n"
- "symbol table; merely return the pair (@var{symbol}\n"
- ". @var{#<undefined>}).\n\n"
- "The @var{soft?} argument determines whether new symbol table
entries\n"
- "should be created when the specified symbol is not already present
in\n"
- "@var{obarray}. If @var{soft?} is specified and is a true value,
then\n"
- "new entries should not be added for symbols not already present in
the\n"
- "table; instead, simply return @code{#f}.")
-#define FUNC_NAME s_scm_string_to_obarray_symbol
-{
- SCM vcell;
- SCM answer;
- int softness;
-
- SCM_VALIDATE_STRING (2, s);
- SCM_ASSERT (SCM_BOOLP (o) || SCM_VECTORP (o), o, SCM_ARG1, FUNC_NAME);
-
- softness = (!SCM_UNBNDP (softp) && !SCM_FALSEP(softp));
- /* iron out some screwy calling conventions */
- if (SCM_FALSEP (o))
- o = scm_symhash;
- else if (SCM_EQ_P (o, SCM_BOOL_T))
- o = SCM_BOOL_F;
-
- vcell = scm_intern_obarray_soft (SCM_STRING_CHARS(s),
- SCM_STRING_LENGTH (s),
- o,
- softness);
- if (SCM_FALSEP (vcell))
- return vcell;
- answer = SCM_CAR (vcell);
- return answer;
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_intern_symbol, "intern-symbol", 2, 0, 0,
- (SCM o, SCM s),
- "Add a new symbol to @var{obarray} with name @var{string}, bound to
an\n"
- "unspecified initial value. The symbol table is not modified if a
symbol\n"
- "with this name is already present.")
-#define FUNC_NAME s_scm_intern_symbol
-{
- scm_sizet hval;
- SCM_VALIDATE_SYMBOL (2,s);
- if (SCM_FALSEP (o))
- o = scm_symhash;
- SCM_VALIDATE_VECTOR (1,o);
- hval = SCM_SYMBOL_HASH (s) % SCM_VECTOR_LENGTH (o);
- /* If the symbol is already interned, simply return. */
- SCM_REDEFER_INTS;
- {
- SCM lsym;
- SCM sym;
- for (lsym = SCM_VELTS (o)[hval];
- SCM_NIMP (lsym);
- lsym = SCM_CDR (lsym))
- {
- sym = SCM_CAR (lsym);
- if (SCM_EQ_P (SCM_CAR (sym), s))
- {
- SCM_REALLOW_INTS;
- return SCM_UNSPECIFIED;
- }
- }
- SCM_VELTS (o)[hval] =
- scm_acons (s, SCM_UNDEFINED, SCM_VELTS (o)[hval]);
- }
- SCM_REALLOW_INTS;
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
+static int gensym_counter;
-SCM_DEFINE (scm_unintern_symbol, "unintern-symbol", 2, 0, 0,
- (SCM o, SCM s),
- "Remove the symbol with name @var{string} from @var{obarray}.
This\n"
- "function returns @code{#t} if the symbol was present and
@code{#f}\n"
- "otherwise.")
-#define FUNC_NAME s_scm_unintern_symbol
-{
- scm_sizet hval;
- SCM_VALIDATE_SYMBOL (2,s);
- if (SCM_FALSEP (o))
- o = scm_symhash;
- SCM_VALIDATE_VECTOR (1,o);
- hval = SCM_SYMBOL_HASH (s) % SCM_VECTOR_LENGTH (o);
- SCM_DEFER_INTS;
+SCM_DEFINE (scm_gensym, "gensym", 0, 1, 0,
+ (SCM prefix),
+ "Create a new symbol with a name constructed from a prefix and\n"
+ "a counter value. The string @var{prefix} can be specified as\n"
+ "an optional argument. Default prefix is @code{g}. The counter\n"
+ "is increased by 1 at each call. There is no provision for\n"
+ "resetting the counter.")
+#define FUNC_NAME s_scm_gensym
+{
+ char buf[MAX_PREFIX_LENGTH + SCM_INTBUFLEN];
+ char *name = buf;
+ int len;
+ if (SCM_UNBNDP (prefix))
+ {
+ name[0] = 'g';
+ len = 1;
+ }
+ else
+ {
+ SCM_VALIDATE_STRING (1, prefix);
+ len = SCM_STRING_LENGTH (prefix);
+ if (len > MAX_PREFIX_LENGTH)
+ name = SCM_MUST_MALLOC (MAX_PREFIX_LENGTH + SCM_INTBUFLEN);
+ strncpy (name, SCM_STRING_CHARS (prefix), len);
+ }
{
- SCM lsym_follow;
- SCM lsym;
- SCM sym;
- for (lsym = SCM_VELTS (o)[hval], lsym_follow = SCM_BOOL_F;
- SCM_NIMP (lsym);
- lsym_follow = lsym, lsym = SCM_CDR (lsym))
- {
- sym = SCM_CAR (lsym);
- if (SCM_EQ_P (SCM_CAR (sym), s))
- {
- /* Found the symbol to unintern. */
- if (SCM_FALSEP (lsym_follow))
- SCM_VELTS(o)[hval] = lsym;
- else
- SCM_SETCDR (lsym_follow, SCM_CDR(lsym));
- SCM_ALLOW_INTS;
- return SCM_BOOL_T;
- }
- }
+ int n_digits = scm_iint2str (gensym_counter++, 10, &name[len]);
+ SCM res = scm_mem2symbol (name, len + n_digits);
+ if (name != buf)
+ scm_must_free (name);
+ return res;
}
- SCM_ALLOW_INTS;
- return SCM_BOOL_F;
}
#undef FUNC_NAME
-SCM_DEFINE (scm_symbol_binding, "symbol-binding", 2, 0, 0,
- (SCM o, SCM s),
- "Look up in @var{obarray} the symbol whose name is @var{string},
and\n"
- "return the value to which it is bound. If @var{obarray} is
@code{#f},\n"
- "use the global symbol table. If @var{string} is not interned in\n"
- "@var{obarray}, an error is signalled.")
-#define FUNC_NAME s_scm_symbol_binding
-{
- SCM vcell;
- SCM_VALIDATE_SYMBOL (2,s);
- if (SCM_FALSEP (o))
- o = scm_symhash;
- SCM_VALIDATE_VECTOR (1,o);
- vcell = scm_sym2ovcell (s, o);
- return SCM_CDR(vcell);
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_symbol_interned_p, "symbol-interned?", 2, 0, 0,
- (SCM o, SCM s),
- "Return @code{#t} if @var{obarray} contains a symbol with name\n"
- "@var{string}, and @code{#f} otherwise.")
-#define FUNC_NAME s_scm_symbol_interned_p
-{
- SCM vcell;
- SCM_VALIDATE_SYMBOL (2,s);
- if (SCM_FALSEP (o))
- o = scm_symhash;
- SCM_VALIDATE_VECTOR (1,o);
- vcell = scm_sym2ovcell_soft (s, o);
- return (SCM_NIMP(vcell)
- ? SCM_BOOL_T
- : SCM_BOOL_F);
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_symbol_bound_p, "symbol-bound?", 2, 0, 0,
- (SCM o, SCM s),
- "Return @code{#t} if @var{obarray} contains a symbol with name\n"
- "@var{string} bound to a defined value. This differs from\n"
- "@var{symbol-interned?} in that the mere mention of a symbol\n"
- "usually causes it to be interned; @code{symbol-bound?}\n"
- "determines whether a symbol has been given any meaningful\n"
- "value.")
-#define FUNC_NAME s_scm_symbol_bound_p
-{
- SCM vcell;
- SCM_VALIDATE_SYMBOL (2,s);
- if (SCM_FALSEP (o))
- o = scm_symhash;
- SCM_VALIDATE_VECTOR (1,o);
- vcell = scm_sym2ovcell_soft (s, o);
- return SCM_BOOL (SCM_NIMP (vcell) && !SCM_UNBNDP (SCM_CDR (vcell)));
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_symbol_set_x, "symbol-set!", 3, 0, 0,
- (SCM o, SCM s, SCM v),
- "Find the symbol in @var{obarray} whose name is @var{string}, and
rebind\n"
- "it to @var{value}. An error is signalled if @var{string} is not
present\n"
- "in @var{obarray}.")
-#define FUNC_NAME s_scm_symbol_set_x
-{
- SCM vcell;
- SCM_VALIDATE_SYMBOL (2,s);
- if (SCM_FALSEP (o))
- o = scm_symhash;
- SCM_VALIDATE_VECTOR (1,o);
- vcell = scm_sym2ovcell (s, o);
- SCM_SETCDR (vcell, v);
- return SCM_UNSPECIFIED;
+SCM_DEFINE (scm_symbol_hash, "symbol-hash", 1, 0, 0,
+ (SCM symbol),
+ "Return a hash value for @var{symbol}.")
+#define FUNC_NAME s_scm_symbol_hash
+{
+ SCM_VALIDATE_SYMBOL (1, symbol);
+ return SCM_MAKINUM (SCM_SYMBOL_HASH (symbol));
}
#undef FUNC_NAME
-
SCM_DEFINE (scm_symbol_fref, "symbol-fref", 1, 0, 0,
(SCM s),
"Return the contents of @var{symbol}'s @dfn{function slot}.")
@@ -732,152 +327,6 @@
}
#undef FUNC_NAME
-
-SCM_DEFINE (scm_symbol_hash, "symbol-hash", 1, 0, 0,
- (SCM symbol),
- "Return a hash value for @var{symbol}.")
-#define FUNC_NAME s_scm_symbol_hash
-{
- SCM_VALIDATE_SYMBOL (1, symbol);
- return SCM_MAKINUM (SCM_SYMBOL_HASH (symbol));
-}
-#undef FUNC_NAME
-
-
-static void
-copy_and_prune_obarray (SCM from, SCM to)
-{
- int i;
- int length = SCM_VECTOR_LENGTH (from);
- for (i = 0; i < length; ++i)
- {
- SCM head = SCM_VELTS (from)[i]; /* GC protection */
- SCM ls = head;
- SCM res = SCM_EOL;
- SCM *lloc = &res;
- while (SCM_NIMP (ls))
- {
- if (!SCM_UNBNDP (SCM_CDAR (ls)))
- {
- *lloc = scm_cons (SCM_CAR (ls), SCM_EOL);
- lloc = SCM_CDRLOC (*lloc);
- }
- ls = SCM_CDR (ls);
- }
- SCM_VELTS (to)[i] = res;
- }
-}
-
-
-SCM_DEFINE (scm_builtin_bindings, "builtin-bindings", 0, 0, 0,
- (),
- "Create and return a copy of the global symbol table, removing
all\n"
- "unbound symbols.")
-#define FUNC_NAME s_scm_builtin_bindings
-{
- int length = SCM_VECTOR_LENGTH (scm_symhash);
- SCM obarray = scm_c_make_hash_table (length);
- copy_and_prune_obarray (scm_symhash, obarray);
- return obarray;
-}
-#undef FUNC_NAME
-
-
-#define MAX_PREFIX_LENGTH 30
-
-static int gensym_counter;
-
-SCM_DEFINE (scm_gensym, "gensym", 0, 1, 0,
- (SCM prefix),
- "Create a new symbol with a name constructed from a prefix and\n"
- "a counter value. The string @var{prefix} can be specified as\n"
- "an optional argument. Default prefix is @code{g}. The counter\n"
- "is increased by 1 at each call. There is no provision for\n"
- "resetting the counter.")
-#define FUNC_NAME s_scm_gensym
-{
- char buf[MAX_PREFIX_LENGTH + SCM_INTBUFLEN];
- char *name = buf;
- int len;
- if (SCM_UNBNDP (prefix))
- {
- name[0] = 'g';
- len = 1;
- }
- else
- {
- SCM_VALIDATE_STRING (1, prefix);
- len = SCM_STRING_LENGTH (prefix);
- if (len > MAX_PREFIX_LENGTH)
- name = SCM_MUST_MALLOC (MAX_PREFIX_LENGTH + SCM_INTBUFLEN);
- strncpy (name, SCM_STRING_CHARS (prefix), len);
- }
- {
- int n_digits = scm_iint2str (gensym_counter++, 10, &name[len]);
- SCM res = scm_mem2symbol (name, len + n_digits);
- if (name != buf)
- scm_must_free (name);
- return res;
- }
-}
-#undef FUNC_NAME
-
-static int gentemp_counter;
-
-SCM_DEFINE (scm_gentemp, "gentemp", 0, 2, 0,
- (SCM prefix, SCM obarray),
- "Create a new symbol with a name unique in an obarray.\n"
- "The name is constructed from an optional string @var{prefix}\n"
- "and a counter value. The default prefix is @code{t}. The\n"
- "@var{obarray} is specified as a second optional argument.\n"
- "Default is the system obarray where all normal symbols are\n"
- "interned. The counter is increased by 1 at each\n"
- "call. There is no provision for resetting the counter.")
-#define FUNC_NAME s_scm_gentemp
-{
- char buf[MAX_PREFIX_LENGTH + SCM_INTBUFLEN];
- char *name = buf;
- int len, n_digits;
- if (SCM_UNBNDP (prefix))
- {
- name[0] = 't';
- len = 1;
- }
- else
- {
- SCM_VALIDATE_STRING (1, prefix);
- len = SCM_STRING_LENGTH (prefix);
- if (len > MAX_PREFIX_LENGTH)
- name = SCM_MUST_MALLOC (MAX_PREFIX_LENGTH + SCM_INTBUFLEN);
- strncpy (name, SCM_STRING_CHARS (prefix), len);
- }
-
- if (SCM_UNBNDP (obarray))
- obarray = scm_symhash;
- else
- SCM_ASSERT ((SCM_VECTORP (obarray) || SCM_WVECTP (obarray)),
- obarray,
- SCM_ARG2,
- FUNC_NAME);
- do
- n_digits = scm_iint2str (gentemp_counter++, 10, &name[len]);
- while (!SCM_FALSEP (scm_intern_obarray_soft (name,
- len + n_digits,
- obarray,
- 1)));
- {
- SCM vcell = scm_intern_obarray_soft (name,
- len + n_digits,
- obarray,
- 0);
- if (name != buf)
- scm_must_free (name);
- return SCM_CAR (vcell);
- }
-}
-#undef FUNC_NAME
-
-
void
scm_symbols_prehistory ()
{
@@ -890,9 +339,11 @@
scm_init_symbols ()
{
gensym_counter = 0;
- gentemp_counter = 0;
#ifndef SCM_MAGIC_SNARFER
#include "libguile/symbols.x"
+#endif
+#if SCM_ENABLE_VCELLS
+ scm_init_symbols_deprecated ();
#endif
}
Index: guile/guile-core/libguile/symbols.h
diff -u guile/guile-core/libguile/symbols.h:1.51
guile/guile-core/libguile/symbols.h:1.52
--- guile/guile-core/libguile/symbols.h:1.51 Wed Mar 7 18:46:38 2001
+++ guile/guile-core/libguile/symbols.h Tue May 15 07:57:20 2001
@@ -77,35 +77,18 @@
extern SCM scm_mem2symbol (const char*, scm_sizet);
extern SCM scm_str2symbol (const char*);
-extern SCM scm_sym2vcell (SCM sym, SCM thunk, SCM definep);
-extern SCM scm_sym2ovcell_soft (SCM sym, SCM obarray);
-extern SCM scm_sym2ovcell (SCM sym, SCM obarray);
-extern SCM scm_intern_obarray_soft (const char *name, scm_sizet len, SCM
obarray, unsigned int softness);
-extern SCM scm_intern_obarray (const char *name, scm_sizet len, SCM obarray);
-extern SCM scm_intern (const char *name, scm_sizet len);
-extern SCM scm_intern0 (const char *name);
-extern SCM scm_sysintern (const char *name, SCM val);
-extern SCM scm_sysintern0 (const char *name);
-extern SCM scm_sysintern0_no_module_lookup (const char *name);
-extern SCM scm_symbol_value0 (const char *name);
extern SCM scm_symbol_p (SCM x);
extern SCM scm_symbol_to_string (SCM s);
extern SCM scm_string_to_symbol (SCM s);
-extern SCM scm_string_to_obarray_symbol (SCM o, SCM s, SCM softp);
-extern SCM scm_intern_symbol (SCM o, SCM s);
-extern SCM scm_unintern_symbol (SCM o, SCM s);
-extern SCM scm_symbol_binding (SCM o, SCM s);
-extern SCM scm_symbol_interned_p (SCM o, SCM s);
-extern SCM scm_symbol_bound_p (SCM o, SCM s);
-extern SCM scm_symbol_set_x (SCM o, SCM s, SCM v);
+
extern SCM scm_symbol_fref (SCM s);
extern SCM scm_symbol_pref (SCM s);
extern SCM scm_symbol_fset_x (SCM s, SCM val);
extern SCM scm_symbol_pset_x (SCM s, SCM val);
+
extern SCM scm_symbol_hash (SCM s);
-extern SCM scm_builtin_bindings (void);
extern SCM scm_gensym (SCM prefix);
-extern SCM scm_gentemp (SCM prefix, SCM obarray);
+
extern void scm_symbols_prehistory (void);
extern void scm_init_symbols (void);
@@ -140,6 +123,34 @@
#define scm_strhash(str, len, n) (scm_string_hash ((str), (len)) % (n))
#endif /* SCM_DEBUG_DEPRECATED == 0 */
+
+#if SCM_ENABLE_VCELLS
+
+extern SCM scm_sym2vcell (SCM sym, SCM thunk, SCM definep);
+extern SCM scm_sym2ovcell_soft (SCM sym, SCM obarray);
+extern SCM scm_sym2ovcell (SCM sym, SCM obarray);
+extern SCM scm_intern_obarray_soft (const char *name, scm_sizet len, SCM
obarray, unsigned int softness);
+extern SCM scm_intern_obarray (const char *name, scm_sizet len, SCM obarray);
+extern SCM scm_intern (const char *name, scm_sizet len);
+extern SCM scm_intern0 (const char *name);
+extern SCM scm_sysintern (const char *name, SCM val);
+extern SCM scm_sysintern0 (const char *name);
+extern SCM scm_sysintern0_no_module_lookup (const char *name);
+extern SCM scm_symbol_value0 (const char *name);
+
+extern SCM scm_string_to_obarray_symbol (SCM o, SCM s, SCM softp);
+extern SCM scm_intern_symbol (SCM o, SCM s);
+extern SCM scm_unintern_symbol (SCM o, SCM s);
+extern SCM scm_symbol_binding (SCM o, SCM s);
+extern SCM scm_symbol_interned_p (SCM o, SCM s);
+extern SCM scm_symbol_bound_p (SCM o, SCM s);
+extern SCM scm_symbol_set_x (SCM o, SCM s, SCM v);
+
+extern SCM scm_gentemp (SCM prefix, SCM obarray);
+
+extern void scm_init_symbols_deprecated (void);
+
+#endif /* SCM_ENABLE_VCELLS */
#endif /* SYMBOLSH */
Index: guile/guile-core/libguile/tag.c
diff -u guile/guile-core/libguile/tag.c:1.24
guile/guile-core/libguile/tag.c:1.25
--- guile/guile-core/libguile/tag.c:1.24 Sat Apr 28 10:29:31 2001
+++ guile/guile-core/libguile/tag.c Tue May 15 07:57:20 2001
@@ -51,7 +51,7 @@
#define CONST_INUM(c_name, scheme_name, value) \
-SCM_VCELL_INIT(c_name, scheme_name, SCM_MAKINUM (value))
+SCM_VARIABLE_INIT(c_name, scheme_name, SCM_MAKINUM (value))
CONST_INUM (scm_utag_immediate_integer, "utag_immediate_integer", 0);
CONST_INUM (scm_utag_immediate_char, "utag_immediate_char", 1);
Index: guile/guile-core/libguile/throw.c
diff -u guile/guile-core/libguile/throw.c:1.80
guile/guile-core/libguile/throw.c:1.81
--- guile/guile-core/libguile/throw.c:1.80 Fri May 4 14:54:00 2001
+++ guile/guile-core/libguile/throw.c Tue May 15 07:57:20 2001
@@ -292,13 +292,13 @@
/* scm_internal_stack_catch
Use this one if you want debugging information to be stored in
- scm_the_last_stack_fluid on error. */
+ scm_the_last_stack_fluid_var on error. */
static SCM
ss_handler (void *data, SCM tag, SCM throw_args)
{
/* Save the stack */
- scm_fluid_set_x (SCM_CDR (scm_the_last_stack_fluid),
+ scm_fluid_set_x (SCM_VARIABLE_REF (scm_the_last_stack_fluid_var),
scm_make_stack (SCM_BOOL_T, SCM_EOL));
/* Throw the error */
return scm_throw (tag, throw_args);
Index: guile/guile-core/libguile/variable.c
diff -u guile/guile-core/libguile/variable.c:1.34
guile/guile-core/libguile/variable.c:1.35
--- guile/guile-core/libguile/variable.c:1.34 Fri Mar 30 07:03:23 2001
+++ guile/guile-core/libguile/variable.c Tue May 15 07:57:20 2001
@@ -49,6 +49,7 @@
#include "libguile/ports.h"
#include "libguile/root.h"
#include "libguile/smob.h"
+#include "libguile/deprecation.h"
#include "libguile/validate.h"
#include "libguile/variable.h"
@@ -60,16 +61,8 @@
{
scm_puts ("#<variable ", port);
scm_intprint (SCM_UNPACK (exp), 16, port);
- {
- SCM vcell = SCM_VARVCELL (exp);
- if (!SCM_UNBNDP (SCM_CAR (vcell)))
- {
- scm_puts (" name: ", port);
- scm_iprin1 (SCM_CAR (vcell), port, pstate);
- }
- scm_puts (" binding: ", port);
- scm_iprin1 (SCM_CDR (vcell), port, pstate);
- }
+ scm_puts (" binding: ", port);
+ scm_iprin1 (SCM_VARIABLE_REF (exp), port, pstate);
scm_putc('>', port);
return 1;
}
@@ -77,55 +70,40 @@
static SCM
variable_equalp (SCM var1, SCM var2)
{
- return scm_equal_p (SCM_VARVCELL (var1), SCM_VARVCELL (var2));
+ return scm_equal_p (SCM_VARIABLE_REF (var1), SCM_VARIABLE_REF (var2));
}
-SCM_SYMBOL (anonymous_variable_sym, "anonymous-variable");
-
+#if SCM_ENABLE_VCELLS
+SCM_SYMBOL (sym_huh, "???");
+#endif
static SCM
-make_vcell_variable (SCM vcell)
+make_variable (SCM init)
{
- SCM_RETURN_NEWSMOB (scm_tc16_variable, SCM_UNPACK (vcell));
+#if !SCM_ENABLE_VCELLS
+ SCM_RETURN_NEWSMOB (scm_tc16_variable, SCM_UNPACK (init));
+#else
+ SCM_RETURN_NEWSMOB (scm_tc16_variable, scm_cons (sym_huh, init));
+#endif
}
-SCM_DEFINE (scm_make_variable, "make-variable", 1, 1, 0,
- (SCM init, SCM name_hint),
- "Return a variable object initialized to value @var{init}.\n"
- "If given, uses @var{name-hint} as its internal (debugging)\n"
- "name, otherwise just treat it as an anonymous variable.\n"
- "Remember, of course, that multiple bindings to the same\n"
- "variable may exist, so @var{name-hint} is just that---a hint.\n")
+SCM_DEFINE (scm_make_variable, "make-variable", 1, 0, 0,
+ (SCM init),
+ "Return a variable initialized to value @var{init}.\n")
#define FUNC_NAME s_scm_make_variable
{
- SCM vcell;
-
- if (SCM_UNBNDP (name_hint))
- name_hint = anonymous_variable_sym;
-
- vcell = scm_cons (name_hint, init);
- return make_vcell_variable (vcell);
+ return make_variable (init);
}
#undef FUNC_NAME
-SCM_DEFINE (scm_make_undefined_variable, "make-undefined-variable", 0, 1, 0,
- (SCM name_hint),
- "Return a variable object initialized to an undefined value.\n"
- "If given, uses @var{name-hint} as its internal (debugging)\n"
- "name, otherwise just treat it as an anonymous variable.\n"
- "Remember, of course, that multiple bindings to the same\n"
- "variable may exist, so @var{name-hint} is just that---a hint.\n")
+SCM_DEFINE (scm_make_undefined_variable, "make-undefined-variable", 0, 0, 0,
+ (),
+ "Return a variable that is initially unbound.\n")
#define FUNC_NAME s_scm_make_undefined_variable
{
- SCM vcell;
-
- if (SCM_UNBNDP (name_hint))
- name_hint = anonymous_variable_sym;
-
- vcell = scm_cons (name_hint, SCM_UNDEFINED);
- return make_vcell_variable (vcell);
+ return make_variable (SCM_UNDEFINED);
}
#undef FUNC_NAME
@@ -148,13 +126,15 @@
"and @code{make-undefined-variable}.")
#define FUNC_NAME s_scm_variable_ref
{
+ SCM val;
SCM_VALIDATE_VARIABLE (1, var);
- return SCM_CDR (SCM_VARVCELL (var));
+ val = SCM_VARIABLE_REF (var);
+ if (val == SCM_UNDEFINED)
+ SCM_MISC_ERROR ("variable is unbound: ~S", SCM_LIST1 (var));
+ return val;
}
#undef FUNC_NAME
-
-
SCM_DEFINE (scm_variable_set_x, "variable-set!", 2, 0, 0,
(SCM var, SCM val),
"Set the value of the variable @var{var} to @var{val}.\n"
@@ -163,41 +143,11 @@
#define FUNC_NAME s_scm_variable_set_x
{
SCM_VALIDATE_VARIABLE (1, var);
- SCM_SETCDR (SCM_VARVCELL (var), val);
+ SCM_VARIABLE_SET (var, val);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
-
-SCM_DEFINE (scm_builtin_variable, "builtin-variable", 1, 0, 0,
- (SCM name),
- "Return the built-in variable with the name @var{name}.\n"
- "@var{name} must be a symbol (not a string).\n"
- "Then use @code{variable-ref} to access its value.\n")
-#define FUNC_NAME s_scm_builtin_variable
-{
- SCM vcell;
- SCM var_slot;
-
- SCM_VALIDATE_SYMBOL (1,name);
- vcell = scm_sym2vcell (name, SCM_BOOL_F, SCM_BOOL_T);
- if (SCM_FALSEP (vcell))
- return SCM_BOOL_F;
-
- scm_intern_symbol (scm_symhash_vars, name);
- var_slot = scm_sym2ovcell (name, scm_symhash_vars);
-
- SCM_DEFER_INTS;
- if (SCM_IMP (SCM_CDR (var_slot))
- || !SCM_EQ_P (SCM_VARVCELL (var_slot), vcell))
- SCM_SETCDR (var_slot, make_vcell_variable (vcell));
- SCM_ALLOW_INTS;
-
- return SCM_CDR (var_slot);
-}
-#undef FUNC_NAME
-
-
SCM_DEFINE (scm_variable_bound_p, "variable-bound?", 1, 0, 0,
(SCM var),
"Return @code{#t} iff @var{var} is bound to a value.\n"
@@ -205,12 +155,41 @@
#define FUNC_NAME s_scm_variable_bound_p
{
SCM_VALIDATE_VARIABLE (1, var);
- return SCM_BOOL (!SCM_UNBNDP (SCM_CDR (SCM_VARVCELL (var))));
+ return SCM_BOOL (SCM_VARIABLE_REF (var) != SCM_UNDEFINED);
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_variable_set_name_hint, "variable-set-name-hint!", 2, 0, 0,
+ (SCM var, SCM hint),
+ "Do not use this function.")
+#define FUNC_NAME s_scm_variable_set_name_hint
+{
+ SCM_VALIDATE_VARIABLE (1, var);
+ SCM_VALIDATE_SYMBOL (2, hint);
+#if SCM_ENABLE_VCELLS
+ SCM_SETCAR (SCM_SMOB_DATA (var), hint);
+#endif
+ return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
+#if SCM_ENABLE_VCELLS
+SCM_DEFINE (scm_builtin_variable, "builtin-variable", 1, 0, 0,
+ (SCM name),
+ "Return the built-in variable with the name @var{name}.\n"
+ "@var{name} must be a symbol (not a string).\n"
+ "Then use @code{variable-ref} to access its value.\n")
+#define FUNC_NAME s_scm_builtin_variable
+{
+ SCM_VALIDATE_SYMBOL (1,name);
+ scm_c_issue_deprecation_warning ("`builtin-variable' is deprecated. "
+ "Use module system operations instead.");
+ return scm_sym2var (name, SCM_BOOL_F, SCM_BOOL_T);
+}
+#undef FUNC_NAME
+#endif /* SCM_ENABLE_VCELLS */
void
scm_init_variable ()
@@ -224,7 +203,6 @@
#include "libguile/variable.x"
#endif
}
-
/*
Local Variables:
Index: guile/guile-core/libguile/variable.h
diff -u guile/guile-core/libguile/variable.h:1.17
guile/guile-core/libguile/variable.h:1.18
--- guile/guile-core/libguile/variable.h:1.17 Fri Mar 30 07:03:23 2001
+++ guile/guile-core/libguile/variable.h Tue May 15 07:57:20 2001
@@ -47,6 +47,7 @@
address@hidden, http://www.cs.washington.edu/homes/gjb */
#include "libguile/__scm.h"
+#include "libguile/smob.h"
@@ -55,20 +56,35 @@
*/
extern scm_bits_t scm_tc16_variable;
-#define SCM_VARVCELL(V) SCM_CELL_OBJECT_1 (V)
-#define SCM_VARIABLEP(X) (!SCM_IMP (X) && SCM_CELL_TYPE (X) ==
scm_tc16_variable)
-#define SCM_UDVARIABLEP(X) (SCM_VARIABLEP(X) && SCM_UNBNDP (SCM_CDR
(SCM_VARVCELL (X))))
-#define SCM_DEFVARIABLEP(X) (SCM_VARIABLEP(X) && !SCM_UNBNDP (SCM_CDR
(SCM_VARVCELL (X))))
+#define SCM_VARIABLEP(X) SCM_SMOB_PREDICATE (scm_tc16_variable, X)
+
+#if !SCM_ENABLE_VCELLS
+#define SCM_VARIABLE_REF(V) SCM_CELL_OBJECT_1(V)
+#define SCM_VARIABLE_SET(V,X) SCM_SET_CELL_OBJECT_1 (V, X)
+#define SCM_VARIABLE_LOC(V) ((SCM *) SCM_CELL_WORD_LOC ((V), 1))
+#else
+#define SCM_VARVCELL(V) SCM_CELL_OBJECT_1(V)
+#define SCM_UDVARIABLEP(X) (SCM_VARIABLEP(X) && SCM_UNBNDP (SCM_CDR
(SCM_VARVCELL (X))))
+#define SCM_DEFVARIABLEP(X) (SCM_VARIABLEP(X) && !SCM_UNBNDP (SCM_CDR
(SCM_VARVCELL (X))))
+
+#define SCM_VARIABLE_REF(V) SCM_CDR(SCM_VARVCELL(V))
+#define SCM_VARIABLE_SET(V,X) SCM_SETCDR(SCM_VARVCELL(V),X)
+#define SCM_VARIABLE_LOC(V) SCM_CDRLOC(SCM_VARVCELL(V))
+#endif
-extern SCM scm_make_variable (SCM init, SCM name_hint);
-extern SCM scm_make_undefined_variable (SCM name_hint);
+extern SCM scm_make_variable (SCM init);
+extern SCM scm_make_undefined_variable (void);
extern SCM scm_variable_p (SCM obj);
extern SCM scm_variable_ref (SCM var);
extern SCM scm_variable_set_x (SCM var, SCM val);
-extern SCM scm_builtin_variable (SCM name);
extern SCM scm_variable_bound_p (SCM var);
+extern SCM scm_variable_set_name_hint (SCM var, SCM hint);
+#if SCM_ENABLE_VCELLS
+extern SCM scm_builtin_variable (SCM name);
+#endif
+
extern void scm_init_variable (void);
#endif /* SCM_VARIABLE_H */