Merge from mvo-vcell-cleanup-1-branch.

libguile/Makefile.am

@@ -49,7 +49,7 @@ libguile_la_SOURCES = alist.c arbiters.c async.c backtrace.c boolean.c	     \
     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,7 +62,7 @@ DOT_X_FILES = alist.x arbiters.x async.x backtrace.x boolean.x chars.x	  \
     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@
 
@@ -78,7 +78,8 @@ DOT_DOC_FILES = alist.doc arbiters.doc async.doc backtrace.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
+    values.doc variable.doc vectors.doc version.doc vports.doc weaks.doc    \
+    symbols-deprecated.doc
 
 EXTRA_DOT_DOC_FILES = @EXTRA_DOT_DOC_FILES@
 

libguile/__scm.h

@@ -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

libguile/_scm.h

@@ -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

libguile/backtrace.c

@@ -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 @@ SCM_DEFINE (scm_display_backtrace, "display-backtrace", 2, 2, 0,
 }
 #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 @@ SCM_DEFINE (scm_backtrace, "backtrace", 0, 0, 0,
 	    "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_DEFINE (scm_backtrace, "backtrace", 0, 0, 0,
 			     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 @@ void
 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"

libguile/backtrace.h

@@ -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);

libguile/cpp_cnvt.awk

@@ -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"
 }

libguile/debug.c

@@ -260,17 +260,12 @@ SCM_DEFINE (scm_make_gloc, "make-gloc", 1, 1, 0,
 	    "@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);
   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 @@ SCM_DEFINE (scm_gloc_p, "gloc?", 1, 0, 0,
 	    "Return @code{#t} if @var{obj} is a gloc.")
 #define FUNC_NAME s_scm_gloc_p
 {
-  return SCM_BOOL((SCM_MEMOIZEDP (obj)
+  return
-                   && (SCM_UNPACK(SCM_MEMOIZED_EXP (obj)) & 7) == 1));
+    SCM_BOOL (SCM_MEMOIZEDP (obj) 
+	      && ((SCM_UNPACK(SCM_MEMOIZED_EXP(obj))&7) == scm_tc3_cons_gloc));
 }
 #undef FUNC_NAME
 
@@ -623,23 +619,23 @@ scm_init_debug ()
   scm_set_smob_print (scm_tc16_debugobj, debugobj_print);
 
 #ifdef GUILE_DEBUG
-  scm_sysintern ("SCM_IM_AND", SCM_IM_AND);
+  scm_define ("SCM_IM_AND", SCM_IM_AND);
-  scm_sysintern ("SCM_IM_BEGIN", SCM_IM_BEGIN);
+  scm_define ("SCM_IM_BEGIN", SCM_IM_BEGIN);
-  scm_sysintern ("SCM_IM_CASE", SCM_IM_CASE);
+  scm_define ("SCM_IM_CASE", SCM_IM_CASE);
-  scm_sysintern ("SCM_IM_COND", SCM_IM_COND);
+  scm_define ("SCM_IM_COND", SCM_IM_COND);
-  scm_sysintern ("SCM_IM_DO", SCM_IM_DO);
+  scm_define ("SCM_IM_DO", SCM_IM_DO);
-  scm_sysintern ("SCM_IM_IF", SCM_IM_IF);
+  scm_define ("SCM_IM_IF", SCM_IM_IF);
-  scm_sysintern ("SCM_IM_LAMBDA", SCM_IM_LAMBDA);
+  scm_define ("SCM_IM_LAMBDA", SCM_IM_LAMBDA);
-  scm_sysintern ("SCM_IM_LET", SCM_IM_LET);
+  scm_define ("SCM_IM_LET", SCM_IM_LET);
-  scm_sysintern ("SCM_IM_LETSTAR", SCM_IM_LETSTAR);
+  scm_define ("SCM_IM_LETSTAR", SCM_IM_LETSTAR);
-  scm_sysintern ("SCM_IM_LETREC", SCM_IM_LETREC);
+  scm_define ("SCM_IM_LETREC", SCM_IM_LETREC);
-  scm_sysintern ("SCM_IM_OR", SCM_IM_OR);
+  scm_define ("SCM_IM_OR", SCM_IM_OR);
-  scm_sysintern ("SCM_IM_QUOTE", SCM_IM_QUOTE);
+  scm_define ("SCM_IM_QUOTE", SCM_IM_QUOTE);
-  scm_sysintern ("SCM_IM_SET_X", SCM_IM_SET_X);
+  scm_define ("SCM_IM_SET_X", SCM_IM_SET_X);
-  scm_sysintern ("SCM_IM_DEFINE", SCM_IM_DEFINE);
+  scm_define ("SCM_IM_DEFINE", SCM_IM_DEFINE);
-  scm_sysintern ("SCM_IM_APPLY", SCM_IM_APPLY);
+  scm_define ("SCM_IM_APPLY", SCM_IM_APPLY);
-  scm_sysintern ("SCM_IM_CONT", SCM_IM_CONT);
+  scm_define ("SCM_IM_CONT", SCM_IM_CONT);
-  scm_sysintern ("SCM_IM_DISPATCH", SCM_IM_DISPATCH);
+  scm_define ("SCM_IM_DISPATCH", SCM_IM_DISPATCH);
 #endif
   scm_add_feature ("debug-extensions");
 

libguile/deprecation.c

@@ -116,8 +116,8 @@ print_deprecation_summary (void)
 SCM_DEFINE(scm_include_deprecated_features,
 	   "include-deprecated-features", 0, 0, 0,
 	   (),
-	   "Return @code{#t} iff deprecated features should be included\n"
+	   "Return @code{#t} iff deprecated features should be included
-           "in public interfaces.")
+            in public interfaces.")
 #define FUNC_NAME s_scm_include_deprecated_features
 {
 #if SCM_DEBUG_DEPRECATED == 0

libguile/dynwind.c

@@ -193,8 +193,7 @@ scm_swap_bindings (SCM glocs, SCM vals)
   while (SCM_NIMP (vals))
     {
       tmp = SCM_GLOC_VAL (SCM_CAR (glocs));
-      SCM_SETCDR (SCM_PACK (SCM_UNPACK (SCM_CAR (glocs)) - 1L),
+      SCM_GLOC_SET_VAL (SCM_CAR (glocs), SCM_CAR (vals));
-		  SCM_CAR (vals));
       SCM_SETCAR (vals, tmp);
       glocs = SCM_CDR (glocs);
       vals = SCM_CDR (vals);

libguile/eval.c

@@ -52,7 +52,6 @@
  * marked with the string "SECTION:".
  */
 
-
 /* SECTION: This code is compiled once.
  */
 
@@ -265,9 +264,6 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
 {
   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,44 +318,46 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
 #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);
+    real_var = scm_sym2var (var, top_thunk, SCM_BOOL_F);
-    if (SCM_FALSEP (vcell))
+    if (SCM_FALSEP (real_var))
       goto errout;
-    else
+
-      var = vcell;
-  }
 #ifndef SCM_RECKLESS
-  if (SCM_NNULLP (env) || SCM_UNBNDP (SCM_CDR (var)))
+    if (SCM_NNULLP (env) || SCM_UNBNDP (SCM_VARIABLE_REF (real_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_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 {
+	else 
-	/* A variable could not be found, but we shall not throw an error. */
+	  {
+	    /* 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)
+    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
@@ -381,10 +379,9 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
       }
 #endif /* USE_THREADS */
 
-  SCM_SET_CELL_WORD_0 (vloc, SCM_UNPACK (var) + scm_tc3_cons_gloc);
+    SCM_SET_CELL_WORD_0 (vloc, SCM_UNPACK (real_var) + scm_tc3_cons_gloc);
-  /* Except wait...what if the var is not a vcell,
+    return SCM_VARIABLE_LOC (real_var);
-   * but syntax or something....  */
+  }
-  return SCM_CDRLOC (var);
 }
 
 #ifdef USE_THREADS
@@ -400,6 +397,8 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
 
 #define unmemocar scm_unmemocar
 
+SCM_SYMBOL (sym_three_question_marks, "???");
+
 SCM 
 scm_unmemocar (SCM form, SCM env)
 {
@@ -409,7 +408,13 @@ scm_unmemocar (SCM form, SCM env)
     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 @@ scm_m_define (SCM x, SCM env)
 	    }
 	}
 #endif
-      arg1 = scm_sym2vcell (proc, scm_env_top_level (env), SCM_BOOL_T);
+      arg1 = scm_sym2var (proc, scm_env_top_level (env), SCM_BOOL_T);
-      SCM_SETCDR (arg1, x);
+      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 @@ scm_m_cont (SCM xorig, SCM env)
 
 /* Multi-language support */
 
-SCM scm_lisp_nil;
+SCM_GLOBAL_SYMBOL (scm_lisp_nil, "nil");
-SCM scm_lisp_t;
+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_SYNTAX (s_atfop, "@fop", scm_makmmacro, scm_m_atfop);
 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));
+  var = scm_symbol_fref (SCM_CAR (x));
-  SCM_ASSYNT (SCM_CONSP (vcell),
+  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 @@ scm_m_atbind (SCM xorig, SCM env)
   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_m_expand_body (SCM xorig, SCM env)
 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 @@ scm_macroexp (SCM x, SCM env)
   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 @@ scm_macroexp (SCM x, SCM env)
  * 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.
- */
+ *
-
+ * Unmemoizing is not a realiable process.  You can not in general
-/* We should introduce an anti-macro interface so that it is possible
+ * expect to get the original source back.
- * to plug in transformers in both directions from other compilation
+ *
- * units.  unmemocopy could then dispatch to anti-macro transformers.
+ * However, GOOPS currently relies on this for method compilation.
- * (Those transformers could perhaps be written in slightly more
+ * This ought to change.
- *  readable style... :)
  */
 
 #define SCM_BIT8(x) (127 & SCM_UNPACK (x))
@@ -1519,11 +1524,12 @@ scm_eval_args (SCM l, SCM env, SCM proc)
 	}
       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 @@ scm_deval_args (SCM l, SCM env, SCM proc, SCM *lloc)
 	}
       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_CEVAL (SCM x, SCM env)
       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 @@ dispatch:
 	/* 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 @@ dispatch:
     }
 
     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 @@ dispatch:
 
 	  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 @@ evapply:
 	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 @@ evapply:
       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 @@ evapply:
 	  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 @@ evapply:
       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 @@ evapply:
 								 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 @@ evapply:
 	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 @@ tail:
       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
 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_init_eval ()
 
   scm_f_apply = scm_make_subr ("apply", scm_tc7_lsubr_2, scm_apply);
 
-  scm_lisp_nil = scm_sysintern ("nil", SCM_UNDEFINED);
+  /* acros */
-  SCM_SETCDR (scm_lisp_nil, SCM_CAR (scm_lisp_nil));
+  /* end of acros */
-  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);
 
 #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");
 }
 

libguile/eval.h

@@ -46,8 +46,6 @@
 
 #include "libguile/__scm.h"
 
-/* Needed by SCM_TOP_LEVEL_LOOKUP_CLOSURE below. */
-
 #include "struct.h"
 
 
@@ -131,8 +129,7 @@ extern SCM scm_eval_options_interface (SCM setting);
 
 /*fixme* This should probably be removed throught the code. */
 
-#define SCM_TOP_LEVEL_LOOKUP_CLOSURE \
+#define SCM_TOP_LEVEL_LOOKUP_CLOSURE (scm_current_module_lookup_closure())
-  SCM_MODULE_EVAL_CLOSURE (scm_current_module ())
 
 #if SCM_DEBUG_DEPRECATED == 0
 
@@ -181,13 +178,14 @@ extern SCM scm_sym_args;
 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_VAR(x)        (SCM_PACK(SCM_UNPACK(x)-scm_tc3_cons_gloc))
-#define SCM_GLOC_VAL(x) (SCM_CDR (SCM_PACK (SCM_UNPACK (x) - 1L)))
+#define SCM_GLOC_VAL(x)        (SCM_VARIABLE_REF (SCM_GLOC_VAR (x)))
-#define SCM_GLOC_VAL_LOC(x) (SCM_CDRLOC (SCM_PACK (SCM_UNPACK (x) - 1L)))
+#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)))
 
 
 

libguile/evalext.c

@@ -77,15 +77,12 @@ SCM_DEFINE (scm_definedp, "defined?", 1, 1, 0,
 	    "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,
+    var = scm_sym2var (sym, scm_current_module_lookup_closure (),
-			  scm_module_system_booted_p
-			  ? SCM_TOP_LEVEL_LOOKUP_CLOSURE
-			  : SCM_EOL,
 			 SCM_BOOL_F);
   else
     {
@@ -111,12 +108,12 @@ SCM_DEFINE (scm_definedp, "defined?", 1, 1, 0,
 		return SCM_BOOL_T;
 	    }
 	}
-    vcell = scm_sym2vcell (sym,
+      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_m_undefine (SCM x, SCM env)
 	      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);
+  arg1 = scm_sym2var (x, scm_env_top_level (env), SCM_BOOL_F);
-  SCM_ASSYNT (SCM_NFALSEP (arg1) && !SCM_UNBNDP (SCM_CDR (arg1)),
+  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

libguile/feature.c

@@ -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 @@ scm_set_program_arguments (int argc, char **argv, char *first)
 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_init_feature()
   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"

libguile/filesys.c

@@ -1440,62 +1440,62 @@ scm_init_filesys ()
   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

libguile/fports.c

@@ -802,9 +802,9 @@ scm_init_fports ()
 {
   scm_tc16_fport = scm_make_fptob ();
 
-  scm_sysintern ("_IOFBF", SCM_MAKINUM (_IOFBF));
+  scm_c_define ("_IOFBF", SCM_MAKINUM (_IOFBF));
-  scm_sysintern ("_IOLBF", SCM_MAKINUM (_IOLBF));
+  scm_c_define ("_IOLBF", SCM_MAKINUM (_IOLBF));
-  scm_sysintern ("_IONBF", SCM_MAKINUM (_IONBF));
+  scm_c_define ("_IONBF", SCM_MAKINUM (_IONBF));
 
 #ifndef SCM_MAGIC_SNARFER
 #include "libguile/fports.x"

libguile/gc.c

@@ -1145,6 +1145,17 @@ MARK (SCM p)
   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 @@ gc_mark_loop_first_time:
       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
+	/* Dirk:FIXME:: The following code is super ugly: ptr may be a
-	 * or a gloc.  If it is a gloc, the cell word #0 of ptr is a pointer
+	 * struct or a gloc.  If it is a gloc, the cell word #0 of ptr
-	 * to a heap cell.  If it is a struct, the cell word #0 of ptr is a
+	 * is the address of a scm_tc16_variable smob.  If it is a
-	 * pointer to a struct vtable data region. The fact that these are
+	 * struct, the cell word #0 of ptr is a pointer to a struct
-	 * accessed in the same way restricts the possibilites to change the
+	 * vtable data region. (The fact that these are accessed in
-	 * data layout of structs or heap cells.
+	 * 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 @@ gc_mark_loop_first_time:
               }
             /* mark vtable */
             ptr = SCM_PACK (vtable_data [scm_vtable_index_vtable]);
-            goto gc_mark_loop;
+            goto_gc_mark_loop;
 	  }
       }
       break;
@@ -1257,11 +1273,11 @@ gc_mark_loop_first_time:
       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 @@ gc_mark_loop_first_time:
 	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 @@ gc_mark_loop_first_time:
 	      RECURSE (obj);
 	  }
 	ptr = SCM_CCLO_REF (ptr, 0);
-	goto gc_mark_loop;
+	goto_gc_mark_loop;
       }
 #endif
 #ifdef HAVE_ARRAYS
@@ -1304,7 +1320,7 @@ gc_mark_loop_first_time:
 
     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 @@ gc_mark_loop_first_time:
 
     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 @@ gc_mark_loop_first_time:
       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 @@ gc_mark_loop_first_time:
 	  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 @@ alloc_some_heap (scm_freelist_t *freelist, policy_on_error error_policy)
 }
 #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}
  */
@@ -2653,10 +2625,6 @@ scm_init_storage ()
 #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;
   scm_protects = scm_c_make_hash_table (31);

libguile/gdbint.c

@@ -300,10 +300,8 @@ gdb_binding (SCM name, SCM value)
     }
   SCM_BEGIN_FOREIGN_BLOCK;
   {
-    SCM vcell = scm_sym2vcell (name,
+    SCM var = scm_sym2var (name, SCM_TOP_LEVEL_LOOKUP_CLOSURE, SCM_BOOL_T);
-			       SCM_TOP_LEVEL_LOOKUP_CLOSURE,
+    SCM_VARIABLE_SET (var, value);
-			       SCM_BOOL_T);
-    SCM_SETCDR (vcell, value);
   }
   SCM_END_FOREIGN_BLOCK;
   return 0;

libguile/gh_data.c

@@ -708,14 +708,14 @@ SCM
 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);
+  var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
-  if (cell != SCM_BOOL_F)
+  if (var != SCM_BOOL_F)
-    return SCM_CDR (cell);
+    return SCM_VARIABLE_REF (var);
   else
     return SCM_UNDEFINED;
 }

libguile/gh_funcs.c

@@ -130,7 +130,8 @@ gh_new_procedure5_0 (const char *proc_name, SCM (*fn) ())
 SCM
 gh_define (const char *name, SCM val)
 {
-  return scm_sysintern (name, val);
+  scm_c_define (name, val);
+  return SCM_UNSPECIFIED;
 }
 
 

libguile/goops.c

@@ -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 @@ scm_sys_compute_applicable_methods (SCM gf, SCM args)
 }
 #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 @@ SCM_DEFINE (scm_sys_goops_loaded, "%goops-loaded", 0, 0, 0,
 #define FUNC_NAME s_scm_sys_goops_loaded
 {
   goops_loaded_p = 1;
-  var_compute_applicable_methods
+  var_compute_applicable_methods =
-    = SCM_CDR (scm_apply (scm_goops_lookup_closure,
+    scm_sym2var (sym_compute_applicable_methods, scm_goops_lookup_closure,
-			  SCM_LIST2 (SCM_CAR (var_compute_applicable_methods),
+		 SCM_BOOL_F);
-				     SCM_BOOL_F),
-			  SCM_EOL));
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME

libguile/gsubr.c

@@ -77,7 +77,9 @@ scm_make_gsubr(const char *name,int req,int opt,int rst,SCM (*fcn)())
   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_make_gsubr(const char *name,int req,int opt,int rst,SCM (*fcn)())
       }
       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;
     }

libguile/hooks.c

@@ -198,7 +198,7 @@ SCM
 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;
 }

libguile/init.c

@@ -366,8 +366,6 @@ scm_load_startup_files ()
       /* 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_init_guile_1 (SCM_STACKITEM *base)
   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_guile_1 (SCM_STACKITEM *base)
   scm_init_strorder ();
   scm_init_strop ();
   scm_init_throw ();
-  scm_init_variable ();
   scm_init_vectors ();
   scm_init_version ();
   scm_init_weaks ();

libguile/keywords.c

@@ -71,24 +71,21 @@ SCM_DEFINE (scm_make_keyword_from_dash_symbol, "make-keyword-from-dash-symbol",
             "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);
+  keyword = scm_hashq_ref (scm_keyword_obarray, symbol, SCM_BOOL_F);
-  if (SCM_FALSEP (vcell))
+  if (SCM_FALSEP (keyword))
     {
-      SCM keyword;
       SCM_NEWSMOB (keyword, scm_tc16_keyword, SCM_UNPACK (symbol));
-      scm_intern_symbol (scm_keyword_obarray, symbol);
+      scm_hashq_set_x (scm_keyword_obarray, symbol, keyword);
-      vcell = scm_sym2ovcell_soft (symbol, scm_keyword_obarray);
-      SCM_SETCDR (vcell, keyword);
     }
   SCM_ALLOW_INTS;
-  return SCM_CDR (vcell);
+  return keyword;
 }
 #undef FUNC_NAME
 

libguile/load.c

@@ -494,7 +494,7 @@ static void
 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 @@ void
 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_VARIABLE_LOC (scm_c_define ("%load-extensions",
 				    SCM_LIST2 (scm_makfrom0str (".scm"),
 					       scm_nullstr)));
-  scm_loc_load_hook = SCM_CDRLOC (scm_sysintern ("%load-hook", SCM_BOOL_F));
+  scm_loc_load_hook = SCM_VARIABLE_LOC (scm_c_define ("%load-hook", SCM_BOOL_F));
 
   init_build_info ();
 

libguile/macros.c

@@ -220,10 +220,10 @@ SCM_DEFINE (scm_macro_transformer, "macro-transformer", 1, 0, 0,
 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));
+  SCM_VARIABLE_SET (var, macroizer (transformer));
-  return SCM_CAR (symcell);
+  return SCM_UNSPECIFIED;
 }
 
 void

libguile/modules.c

@@ -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 @@ SCM_DEFINE (scm_current_module, "current-module", 0, 0, 0,
 }
 #undef FUNC_NAME
 
-#define SCM_VALIDATE_STRUCT_TYPE(pos, v, type) \
+static void scm_post_boot_init_modules (void);
-  do { \
-    SCM_ASSERT (SCM_NIMP (v) && SCM_NFALSEP (SCM_STRUCTP (v)) \
-		&& SCM_STRUCT_VTABLE (v) == (type), \
-                v, pos, FUNC_NAME); \
-  } while (0)
 
 SCM_DEFINE (scm_set_current_module, "set-current-module", 1, 0, 0,
 	    (SCM module),
@@ -97,21 +94,18 @@ SCM_DEFINE (scm_set_current_module, "set-current-module", 1, 0, 0,
 {
   SCM old;
 
-  /* XXX - we can not validate our argument when the module system
+  if (!scm_module_system_booted_p)
-           hasn't been booted yet since we don't know the type.  This
+    scm_post_boot_init_modules ();
-           should be fixed when we have a cleaner way of booting
+
-           Guile. 
+  SCM_VALIDATE_MODULE (SCM_ARG1, module);
-  */
-  if (scm_module_system_booted_p)
-    SCM_VALIDATE_STRUCT_TYPE (SCM_ARG1, module, scm_module_type);
 
   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 @@ scm_module_full_name (SCM name)
     return scm_append (SCM_LIST2 (module_prefix, name));
 }
 
-static SCM make_modules_in;
+static SCM make_modules_in_var;
-static SCM beautify_user_module_x;
+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,13 +154,17 @@ scm_make_module (SCM name)
 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)
 {
+  if (module == SCM_BOOL_F)
+    return SCM_BOOL_F;
+  else
     return SCM_MODULE_EVAL_CLOSURE (module);
 }
 
@@ -182,6 +180,9 @@ scm_current_module_lookup_closure ()
 SCM
 scm_module_transformer (SCM module)
 {
+  if (module == SCM_BOOL_F)
+    return SCM_BOOL_F;
+  else
     return SCM_MODULE_TRANSFORMER (module);
 }
 
@@ -194,20 +195,22 @@ scm_current_module_transformer ()
     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 @@ scm_env_top_level (SCM env)
   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 @@ scm_system_module_env_p (SCM env)
  * 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 @@ module_variable (SCM module, SCM sym)
 
 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_eval_closure_lookup (SCM eclo, SCM sym, SCM definep)
 {
   SCM module = SCM_PACK (SCM_SMOB_DATA (eclo));
   if (SCM_NFALSEP (definep))
-    return scm_apply (SCM_CDR (module_make_local_var_x),
+    {
+      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,13 +351,221 @@ SCM_DEFINE (scm_standard_eval_closure, "standard-eval-closure", 1, 0, 0,
 }
 #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!",
+  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);
@@ -331,21 +574,21 @@ scm_init_modules ()
   the_module = scm_permanent_object (scm_make_fluid ());
 }
 
-void
+static void
 scm_post_boot_init_modules ()
 {
-  scm_module_type =
+#define PERM(x) scm_permanent_object(x)
-    scm_permanent_object (SCM_CDR (scm_intern0 ("module-type")));
+
-  scm_module_tag = (SCM_CELL_WORD_1 (scm_module_type) + scm_tc3_cons_gloc);
+  SCM module_type = SCM_VARIABLE_REF (scm_c_lookup ("module-type"));
-  module_prefix = scm_permanent_object (SCM_LIST2 (scm_sym_app,
+  scm_module_tag = (SCM_CELL_WORD_1 (module_type) + scm_tc3_cons_gloc);
-						   scm_sym_modules));
+  module_prefix = PERM (SCM_LIST2 (scm_sym_app, scm_sym_modules));
-  make_modules_in = scm_intern0 ("make-modules-in");
+  make_modules_in_var = PERM (scm_c_lookup ("make-modules-in"));
-  beautify_user_module_x = scm_intern0 ("beautify-user-module!");
+  beautify_user_module_x_var = PERM (scm_c_lookup ("beautify-user-module!"));
-  the_root_module = scm_intern0 ("the-root-module");
+  the_root_module_var = PERM (scm_c_lookup ("the-root-module"));
-  root_module_lookup_closure = scm_permanent_object
+  root_module_lookup_closure =
-    (scm_module_lookup_closure (SCM_CDR (the_root_module)));
+    PERM (scm_module_lookup_closure (SCM_VARIABLE_REF (the_root_module_var)));
-  resolve_module = scm_intern0 ("resolve-module");
+  resolve_module_var = PERM (scm_c_lookup ("resolve-module"));
-  try_module_autoload = scm_intern0 ("try-module-autoload");
+  try_module_autoload_var = PERM (scm_c_lookup ("try-module-autoload"));
   scm_module_system_booted_p = 1;
 }
 

libguile/modules.h

@@ -82,7 +82,7 @@ extern scm_bits_t scm_tc16_eval_closure;
 
 
 
-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_top_level_env (SCM thunk);
 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 */
 

libguile/numbers.c

@@ -4546,8 +4546,10 @@ scm_init_numbers ()
    * 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_c_define ("most-positive-fixnum",
-  scm_sysintern ("most-negative-fixnum", SCM_MAKINUM (SCM_MOST_NEGATIVE_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");

libguile/objects.c

@@ -509,13 +509,13 @@ scm_init_objects ()
   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"

libguile/ports.c

@@ -1564,9 +1564,9 @@ void
 scm_init_ports ()
 {
   /* lseek() symbols.  */
-  scm_sysintern ("SEEK_SET", SCM_MAKINUM (SEEK_SET));
+  scm_c_define ("SEEK_SET", SCM_MAKINUM (SEEK_SET));
-  scm_sysintern ("SEEK_CUR", SCM_MAKINUM (SEEK_CUR));
+  scm_c_define ("SEEK_CUR", SCM_MAKINUM (SEEK_CUR));
-  scm_sysintern ("SEEK_END", SCM_MAKINUM (SEEK_END));
+  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);

libguile/posix.c

@@ -1572,70 +1572,70 @@ scm_init_posix ()
   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_c_define ("R_OK", SCM_MAKINUM (R_OK));
-  scm_sysintern ("W_OK", SCM_MAKINUM (W_OK));
+  scm_c_define ("W_OK", SCM_MAKINUM (W_OK));
-  scm_sysintern ("X_OK", SCM_MAKINUM (X_OK));
+  scm_c_define ("X_OK", SCM_MAKINUM (X_OK));
-  scm_sysintern ("F_OK", SCM_MAKINUM (F_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"

libguile/print.c

@@ -371,7 +371,8 @@ taloop:
     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))

libguile/procs.c

@@ -73,7 +73,7 @@ SCM
 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_make_subr_opt (const char *name, int type, SCM (*fcn) (), int set)
       scm_subr_table_room = new_size;
     }
 
+  symbol = scm_str2symbol (name);
+
   SCM_NEWCELL (z);
   if (set)
-    {
+    var = scm_sym2var (symbol, scm_current_module_lookup_closure (),
-      symcell = scm_sysintern (name, SCM_UNDEFINED);
+		       SCM_BOOL_T);
-      symbol = SCM_CAR (symcell);
-    }
   else
-    {
+    var = SCM_BOOL_F;
-      symcell = SCM_BOOL_F; /* to avoid warning */
-      symbol = scm_str2symbol (name);
-    }
   
   entry = scm_subr_table_size;
   scm_subr_table[entry].handle = z;
@@ -112,7 +109,7 @@ scm_make_subr_opt (const char *name, int type, SCM (*fcn) (), int set)
   scm_subr_table_size++;
   
   if (set)
-    SCM_SETCDR (symcell, z);
+    SCM_VARIABLE_SET (var, z);
   
   return z;
 }

libguile/ramap.c

@@ -2043,12 +2043,19 @@ scm_array_equal_p (SCM ra0, SCM ra1)
 }
 
 
-
 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;
+    }
 }
 
 

libguile/random.c

@@ -352,7 +352,7 @@ rstate_free (SCM rstate)
  * 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 @@ SCM_DEFINE (scm_random, "random", 1, 1, 0,
 #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 @@ SCM_DEFINE (scm_copy_random_state, "copy-random-state", 0, 1, 0,
 #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 @@ SCM_DEFINE (scm_random_uniform, "random:uniform", 0, 1, 0,
 #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 @@ SCM_DEFINE (scm_random_normal, "random:normal", 0, 1, 0,
 #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_DEFINE (scm_random_solid_sphere_x, "random:solid-sphere!", 1, 1, 0,
 {
   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_DEFINE (scm_random_hollow_sphere_x, "random:hollow-sphere!", 1, 1, 0,
 {
   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 @@ SCM_DEFINE (scm_random_normal_vector_x, "random:normal-vector!", 1, 1, 0,
   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 @@ SCM_DEFINE (scm_random_exp, "random:exp", 0, 1, 0,
 #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)));
 }

libguile/read.c

@@ -819,7 +819,7 @@ void
 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

libguile/regex-posix.c

@@ -303,14 +303,14 @@ scm_init_regex_posix ()
   scm_set_smob_free (scm_tc16_regex, regex_free);
 
   /* Compilation flags.  */
-  scm_sysintern ("regexp/basic", scm_long2num (REG_BASIC));
+  scm_c_define ("regexp/basic", scm_long2num (REG_BASIC));
-  scm_sysintern ("regexp/extended", scm_long2num (REG_EXTENDED));
+  scm_c_define ("regexp/extended", scm_long2num (REG_EXTENDED));
-  scm_sysintern ("regexp/icase", scm_long2num (REG_ICASE));
+  scm_c_define ("regexp/icase", scm_long2num (REG_ICASE));
-  scm_sysintern ("regexp/newline", scm_long2num (REG_NEWLINE));
+  scm_c_define ("regexp/newline", scm_long2num (REG_NEWLINE));
 
   /* Execution flags.  */
-  scm_sysintern ("regexp/notbol", scm_long2num (REG_NOTBOL));
+  scm_c_define ("regexp/notbol", scm_long2num (REG_NOTBOL));
-  scm_sysintern ("regexp/noteol", scm_long2num (REG_NOTEOL));
+  scm_c_define ("regexp/noteol", scm_long2num (REG_NOTEOL));
 
 #ifndef SCM_MAGIC_SNARFER
 #include "libguile/regex-posix.x"

libguile/root.h

@@ -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_keyword_obarray scm_sys_protects[5]
-#define scm_symhash_vars scm_sys_protects[6]
+#define scm_stand_in_procs scm_sys_protects[6]
-#define scm_keyword_obarray scm_sys_protects[7]
+#define scm_object_whash scm_sys_protects[7]
-#define scm_stand_in_procs scm_sys_protects[8]
+#define scm_permobjs scm_sys_protects[8]
-#define scm_object_whash scm_sys_protects[9]
+#define scm_asyncs scm_sys_protects[9]
-#define scm_permobjs scm_sys_protects[10]
+#define scm_protects scm_sys_protects[10]
-#define scm_asyncs scm_sys_protects[11]
+#define scm_properties_whash scm_sys_protects[11]
-#define scm_protects scm_sys_protects[12]
-#define scm_properties_whash scm_sys_protects[13]
 #ifdef DEBUG_EXTENSIONS
-#define scm_source_whash scm_sys_protects[14]
+#define scm_source_whash scm_sys_protects[12]
-#define SCM_NUM_PROTECTS 15
+#define SCM_NUM_PROTECTS 13
 #else
-#define SCM_NUM_PROTECTS 14
+#define SCM_NUM_PROTECTS 12
 #endif
 
 extern SCM scm_sys_protects[];

libguile/scmsigs.c

@@ -492,7 +492,7 @@ scm_init_scmsigs ()
   int i;
 
   signal_handlers =
-    SCM_CDRLOC (scm_sysintern ("signal-handlers",
+    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);
@@ -532,14 +532,14 @@ scm_init_scmsigs ()
 #endif
     }
 
-  scm_sysintern ("NSIG", scm_long2num (NSIG));
+  scm_c_define ("NSIG", scm_long2num (NSIG));
-  scm_sysintern ("SIG_IGN", scm_long2num ((long) SIG_IGN));
+  scm_c_define ("SIG_IGN", scm_long2num ((long) SIG_IGN));
-  scm_sysintern ("SIG_DFL", scm_long2num ((long) SIG_DFL));
+  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

libguile/script.c

@@ -571,7 +571,7 @@ scm_compile_shell_switches (int argc, char **argv)
   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))

libguile/snarf.h

@@ -172,6 +172,27 @@ SCM_SNARF_INIT(c_name = scm_permanent_object (scm_c_make_keyword (scheme_name)))
 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));)
@@ -188,11 +209,6 @@ SCM_SNARF_INIT(c_name = scm_permanent_object (scm_sysintern (scheme_name, init_v
 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) */
 
 #ifdef SCM_MAGIC_SNARFER

libguile/socket.c

@@ -1264,123 +1264,123 @@ scm_init_socket ()
 {
   /* 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");

libguile/srcprop.c

@@ -334,7 +334,7 @@ scm_init_srcprop ()
   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"

libguile/stacks.c

@@ -221,9 +221,9 @@ read_frame (scm_debug_frame *dframe,long offset,scm_info_frame *iframe)
 static SCM
 get_applybody ()
 {
-  SCM cell = scm_sym2vcell (scm_sym_apply, SCM_BOOL_F, SCM_BOOL_F);
+  SCM var = scm_sym2var (scm_sym_apply, SCM_BOOL_F, SCM_BOOL_F);
-  if (SCM_CONSP (cell) && SCM_CLOSUREP (SCM_CDR (cell)))
+  if (SCM_VARIABLEP (var) && SCM_CLOSUREP (SCM_VARIABLE_REF (var)))
-    return SCM_CADR (SCM_CODE (SCM_CDR (cell)));
+    return SCM_CADR (SCM_CODE (SCM_VARIABLE_REF (var)));
   else
     return SCM_UNDEFINED;
 }

libguile/stime.c

@@ -706,7 +706,7 @@ SCM_DEFINE (scm_strptime, "strptime", 2, 0, 0,
 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

libguile/struct.c

@@ -820,10 +820,11 @@ scm_init_struct ()
     = 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_c_define ("vtable-index-layout", SCM_MAKINUM (scm_vtable_index_layout));
-  scm_sysintern ("vtable-index-vtable", SCM_MAKINUM (scm_vtable_index_vtable));
+  scm_c_define ("vtable-index-vtable", SCM_MAKINUM (scm_vtable_index_vtable));
-  scm_sysintern ("vtable-index-printer", SCM_MAKINUM (scm_vtable_index_printer));
+  scm_c_define ("vtable-index-printer",
-  scm_sysintern ("vtable-offset-user", SCM_MAKINUM (scm_vtable_offset_user));
+		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

libguile/symbols-deprecated.c

@@ -0,0 +1,637 @@
+/*	Copyright (C) 1995,1996,1997,1998, 2000, 2001 Free Software Foundation, Inc.
+ * 
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2, or (at your option)
+ * any later version.
+ * 
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ * 
+ * You should have received a copy of the GNU General Public License
+ * along with this software; see the file COPYING.  If not, write to
+ * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
+ * Boston, MA 02111-1307 USA
+ *
+ * As a special exception, the Free Software Foundation gives permission
+ * for additional uses of the text contained in its release of GUILE.
+ *
+ * The exception is that, if you link the GUILE library with other files
+ * to produce an executable, this does not by itself cause the
+ * resulting executable to be covered by the GNU General Public License.
+ * Your use of that executable is in no way restricted on account of
+ * linking the GUILE library code into it.
+ *
+ * This exception does not however invalidate any other reasons why
+ * the executable file might be covered by the GNU General Public License.
+ *
+ * This exception applies only to the code released by the
+ * Free Software Foundation under the name GUILE.  If you copy
+ * code from other Free Software Foundation releases into a copy of
+ * GUILE, as the General Public License permits, the exception does
+ * not apply to the code that you add in this way.  To avoid misleading
+ * anyone as to the status of such modified files, you must delete
+ * this exception notice from them.
+ *
+ * If you write modifications of your own for GUILE, it is your choice
+ * whether to permit this exception to apply to your modifications.
+ * If you do not wish that, delete this exception notice.  */
+
+/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
+   gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
+
+
+
+#include "libguile/_scm.h"
+#include "libguile/chars.h"
+#include "libguile/eval.h"
+#include "libguile/hash.h"
+#include "libguile/smob.h"
+#include "libguile/variable.h"
+#include "libguile/alist.h"
+#include "libguile/fluids.h"
+#include "libguile/strings.h"
+#include "libguile/vectors.h"
+#include "libguile/hashtab.h"
+#include "libguile/weaks.h"
+#include "libguile/modules.h"
+#include "libguile/deprecation.h"
+
+#include "libguile/validate.h"
+#include "libguile/symbols.h"
+
+#ifdef HAVE_STRING_H
+#include <string.h>
+#endif
+
+
+
+#if SCM_ENABLE_VCELLS
+
+/* 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_c_issue_deprecation_warning ("`scm_sym2ovcell_soft' is deprecated. "
+				   "Use hashtables instead.");
+
+  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;
+
+  scm_c_issue_deprecation_warning ("`scm_sym2ovcell' is deprecated. "
+				   "Use hashtables instead.");
+
+  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;
+
+  scm_c_issue_deprecation_warning ("`scm_intern_obarray_soft' is deprecated. "
+				   "Use hashtables instead.");
+
+  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)
+{
+  scm_c_issue_deprecation_warning ("`scm_intern_obarray' is deprecated. "
+				   "Use hashtables instead.");
+
+  return scm_intern_obarray_soft (name, len, obarray, 0);
+}
+
+
+SCM 
+scm_intern (const char *name,scm_sizet len)
+{
+  scm_c_issue_deprecation_warning ("`scm_intern' is deprecated. "
+				   "Use scm_c_define or scm_c_lookup instead.");
+
+  {
+    SCM symbol = scm_mem2symbol (name, len);
+    SCM var = scm_sym2var (symbol, SCM_BOOL_F, SCM_BOOL_T);
+    SCM vcell = SCM_VARVCELL (var);
+    SCM_SETCAR (vcell, symbol);
+    return vcell;
+  }
+}
+
+
+SCM
+scm_intern0 (const char * name)
+{
+  scm_c_issue_deprecation_warning ("`scm_intern0' is deprecated. "
+				   "Use scm_define or scm_lookup instead.");
+
+  return scm_intern (name, strlen (name));
+}
+
+/* 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 var;
+
+  scm_c_issue_deprecation_warning ("`scm_sysintern' is deprecated. "
+				   "Use `scm_define' instead.");
+
+  var = scm_c_define (name, val);
+  return SCM_VARVCELL (var);
+}
+
+SCM
+scm_sysintern0 (const char *name)
+{
+  SCM var;
+  SCM symbol;
+
+  scm_c_issue_deprecation_warning ("`scm_sysintern0' is deprecated. "
+				   "Use `scm_define' instead.");
+
+  symbol = scm_str2symbol (name);
+  var = scm_sym2var (symbol, scm_current_module_lookup_closure (), SCM_BOOL_T);
+  if (var == SCM_BOOL_F)
+    scm_misc_error ("sysintern0", "can't define variable", symbol);
+  return SCM_VARVCELL (var);
+}
+
+/* Lookup the value of the symbol named by the nul-terminated string
+   NAME in the current module.  */
+SCM
+scm_symbol_value0 (const char *name)
+{
+  scm_c_issue_deprecation_warning ("`scm_symbol_value0' is deprecated. "
+				   "Use `scm_lookup' instead.");
+
+  return scm_variable_ref (scm_c_lookup (name));
+}
+
+SCM
+scm_sym2vcell (SCM sym, SCM thunk, SCM definep)
+{
+  SCM var;
+
+  scm_c_issue_deprecation_warning("`scm_sym2vcell' is deprecated. "
+				  "Use `scm_define' or `scm_lookup' instead.");
+  
+  var = scm_sym2var (sym, thunk, definep);
+  if (var == SCM_BOOL_F)
+    return SCM_BOOL_F;
+  return SCM_VARVCELL (var);
+}
+
+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);
+
+  scm_c_issue_deprecation_warning ("`string->obarray-symbol' is deprecated. "
+				   "Use hashtables instead.");
+
+  softness = (!SCM_UNBNDP (softp) && !SCM_FALSEP(softp));
+  /* iron out some screwy calling conventions */
+  if (SCM_FALSEP (o))
+    {
+      /* nothing interesting to do here. */
+      return scm_string_to_symbol (s);
+    }
+  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))
+    return SCM_UNSPECIFIED;
+
+  scm_c_issue_deprecation_warning ("`intern-symbol' is deprecated. "
+				   "Use hashtables instead.");
+
+  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
+
+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_c_issue_deprecation_warning ("`unintern-symbol' is deprecated. "
+				   "Use hashtables instead.");
+
+  SCM_VALIDATE_SYMBOL (2,s);
+  if (SCM_FALSEP (o))
+    return SCM_BOOL_F;
+  SCM_VALIDATE_VECTOR (1,o);
+  hval = SCM_SYMBOL_HASH (s) % SCM_VECTOR_LENGTH (o);
+  SCM_DEFER_INTS;
+  {
+    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;
+	  }
+      }
+  }
+  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_c_issue_deprecation_warning ("`symbol-binding' is deprecated. "
+				   "Use hashtables instead.");
+
+  SCM_VALIDATE_SYMBOL (2,s);
+  if (SCM_FALSEP (o))
+    return scm_variable_ref (scm_lookup (s));
+  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_c_issue_deprecation_warning ("`symbol-interned?' is deprecated. "
+				   "Use hashtables instead.");
+
+  SCM_VALIDATE_SYMBOL (2,s);
+  if (SCM_FALSEP (o))
+    {
+      SCM var = scm_sym2var (s, SCM_BOOL_F, SCM_BOOL_F);
+      if (var != SCM_BOOL_F)
+	return SCM_BOOL_T;
+      return SCM_BOOL_F;
+    }
+  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_c_issue_deprecation_warning ("`symbol-bound?' is deprecated. "
+				   "Use hashtables instead.");
+
+  SCM_VALIDATE_SYMBOL (2,s);
+  if (SCM_FALSEP (o))
+    {
+      SCM var = scm_sym2var (s, SCM_BOOL_F, SCM_BOOL_F);
+      if (SCM_DEFVARIABLEP (var))
+	return SCM_BOOL_T;
+      return SCM_BOOL_F;
+    }
+  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_c_issue_deprecation_warning ("`symbol-set!' is deprecated. "
+				   "Use the module system instead.");
+
+  SCM_VALIDATE_SYMBOL (2,s);
+  if (SCM_FALSEP (o))
+    {
+      scm_define (s, v);
+      return SCM_UNSPECIFIED;
+    }
+  SCM_VALIDATE_VECTOR (1,o);
+  vcell = scm_sym2ovcell (s, o);
+  SCM_SETCDR (vcell, v);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+#if 0
+
+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);
+
+  scm_issue_deprecation_warning ("`builtin-bindings' is deprecated. "
+				 "Use the module system instead.");
+
+  copy_and_prune_obarray (scm_symhash, obarray);
+  return obarray;
+}
+#undef FUNC_NAME
+
+#endif
+
+#define MAX_PREFIX_LENGTH 30
+
+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;
+
+  scm_c_issue_deprecation_warning ("`gentemp' is deprecated. "
+				   "Use `gensym' instead.");
+
+  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))
+    return scm_gensym (prefix);
+  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_init_symbols_deprecated ()
+{
+  gentemp_counter = 0;
+#ifndef SCM_MAGIC_SNARFER
+#include "libguile/symbols-deprecated.x"
+#endif
+}
+
+#endif /* SCM_ENABLE_VCELLS */
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/

libguile/symbols.c

@@ -158,264 +158,6 @@ scm_str2symbol (const char *str)
   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 @@ SCM_DEFINE (scm_string_to_symbol, "string->symbol", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+#define MAX_PREFIX_LENGTH 30
 
-SCM_DEFINE (scm_string_to_obarray_symbol, "string->obarray-symbol", 2, 1, 0,
+static int gensym_counter;
-           (SCM o, SCM s, SCM softp),
+
-	    "Intern a new symbol in @var{obarray}, a symbol table, with name\n"
+SCM_DEFINE (scm_gensym, "gensym", 0, 1, 0,
-	    "@var{string}.\n\n"
+            (SCM prefix),
-	    "If @var{obarray} is @code{#f}, use the default system symbol table.  If\n"
+	    "Create a new symbol with a name constructed from a prefix and\n"
-	    "@var{obarray} is @code{#t}, the symbol should not be interned in any\n"
+	    "a counter value. The string @var{prefix} can be specified as\n"
-	    "symbol table; merely return the pair (@var{symbol}\n"
+	    "an optional argument. Default prefix is @code{g}.  The counter\n"
-	    ". @var{#<undefined>}).\n\n"
+	    "is increased by 1 at each call. There is no provision for\n"
-	    "The @var{soft?} argument determines whether new symbol table entries\n"
+	    "resetting the counter.")
-	    "should be created when the specified symbol is not already present in\n"
+#define FUNC_NAME s_scm_gensym
-	    "@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;
+  char buf[MAX_PREFIX_LENGTH + SCM_INTBUFLEN];
-  SCM answer;
+  char *name = buf;
-  int softness;
+  int len;
-
+  if (SCM_UNBNDP (prefix))
-  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;
+      name[0] = 'g';
-    SCM sym;
+      len = 1;
-    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
-
-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 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;
+      SCM_VALIDATE_STRING (1, prefix);
-	    return SCM_BOOL_T;
+      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;
   }
-  }
-  SCM_ALLOW_INTS;
-  return SCM_BOOL_F;
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_symbol_binding, "symbol-binding", 2, 0, 0,
+SCM_DEFINE (scm_symbol_hash, "symbol-hash", 1, 0, 0, 
-           (SCM o, SCM s),
+	    (SCM symbol),
-	    "Look up in @var{obarray} the symbol whose name is @var{string}, and\n"
+	    "Return a hash value for @var{symbol}.")
-	    "return the value to which it is bound.  If @var{obarray} is @code{#f},\n"
+#define FUNC_NAME s_scm_symbol_hash
-	    "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 (1, symbol);
-  SCM_VALIDATE_SYMBOL (2,s);
+  return SCM_MAKINUM (SCM_SYMBOL_HASH (symbol));
-  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;
-}
-#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 @@ SCM_DEFINE (scm_symbol_pset_x, "symbol-pset!", 2, 0, 0,
 }
 #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,10 +339,12 @@ void
 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
 }
 
 /*

libguile/symbols.h

@@ -77,35 +77,18 @@ extern SCM scm_sys_symbols (void);
 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);
 
@@ -141,6 +124,34 @@ extern void scm_init_symbols (void);
 
 #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 */
 
 /*

libguile/tag.c

@@ -1,108 +0,0 @@
-/*	Copyright (C) 1996, 1997, 2000 Free Software Foundation, Inc.
- * 
- * This program is free software; you can redistribute it and/or modify
- * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2, or (at your option)
- * any later version.
- * 
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- * GNU General Public License for more details.
- * 
- * You should have received a copy of the GNU General Public License
- * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
- * Boston, MA 02111-1307 USA
- *
- * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
- *
- * The exception is that, if you link the GUILE library with other files
- * to produce an executable, this does not by itself cause the
- * resulting executable to be covered by the GNU General Public License.
- * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
- *
- * This exception does not however invalidate any other reasons why
- * the executable file might be covered by the GNU General Public License.
- *
- * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE.  If you copy
- * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
- * not apply to the code that you add in this way.  To avoid misleading
- * anyone as to the status of such modified files, you must delete
- * this exception notice from them.
- *
- * If you write modifications of your own for GUILE, it is your choice
- * whether to permit this exception to apply to your modifications.
- * If you do not wish that, delete this exception notice.  */
-
-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
-   gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
-
-
-#include "libguile/_scm.h"
-#include "libguile/chars.h"
-#include "libguile/struct.h"
-
-#include "libguile/tag.h"
-
-
-#define CONST_INUM(c_name, scheme_name, value) \
-SCM_VCELL_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);
-CONST_INUM (scm_utag_pair, "utag_pair", 2);
-CONST_INUM (scm_utag_closure, "utag_closure", 3);
-CONST_INUM (scm_utag_symbol, "utag_symbol", 4);
-CONST_INUM (scm_utag_vector, "utag_vector", 5);
-CONST_INUM (scm_utag_wvect, "utag_wvect", 6);
-
-#ifdef HAVE_ARRAYS
-CONST_INUM (scm_utag_bvect, "utag_bvect", 7);
-CONST_INUM (scm_utag_byvect, "utag_byvect", 8);
-CONST_INUM (scm_utag_svect, "utag_svect", 9);
-CONST_INUM (scm_utag_ivect, "utag_ivect", 10);
-CONST_INUM (scm_utag_uvect, "utag_uvect", 11);
-CONST_INUM (scm_utag_fvect, "utag_fvect", 12);
-CONST_INUM (scm_utag_dvect, "utag_dvect", 13);
-CONST_INUM (scm_utag_cvect, "utag_cvect", 14);
-#endif 
-
-CONST_INUM (scm_utag_string, "utag_string", 15);
-CONST_INUM (scm_utag_substring, "utag_substring", 17);
-CONST_INUM (scm_utag_asubr, "utag_asubr", 19);
-CONST_INUM (scm_utag_subr_0, "utag_subr_0", 20);
-CONST_INUM (scm_utag_subr_1, "utag_subr_1", 21);
-CONST_INUM (scm_utag_cxr, "utag_cxr", 22);
-CONST_INUM (scm_utag_subr_3, "utag_subr_3", 23);
-CONST_INUM (scm_utag_subr_2, "utag_subr_2", 24);
-CONST_INUM (scm_utag_rpsubr, "utag_rpsubr", 25);
-CONST_INUM (scm_utag_subr_1o, "utag_subr_1o", 26);
-CONST_INUM (scm_utag_subr_2o, "utag_subr_2o", 27);
-CONST_INUM (scm_utag_lsubr_2, "utag_lsubr_2", 28);
-CONST_INUM (scm_utag_lsubr, "utag_lsubr", 29);
-CONST_INUM (scm_utag_smob_base, "utag_smob_base", 252);
-CONST_INUM (scm_utag_port_base, "utag_port_base", 253);
-CONST_INUM (scm_utag_flag_base, "utag_flag_base", 254);
-CONST_INUM (scm_utag_struct_base, "utag_struct_base", 255);
-
-
-
-void
-scm_init_tag ()
-{
-#ifndef SCM_MAGIC_SNARFER
-#include "libguile/tag.x"
-#endif
-}
-
-
-/*
-  Local Variables:
-  c-file-style: "gnu"
-  End:
-*/

libguile/throw.c

@@ -292,13 +292,13 @@ scm_internal_lazy_catch (SCM tag, scm_catch_body_t body, void *body_data, scm_ca
 
 /* 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);

libguile/variable.c

@@ -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 @@ variable_print (SCM exp, SCM port, scm_print_state *pstate)
 {
   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_iprin1 (SCM_VARIABLE_REF (exp), port, pstate);
-  }
   scm_putc('>', port);
   return 1;
 }
@@ -77,55 +70,40 @@ variable_print (SCM exp, SCM port, scm_print_state *pstate)
 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_DEFINE (scm_make_variable, "make-variable", 1, 0, 0, 
-            (SCM init, SCM name_hint),
+            (SCM init),
-            "Return a variable object initialized to value @var{init}.\n"
+            "Return a variable 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")
 #define FUNC_NAME s_scm_make_variable
 {
-  SCM vcell;
+  return make_variable (init);
-  
-  if (SCM_UNBNDP (name_hint))
-    name_hint = anonymous_variable_sym;
-
-  vcell = scm_cons (name_hint, init);
-  return make_vcell_variable (vcell);
 }
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_make_undefined_variable, "make-undefined-variable", 0, 1, 0, 
+SCM_DEFINE (scm_make_undefined_variable, "make-undefined-variable", 0, 0, 0, 
-            (SCM name_hint),
+            (),
-            "Return a variable object initialized to an undefined value.\n"
+            "Return a variable that is initially unbound.\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")
 #define FUNC_NAME s_scm_make_undefined_variable
 {
-  SCM vcell;
+  return make_variable (SCM_UNDEFINED);
-
-  if (SCM_UNBNDP (name_hint))
-    name_hint = anonymous_variable_sym;
-
-  vcell = scm_cons (name_hint, SCM_UNDEFINED);
-  return make_vcell_variable (vcell);
 }
 #undef FUNC_NAME
 
@@ -148,13 +126,15 @@ SCM_DEFINE (scm_variable_ref, "variable-ref", 1, 0, 0,
 	    "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 @@ SCM_DEFINE (scm_variable_set_x, "variable-set!", 2, 0, 0,
 #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 @@ SCM_DEFINE (scm_variable_bound_p, "variable-bound?", 1, 0, 0,
 #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 ()
@@ -225,7 +204,6 @@ scm_init_variable ()
 #endif
 }
 
-
 /*
   Local Variables:
   c-file-style: "gnu"

libguile/variable.h

@@ -47,6 +47,7 @@
    gjb@cs.washington.edu, 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_SMOB_PREDICATE (scm_tc16_variable, X)
-#define SCM_VARIABLEP(X)   	(!SCM_IMP (X) && SCM_CELL_TYPE (X) == scm_tc16_variable)
+
+#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_variable (SCM init);
-extern SCM scm_make_undefined_variable (SCM name_hint);
+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 */