* tags.h: Update tag system docs.

(scm_tc3_cons_gloc): Renamed to scm_tc3_struct.  Changed all uses.
(scm_tcs_cons_gloc): Renamed to scm_tcs_struct.  Changed all uses.
(SCM_ECONSP, SCM_NECONSP): Removed.  Changed all uses to SCM_CONSP
or SCM_NCONSP, respectively.

* struct.c, struct.h, srcprop.c, procs.c, procprop.c, print.c,
objects.c. modules.c, goops.c, eval.c, debug.c: Changed all uses
of scm_tc3_cond_gloc and scm_tcs_cons_gloc.  See above.

* print.c (scm_iprin1): Remove printing of glocs.  Do not try to
tell glocs from structs.

* gc.c (scm_gc_mark, scm_gc_sweep): Remove handling of glocs.

* eval.c (scm_m_atbind): Make a list of variables, not glocs.
(scm_ceval, scm_deval): For SCM_IM_BIND, fiddle with variables
instead of with glocs.
(EVALCAR): Do not test for glocs.
(scm_lookupcar, scm_lookupcar1): Do not handle glocs in race
condition.
(scm_unmemocar): Do not handle glocs.
(scm_m_atfop): Memoize as a variable, not as a gloc.
(scm_eval_args, scm_deval_args): Do not handle glocs.
(scm_ceval, scm_deval): Likewise.

* eval.h (SCM_XEVALCAR): Do not test for glocs.
(SCM_GLOC_VAR, SCM_GLOC_VAL, SCM_GLOC_SET_VAL, SCM_GLOC_VAL_LOC):
Removed.

* debug.h, debug.c (scm_make_gloc, scm_gloc_p): Removed.

* dynwind.c (scm_swap_bindings): Likewise.
(scm_dowinds): Updated to recognize lists of variables instead of
lists of glocs.

* __scm.h (SCM_CAUTIOS, SCM_RECKLESS): Update comments.

libguile/__scm.h

@@ -100,11 +100,12 @@
 /* If the compile FLAG `SCM_CAUTIOUS' is #defined then the number of
  * arguments is always checked for application of closures.  If the
  * compile FLAG `SCM_RECKLESS' is #defined then they are not checked.
- * Otherwise, number of argument checks for closures are made only when
+ * Otherwise, number of argument checks for closures are made only
- * the function position (whose value is the closure) of a combination is
+ * when the function position (whose value is the closure) of a
- * not an ILOC or GLOC.  When the function position of a combination is a
+ * combination is not an ILOC or a variable (true?).  When the
- * symbol it will be checked only the first time it is evaluated because
+ * function position of a combination is a symbol it will be checked
- * it will then be replaced with an ILOC or GLOC.
+ * only the first time it is evaluated because it will then be
+ * replaced with an ILOC or variable.
  */
 #undef SCM_RECKLESS
 #define SCM_CAUTIOUS

libguile/debug.c

@@ -196,17 +196,6 @@ scm_make_memoized (SCM exp, SCM env)
  *     specified, the top-level environment of the current module will
  *     be assumed.  All environments must match.
  *
- * - procedure: make-gloc VARIABLE [ENV]
- *
- *     Return a gloc, encapsulated in a memoized object.
- *
- *     (Glocs can't exist in normal list structures, since they will
- *     be mistaken for structs.)
- *
- * - procedure: gloc? OBJECT
- *
- *     Return #t if OBJECT is a memoized gloc.
- *
  * - procedure: make-iloc FRAME BINDING CDRP
  *
  *     Return an iloc referring to frame no. FRAME, binding
@@ -252,32 +241,6 @@ scm_make_memoized (SCM exp, SCM env)
 #include "libguile/variable.h"
 #include "libguile/procs.h"
 
-SCM_DEFINE (scm_make_gloc, "make-gloc", 1, 1, 0, 
-            (SCM var, SCM env),
-	    "Create a gloc for variable @var{var} in the environment\n"
-	    "@var{env}.")
-#define FUNC_NAME s_scm_make_gloc
-{
-  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_PACK (SCM_UNPACK (var) + scm_tc3_cons_gloc), env);
-}
-#undef FUNC_NAME
-
-SCM_DEFINE (scm_gloc_p, "gloc?", 1, 0, 0, 
-            (SCM obj),
-	    "Return @code{#t} if @var{obj} is a gloc.")
-#define FUNC_NAME s_scm_gloc_p
-{
-  return
-    SCM_BOOL (SCM_MEMOIZEDP (obj) 
-	      && ((SCM_UNPACK(SCM_MEMOIZED_EXP(obj))&7) == scm_tc3_cons_gloc));
-}
-#undef FUNC_NAME
-
 SCM_DEFINE (scm_make_iloc, "make-iloc", 3, 0, 0,
             (SCM frame, SCM binding, SCM cdrp),
 	    "Return a new iloc with frame offset @var{frame}, binding\n"
@@ -538,8 +501,8 @@ scm_m_start_stack (SCM exp, SCM env)
 #define FUNC_NAME s_start_stack
 {
   exp = SCM_CDR (exp);
-  if (!SCM_ECONSP (exp) 
+  if (!SCM_CONSP (exp) 
-      || !SCM_ECONSP (SCM_CDR (exp))
+      || !SCM_CONSP (SCM_CDR (exp))
       || !SCM_NULLP (SCM_CDDR (exp)))
     SCM_WRONG_NUM_ARGS ();
   return scm_start_stack (scm_eval_car (exp, env), SCM_CADR (exp), env);

libguile/debug.h

@@ -209,8 +209,6 @@ extern SCM scm_make_debugobj (scm_t_debug_frame *debug);
 extern void scm_init_debug (void);
 
 #ifdef GUILE_DEBUG
-extern SCM scm_make_gloc (SCM var, SCM env);
-extern SCM scm_gloc_p (SCM obj);
 extern SCM scm_make_iloc (SCM frame, SCM binding, SCM cdrp);
 extern SCM scm_iloc_p (SCM obj);
 extern SCM scm_memcons (SCM car, SCM cdr, SCM env);

libguile/dynwind.c

@@ -185,15 +185,15 @@ SCM_DEFINE (scm_wind_chain, "wind-chain", 0, 0, 0,
 #endif
 
 static void
-scm_swap_bindings (SCM glocs, SCM vals)
+scm_swap_bindings (SCM vars, SCM vals)
 {
   SCM tmp;
   while (SCM_NIMP (vals))
     {
-      tmp = SCM_GLOC_VAL (SCM_CAR (glocs));
+      tmp = SCM_VARIABLE_REF (SCM_CAR (vars));
-      SCM_GLOC_SET_VAL (SCM_CAR (glocs), SCM_CAR (vals));
+      SCM_VARIABLE_SET (SCM_CAR (vars), SCM_CAR (vals));
       SCM_SETCAR (vals, tmp);
-      glocs = SCM_CDR (glocs);
+      vars = SCM_CDR (vars);
       vals = SCM_CDR (vals);
     }
 }
@@ -219,13 +219,16 @@ scm_dowinds (SCM to, long delta)
 #endif
 	{
 	  wind_key = SCM_CAR (wind_elt);
-	  /* key = #t | symbol | thunk | list of glocs | list of fluids */
+	  /* key = #t | symbol | thunk | list of variables | list of fluids */
 	  if (SCM_NIMP (wind_key))
 	    {
-	      if (SCM_TYP3 (wind_key) == scm_tc3_cons_gloc)
+	      if (SCM_CONSP (wind_key))
-		scm_swap_bindings (wind_key, SCM_CDR (wind_elt));
+		{
-	      else if (SCM_TYP3 (wind_key) == scm_tc3_cons)
+		  if (SCM_VARIABLEP (SCM_CAR (wind_key)))
-		scm_swap_fluids (wind_key, SCM_CDR (wind_elt));
+		    scm_swap_bindings (wind_key, SCM_CDR (wind_elt));
+		  else if (SCM_FLUIDP (SCM_CAR (wind_key)))
+		    scm_swap_fluids (wind_key, SCM_CDR (wind_elt));
+		}
 	      else if (SCM_GUARDSP (wind_key))
 		SCM_BEFORE_GUARD (wind_key) (SCM_GUARD_DATA (wind_key));
 	      else if (SCM_TYP3 (wind_key) == scm_tc3_closure)
@@ -254,10 +257,13 @@ scm_dowinds (SCM to, long delta)
 	  wind_key = SCM_CAR (wind_elt);
 	  if (SCM_NIMP (wind_key))
 	    {
-	      if (SCM_TYP3 (wind_key) == scm_tc3_cons_gloc)
+	      if (SCM_CONSP (wind_key))
-		scm_swap_bindings (wind_key, from);
+		{
-	      else if (SCM_TYP3 (wind_key) == scm_tc3_cons)
+		  if (SCM_VARIABLEP (SCM_CAR (wind_key)))
-		scm_swap_fluids_reverse (wind_key, from);
+		    scm_swap_bindings (wind_key, SCM_CDR (wind_elt));
+		  else if (SCM_FLUIDP (SCM_CAR (wind_key)))
+		    scm_swap_fluids_reverse (wind_key, SCM_CDR (wind_elt));
+		}
 	      else if (SCM_GUARDSP (wind_key))
 		SCM_AFTER_GUARD (wind_key) (SCM_GUARD_DATA (wind_key));
 	      else if (SCM_TYP3 (wind_key) == scm_tc3_closure)

libguile/eval.c

@@ -156,10 +156,8 @@ char *alloca ();
 			     : SCM_CEVAL (SCM_CAR (x), env))
 
 #define EVALCAR(x, env) (!SCM_CELLP (SCM_CAR (x)) \
-			? (SCM_IMP (SCM_CAR (x)) \
+			 ? SCM_EVALIM (SCM_CAR (x), env) \
-			   ? SCM_EVALIM (SCM_CAR (x), env) \
+			 : EVALCELLCAR (x, env))
-			   : SCM_GLOC_VAL (SCM_CAR (x))) \
-			: EVALCELLCAR (x, env))
 
 #define EXTEND_ENV SCM_EXTEND_ENV
 
@@ -197,7 +195,7 @@ scm_ilookup (SCM iloc, SCM env)
    tree-code instructions.
 
    There shouldn't normally be a problem with memoizing local and
-   global variable references (into ilocs and glocs), because all
+   global variable references (into ilocs and variables), because all
    threads will mutate the code in *exactly* the same way and (if I
    read the C code correctly) it is not possible to observe a half-way
    mutated cons cell.  The lookup procedure can handle this
@@ -205,11 +203,11 @@ scm_ilookup (SCM iloc, SCM env)
 
    It is different with macro expansion, because macro expansion
    happens outside of the lookup procedure and can't be
-   undone. Therefore it can't cope with it.  It has to indicate
+   undone. Therefore the lookup procedure can't cope with it.  It has
-   failure when it detects a lost race and hope that the caller can
+   to indicate failure when it detects a lost race and hope that the
-   handle it.  Luckily, it turns out that this is the case.
+   caller can handle it.  Luckily, it turns out that this is the case.
 
-   An example to illustrate this: Suppose that the follwing form will
+   An example to illustrate this: Suppose that the following form will
    be memoized concurrently by two threads
 
        (let ((x 12)) x)
@@ -226,13 +224,13 @@ scm_ilookup (SCM iloc, SCM env)
    But let's see what will happen when the race occurs while looking
    up the symbol "let" at the start of the form.  It could happen that
    the second thread interrupts the lookup of the first thread and not
-   only substitutes a gloc for it but goes right ahead and replaces it
+   only substitutes a variable for it but goes right ahead and
-   with the compiled form (#@let* (x 12) x).  Now, when the first
+   replaces it with the compiled form (#@let* (x 12) x).  Now, when
-   thread completes its lookup, it would replace the #@let* with a
+   the first thread completes its lookup, it would replace the #@let*
-   gloc pointing to the "let" binding, effectively reverting the form
+   with a variable containing the "let" binding, effectively reverting
-   to (let (x 12) x).  This is wrong.  It has to detect that it has
+   the form to (let (x 12) x).  This is wrong.  It has to detect that
-   lost the race and the evaluator has to reconsider the changed form
+   it has lost the race and the evaluator has to reconsider the
-   completely.
+   changed form completely.
 
    This race condition could be resolved with some kind of traffic
    light (like mutexes) around scm_lookupcar, but I think that it is
@@ -370,15 +368,13 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
 	   completely. */
       race:
 	var = SCM_CAR (vloc);
-	if (SCM_ITAG3 (var) == scm_tc3_cons_gloc)
-	  return SCM_GLOC_VAL_LOC (var);
 	if (SCM_VARIABLEP (var))
 	  return SCM_VARIABLE_LOC (var);
 #ifdef MEMOIZE_LOCALS
 	if (SCM_ITAG7 (var) == SCM_ITAG7 (SCM_ILOC00))
 	  return scm_ilookup (var, genv);
 #endif
-	/* We can't cope with anything else than glocs and ilocs.  When
+	/* We can't cope with anything else than variables and ilocs.  When
 	   a special form has been memoized (i.e. `let' into `#@let') we
 	   return NULL and expect the calling function to do the right
 	   thing.  For the evaluator, this means going back and redoing
@@ -415,15 +411,7 @@ scm_unmemocar (SCM form, SCM env)
   if (SCM_IMP (form))
     return form;
   c = SCM_CAR (form);
-  if (SCM_ITAG3 (c) == scm_tc3_cons_gloc)
+  if (SCM_VARIABLEP (c))
-    {
-      SCM sym =
-	scm_module_reverse_lookup (scm_env_module (env), SCM_GLOC_VAR (c));
-      if (SCM_EQ_P (sym, SCM_BOOL_F))
-	sym = sym_three_question_marks;
-      SCM_SETCAR (form, sym);
-    }
-  else if (SCM_VARIABLEP (c))
     {
       SCM sym =
 	scm_module_reverse_lookup (scm_env_module (env), c);
@@ -839,7 +827,7 @@ iqq (SCM form, SCM env, long depth)
       --depth;
     label:
       form = SCM_CDR (form);
-      SCM_ASSERT (SCM_ECONSP (form) && SCM_NULLP (SCM_CDR (form)),
+      SCM_ASSERT (SCM_CONSP (form) && SCM_NULLP (SCM_CDR (form)),
                   form, SCM_ARG1, s_quasiquote);
       if (0 == depth)
 	return evalcar (form, env);
@@ -1120,7 +1108,7 @@ scm_m_atfop (SCM xorig, SCM env SCM_UNUSED)
   var = scm_symbol_fref (SCM_CAR (x));
   SCM_ASSYNT (SCM_VARIABLEP (var),
 	      "Symbol's function definition is void", NULL);
-  SCM_SET_CELL_WORD_0 (x, SCM_UNPACK (var) + scm_tc3_cons_gloc);
+  SCM_SETCAR (x, var);
   return x;
 }
 
@@ -1146,7 +1134,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_sym2var (SCM_CAR (x), env, SCM_BOOL_T)) + scm_tc3_cons_gloc);
+      SCM_SETCAR (x, scm_sym2var (SCM_CAR (x), env, SCM_BOOL_T));
       x = SCM_CDR (x);
     }
   return scm_cons (SCM_IM_BIND, SCM_CDR (xorig));
@@ -1291,7 +1279,7 @@ unmemocopy (SCM x, SCM env)
 #ifdef DEBUG_EXTENSIONS
   SCM p;
 #endif
-  if (SCM_NCELLP (x) || SCM_NECONSP (x))
+  if (SCM_NCELLP (x) || SCM_NCONSP (x))
     return x;
 #ifdef DEBUG_EXTENSIONS
   p = scm_whash_lookup (scm_source_whash, x);
@@ -1459,7 +1447,7 @@ unmemocopy (SCM x, SCM env)
 			  env);
     }
 loop:
-  while (SCM_CELLP (x = SCM_CDR (x)) && SCM_ECONSP (x))
+  while (SCM_CELLP (x = SCM_CDR (x)) && SCM_CONSP (x))
     {
       if (SCM_ISYMP (SCM_CAR (x)))
 	/* skip body markers */
@@ -1528,40 +1516,17 @@ SCM
 scm_eval_args (SCM l, SCM env, SCM proc)
 {
   SCM results = SCM_EOL, *lloc = &results, res;
-  while (!SCM_IMP (l))
+  while (SCM_CONSP (l))
     {
-#ifdef SCM_CAUTIOUS
-      if (SCM_CONSP (l))
-	{
-	  if (SCM_IMP (SCM_CAR (l)))
-	    res = SCM_EVALIM (SCM_CAR (l), env);
-	  else
-	    res = EVALCELLCAR (l, env);
-	}
-      else if (SCM_TYP3 (l) == scm_tc3_cons_gloc)
-	{
-	  scm_t_bits vcell =
-	    SCM_STRUCT_VTABLE_DATA (l) [scm_vtable_index_vcell];
-	  if (vcell == 0)
-	    res = SCM_CAR (l); /* struct planted in code */
-	  else
-	    res = SCM_GLOC_VAL (SCM_CAR (l));
-	}
-      else
-	goto wrongnumargs;
-#else
       res = EVALCAR (l, env);
-#endif
+
       *lloc = scm_cons (res, SCM_EOL);
       lloc = SCM_CDRLOC (*lloc);
       l = SCM_CDR (l);
     }
 #ifdef SCM_CAUTIOUS
   if (!SCM_NULLP (l))
-    {
+    scm_wrong_num_args (proc);
-    wrongnumargs:
-      scm_wrong_num_args (proc);
-    }
 #endif
   return results;
 }
@@ -1758,40 +1723,17 @@ SCM
 scm_deval_args (SCM l, SCM env, SCM proc, SCM *lloc)
 {
   SCM *results = lloc, res;
-  while (!SCM_IMP (l))
+  while (SCM_CONSP (l))
     {
-#ifdef SCM_CAUTIOUS
-      if (SCM_CONSP (l))
-	{
-	  if (SCM_IMP (SCM_CAR (l)))
-	    res = SCM_EVALIM (SCM_CAR (l), env);
-	  else
-	    res = EVALCELLCAR (l, env);
-	}
-      else if (SCM_TYP3 (l) == scm_tc3_cons_gloc)
-	{
-	  scm_t_bits vcell =
-	    SCM_STRUCT_VTABLE_DATA (l) [scm_vtable_index_vcell];
-	  if (vcell == 0)
-	    res = SCM_CAR (l); /* struct planted in code */
-	  else
-	    res = SCM_GLOC_VAL (SCM_CAR (l));
-	}
-      else
-	goto wrongnumargs;
-#else
       res = EVALCAR (l, env);
-#endif
+
       *lloc = scm_cons (res, SCM_EOL);
       lloc = SCM_CDRLOC (*lloc);
       l = SCM_CDR (l);
     }
 #ifdef SCM_CAUTIOUS
   if (!SCM_NULLP (l))
-    {
+    scm_wrong_num_args (proc);
-    wrongnumargs:
-      scm_wrong_num_args (proc);
-    }
 #endif
   return *results;
 }
@@ -2014,7 +1956,7 @@ dispatch:
       if (!SCM_CELLP (SCM_CAR (x)))
 	{
 	  x = SCM_CAR (x);
-	  RETURN (SCM_IMP (x) ? SCM_EVALIM (x, env) : SCM_GLOC_VAL (x))
+	  RETURN (SCM_EVALIM (x, env))
 	}
 
       if (SCM_SYMBOLP (SCM_CAR (x)))
@@ -2208,9 +2150,6 @@ dispatch:
 	  else
 	    t.lloc = scm_lookupcar (x, env, 1);
 	  break;
-	case scm_tc3_cons_gloc:
-	  t.lloc = SCM_GLOC_VAL_LOC (proc);
-	  break;
 #ifdef MEMOIZE_LOCALS
 	case scm_tc3_imm24:
 	  t.lloc = scm_ilookup (proc, env);
@@ -2309,8 +2248,8 @@ dispatch:
 	    arg2 = *scm_ilookup (proc, env);
 	  else if (SCM_NCONSP (proc))
 	    {
-	      if (SCM_NCELLP (proc))
+	      if (SCM_VARIABLEP (proc))
-		arg2 = SCM_GLOC_VAL (proc);
+		arg2 = SCM_VARIABLE_REF (proc);
 	      else
 		arg2 = *scm_lookupcar (SCM_CDR (x), env, 1);
 	    }
@@ -2477,9 +2416,8 @@ dispatch:
 	  arg2 = SCM_CDAR (env);
 	  while (SCM_NIMP (arg2))
 	    {
-	      proc = SCM_GLOC_VAL (SCM_CAR (t.arg1));
+	      proc = SCM_VARIABLE_REF (SCM_CAR (t.arg1));
-	      SCM_SETCDR (SCM_PACK (SCM_UNPACK (SCM_CAR (t.arg1)) - 1L),
+	      SCM_VARIABLE_SET (SCM_CAR (t.arg1), SCM_CAR (arg2));
-			  SCM_CAR (arg2));
 	      SCM_SETCAR (arg2, proc);
 	      t.arg1 = SCM_CDR (t.arg1);
 	      arg2 = SCM_CDR (arg2);
@@ -2499,8 +2437,7 @@ dispatch:
 	  arg2 = SCM_CDAR (env);
 	  while (SCM_NIMP (arg2))
 	    {
-	      SCM_SETCDR (SCM_PACK (SCM_UNPACK (SCM_CAR (t.arg1)) - 1L),
+	      SCM_VARIABLE_SET (SCM_CAR (t.arg1), SCM_CAR (arg2));
-			  SCM_CAR (arg2));
 	      t.arg1 = SCM_CDR (t.arg1);
 	      arg2 = SCM_CDR (arg2);
 	    }
@@ -2557,6 +2494,7 @@ dispatch:
     case scm_tc7_cclo:
     case scm_tc7_pws:
     case scm_tcs_subrs:
+    case scm_tcs_struct:
       RETURN (x);
 
     case scm_tc7_variable:
@@ -2573,25 +2511,7 @@ dispatch:
 #endif
       break;
 #endif /* ifdef MEMOIZE_LOCALS */
-
       
-    case scm_tcs_cons_gloc: {
-      scm_t_bits vcell = SCM_STRUCT_VTABLE_DATA (x) [scm_vtable_index_vcell];
-      if (vcell == 0) {
-	/* This is a struct implanted in the code, not a gloc. */
-	RETURN (x);
-      } else {
-	proc = SCM_GLOC_VAL (SCM_CAR (x));
-	SCM_ASRTGO (SCM_NIMP (proc), badfun);
-#ifndef SCM_RECKLESS
-#ifdef SCM_CAUTIOUS
-	goto checkargs;
-#endif
-#endif
-      }
-      break;
-    }
-
     case scm_tcs_cons_nimcar:
       orig_sym = SCM_CAR (x);
       if (SCM_SYMBOLP (orig_sym))
@@ -2733,7 +2653,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: /* really structs, not glocs */
+      case scm_tcs_struct:
 	if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
 	  {
 	    x = SCM_ENTITY_PROCEDURE (proc);
@@ -2786,14 +2706,6 @@ evapply:
       else
 	t.arg1 = EVALCELLCAR (x, env);
     }
-  else if (SCM_TYP3 (x) == scm_tc3_cons_gloc)
-    {
-      scm_t_bits vcell = SCM_STRUCT_VTABLE_DATA (x) [scm_vtable_index_vcell];
-      if (vcell == 0)
-	t.arg1 = SCM_CAR (x); /* struct planted in code */
-      else
-	t.arg1 = SCM_GLOC_VAL (SCM_CAR (x));
-    }
   else
     goto wrongnumargs;
 #else
@@ -2888,7 +2800,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: /* really structs, not glocs */
+	case scm_tcs_struct:
 	  if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
 	    {
 	      x = SCM_ENTITY_PROCEDURE (proc);
@@ -2936,14 +2848,6 @@ evapply:
       else
 	arg2 = EVALCELLCAR (x, env);
     }
-  else if (SCM_TYP3 (x) == scm_tc3_cons_gloc)
-    {
-      scm_t_bits vcell = SCM_STRUCT_VTABLE_DATA (x) [scm_vtable_index_vcell];
-      if (vcell == 0)
-	arg2 = SCM_CAR (x); /* struct planted in code */
-      else
-	arg2 = SCM_GLOC_VAL (SCM_CAR (x));
-    }
   else
     goto wrongnumargs;
 #else
@@ -2992,7 +2896,7 @@ evapply:
 								 proc))),
 			     SCM_EOL));
 #endif
-	case scm_tcs_cons_gloc: /* really structs, not glocs */
+	case scm_tcs_struct:
 	  if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
 	    {
 	      x = SCM_ENTITY_PROCEDURE (proc);
@@ -3058,7 +2962,7 @@ evapply:
 	}
     }
 #ifdef SCM_CAUTIOUS
-    if (SCM_IMP (x) || SCM_NECONSP (x))
+    if (SCM_IMP (x) || SCM_NCONSP (x))
       goto wrongnumargs;
 #endif
 #ifdef DEVAL
@@ -3206,7 +3110,7 @@ evapply:
 	x = SCM_CODE (proc);
 	goto nontoplevel_cdrxbegin;
 #endif /* DEVAL */
-      case scm_tcs_cons_gloc: /* really structs, not glocs */
+      case scm_tcs_struct:
 	if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
 	  {
 #ifdef DEVAL
@@ -3649,7 +3553,7 @@ tail:
       debug.vect[0].a.proc = proc;
 #endif
       goto tail;
-    case scm_tcs_cons_gloc: /* really structs, not glocs */
+    case scm_tcs_struct:
       if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
 	{
 #ifdef DEVAL

libguile/eval.h

@@ -115,9 +115,7 @@ extern SCM scm_eval_options_interface (SCM setting);
 			   ? SCM_EVALIM2(x) \
 			   : (*scm_ceval_ptr) ((x), (env)))
 #define SCM_XEVALCAR(x, env) (SCM_NCELLP (SCM_CAR (x)) \
-			      ? (SCM_IMP (SCM_CAR (x)) \
+			      ? SCM_EVALIM (SCM_CAR (x), env) \
-				 ? SCM_EVALIM (SCM_CAR (x), env) \
-				 : SCM_GLOC_VAL (SCM_CAR (x))) \
 			      : (SCM_SYMBOLP (SCM_CAR (x)) \
 			         ? *scm_lookupcar (x, env, 1) \
 			         : (*scm_ceval_ptr) (SCM_CAR (x), env)))
@@ -182,16 +180,6 @@ 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 variable with a 
- * tag of 1.  This is called a "gloc".
- */
-
-#define SCM_GLOC_VAR(x)        (SCM_PACK(SCM_UNPACK(x)-scm_tc3_cons_gloc))
-#define SCM_GLOC_VAL(x)        (SCM_VARIABLE_REF (SCM_GLOC_VAR (x)))
-#define SCM_GLOC_SET_VAL(x, y) (SCM_VARIABLE_SET (SCM_GLOC_VAR (x), y))
-#define SCM_GLOC_VAL_LOC(x)    (SCM_VARIABLE_LOC (SCM_GLOC_VAR (x)))
-
 
 
 extern SCM * scm_ilookup (SCM iloc, SCM env);

libguile/gc.c

@@ -1257,63 +1257,40 @@ gc_mark_loop_first_time:
       RECURSE (SCM_SETTER (ptr));
       ptr = SCM_PROCEDURE (ptr);
       goto_gc_mark_loop;
-    case scm_tcs_cons_gloc:
+    case scm_tcs_struct:
       {
-	/* Dirk:FIXME:: The following code is super ugly: ptr may be a
+	/* XXX - use less explicit code. */
-	 * struct or a gloc.  If it is a gloc, the cell word #0 of ptr
+	scm_t_bits word0 = SCM_CELL_WORD_0 (ptr) - scm_tc3_struct;
-	 * is the address of a scm_tc16_variable smob.  If it is a
+	scm_t_bits * vtable_data = (scm_t_bits *) word0;
-	 * struct, the cell word #0 of ptr is a pointer to a struct
+	SCM layout = SCM_PACK (vtable_data [scm_vtable_index_layout]);
-	 * vtable data region. (The fact that these are accessed in
+	long len = SCM_SYMBOL_LENGTH (layout);
-	 * the same way restricts the possibilites to change the data
+	char * fields_desc = SCM_SYMBOL_CHARS (layout);
-	 * layout of structs or heap cells.)  To discriminate between
+	scm_t_bits * struct_data = (scm_t_bits *) SCM_STRUCT_DATA (ptr);
-	 * the two, it is guaranteed that the scm_vtable_index_vcell
+
-	 * element of the prospective vtable is always zero.  For a
+	if (vtable_data[scm_struct_i_flags] & SCM_STRUCTF_ENTITY)
-	 * gloc, this location has the CDR of the variable smob, which
-	 * is guaranteed to be non-zero.
-	 */
-	scm_t_bits word0 = SCM_CELL_WORD_0 (ptr) - scm_tc3_cons_gloc;
-	scm_t_bits * vtable_data = (scm_t_bits *) word0; /* access as struct */
-	if (vtable_data [scm_vtable_index_vcell] != 0)
 	  {
-            /* ptr is a gloc */
+	    RECURSE (SCM_PACK (struct_data[scm_struct_i_procedure]));
-            SCM gloc_car = SCM_PACK (word0);
+	    RECURSE (SCM_PACK (struct_data[scm_struct_i_setter]));
-            RECURSE (gloc_car);
-            ptr = SCM_CDR (ptr);
-            goto gc_mark_loop;
-          }
-        else
-          {
-            /* ptr is a struct */
-            SCM layout = SCM_PACK (vtable_data [scm_vtable_index_layout]);
-            long len = SCM_SYMBOL_LENGTH (layout);
-            char * fields_desc = SCM_SYMBOL_CHARS (layout);
-            scm_t_bits * struct_data = (scm_t_bits *) SCM_STRUCT_DATA (ptr);
-
-            if (vtable_data[scm_struct_i_flags] & SCM_STRUCTF_ENTITY)
-              {
-                RECURSE (SCM_PACK (struct_data[scm_struct_i_procedure]));
-                RECURSE (SCM_PACK (struct_data[scm_struct_i_setter]));
-              }
-            if (len)
-              {
-                long x;
-
-                for (x = 0; x < len - 2; x += 2, ++struct_data)
-                  if (fields_desc[x] == 'p')
-                    RECURSE (SCM_PACK (*struct_data));
-                if (fields_desc[x] == 'p')
-                  {
-                    if (SCM_LAYOUT_TAILP (fields_desc[x + 1]))
-                      for (x = *struct_data++; x; --x, ++struct_data)
-                        RECURSE (SCM_PACK (*struct_data));
-                    else
-                      RECURSE (SCM_PACK (*struct_data));
-                  }
-              }
-            /* mark vtable */
-            ptr = SCM_PACK (vtable_data [scm_vtable_index_vtable]);
-            goto_gc_mark_loop;
 	  }
+	if (len)
+	  {
+	    long x;
+	    
+	    for (x = 0; x < len - 2; x += 2, ++struct_data)
+	      if (fields_desc[x] == 'p')
+		RECURSE (SCM_PACK (*struct_data));
+	    if (fields_desc[x] == 'p')
+	      {
+		if (SCM_LAYOUT_TAILP (fields_desc[x + 1]))
+		  for (x = *struct_data++; x; --x, ++struct_data)
+		    RECURSE (SCM_PACK (*struct_data));
+		else
+		  RECURSE (SCM_PACK (*struct_data));
+	      }
+	  }
+	/* mark vtable */
+	ptr = SCM_PACK (vtable_data [scm_vtable_index_vtable]);
+	goto_gc_mark_loop;
       }
       break;
     case scm_tcs_closures:
@@ -1748,28 +1725,15 @@ scm_gc_sweep ()
 
 	  switch SCM_TYP7 (scmptr)
             {
-	    case scm_tcs_cons_gloc:
+	    case scm_tcs_struct:
 	      {
-		/* Dirk:FIXME:: Again, super ugly code:  scmptr may be a
+		/* Structs need to be freed in a special order.
-		 * struct or a gloc.  See the corresponding comment in
+		 * This is handled by GC C hooks in struct.c.
-		 * scm_gc_mark.
 		 */
-		scm_t_bits word0 = (SCM_CELL_WORD_0 (scmptr)
+		SCM_SET_STRUCT_GC_CHAIN (scmptr, scm_structs_to_free);
-				    - scm_tc3_cons_gloc);
+		scm_structs_to_free = scmptr;
-		/* access as struct */
-		scm_t_bits * vtable_data = (scm_t_bits *) word0;
-		if (vtable_data[scm_vtable_index_vcell] == 0)
-		  {
-		    /* Structs need to be freed in a special order.
-		     * This is handled by GC C hooks in struct.c.
-		     */
-		    SCM_SET_STRUCT_GC_CHAIN (scmptr, scm_structs_to_free);
-		    scm_structs_to_free = scmptr;
-                    continue;
-		  }
-		/* fall through so that scmptr gets collected */
 	      }
-	      break;
+	      continue;
 	    case scm_tcs_cons_imcar:
 	    case scm_tcs_cons_nimcar:
 	    case scm_tcs_closures:

libguile/goops.c

@@ -1313,7 +1313,7 @@ wrap_init (SCM class, SCM *m, long n)
   SCM_SET_STRUCT_GC_CHAIN (z, 0);
   SCM_SET_CELL_WORD_1 (z, m);
   SCM_SET_CELL_WORD_0 (z, (scm_t_bits) SCM_STRUCT_DATA (class)
-		          | scm_tc3_cons_gloc);
+		          | scm_tc3_struct);
 
   return z;
 }
@@ -2594,7 +2594,7 @@ scm_wrap_object (SCM class, void *data)
   SCM_NEWCELL2 (z);
   SCM_SETCDR (z, SCM_PACK ((scm_t_bits) data));
   SCM_SET_STRUCT_GC_CHAIN (z, 0);
-  SCM_SETCAR (z, SCM_UNPACK (SCM_CDR (class)) | scm_tc3_cons_gloc);
+  SCM_SETCAR (z, SCM_UNPACK (SCM_CDR (class)) | scm_tc3_struct);
   return z;
 }
 

libguile/modules.c

@@ -627,7 +627,7 @@ scm_post_boot_init_modules ()
 #define PERM(x) scm_permanent_object(x)
 
   SCM module_type = SCM_VARIABLE_REF (scm_c_lookup ("module-type"));
-  scm_module_tag = (SCM_CELL_WORD_1 (module_type) + scm_tc3_cons_gloc);
+  scm_module_tag = (SCM_CELL_WORD_1 (module_type) + scm_tc3_struct);
 
   resolve_module_var = PERM (scm_c_lookup ("resolve-module"));
   process_define_module_var = PERM (scm_c_lookup ("process-define-module"));

libguile/objects.c

@@ -168,8 +168,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
 				    ? SCM_INOUT_PCLASS_INDEX | SCM_PTOBNUM (x)
 				    : SCM_OUT_PCLASS_INDEX | SCM_PTOBNUM (x))
 				 : SCM_IN_PCLASS_INDEX | SCM_PTOBNUM (x))];
-	case scm_tcs_cons_gloc:
+	case scm_tcs_struct:
-	  /* must be a struct */
 	  if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS_VALID)
 	    return SCM_CLASS_OF (x);
 	  else if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS)
@@ -204,7 +203,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
 	    return scm_class_unknown;
 	}
 
-    case scm_tc3_cons_gloc:
+    case scm_tc3_struct:
     case scm_tc3_tc7_1:
     case scm_tc3_tc7_2:
     case scm_tc3_closure:

libguile/print.c

@@ -397,7 +397,6 @@ SCM_GPROC(s_display, "display", 1, 1, 0, scm_display, g_display);
 void 
 scm_iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 {
-taloop:
   switch (SCM_ITAG3 (exp))
     {
     case scm_tc3_closure:
@@ -451,39 +450,30 @@ taloop:
 	  scm_ipruk ("immediate", exp, port);
 	}
       break;
-    case scm_tc3_cons_gloc:
-      /* gloc */
-      scm_puts ("#@", port);
-      exp = scm_module_reverse_lookup (scm_current_module (),
-				       SCM_GLOC_VAR (exp));
-      goto taloop;
     case scm_tc3_cons:
       switch (SCM_TYP7 (exp))
 	{
-	case scm_tcs_cons_gloc:
+	case scm_tcs_struct:
-
+	  {
-	  if (SCM_STRUCT_VTABLE_DATA (exp) [scm_vtable_index_vcell] == 0)
+	    ENTER_NESTED_DATA (pstate, exp, circref);
-	    {
+	    if (SCM_OBJ_CLASS_FLAGS (exp) & SCM_CLASSF_GOOPS)
-	      ENTER_NESTED_DATA (pstate, exp, circref);
+	      {
-	      if (SCM_OBJ_CLASS_FLAGS (exp) & SCM_CLASSF_GOOPS)
+		SCM pwps, print = pstate->writingp ? g_write : g_display;
-		{
+		if (!print)
-		  SCM pwps, print = pstate->writingp ? g_write : g_display;
+		  goto print_struct;
-		  if (!print)
+		SCM_NEWSMOB (pwps,
-		    goto print_struct;
+			     scm_tc16_port_with_ps,
-		  SCM_NEWSMOB (pwps,
+			     SCM_UNPACK (scm_cons (port, pstate->handle)));
-			       scm_tc16_port_with_ps,
+		scm_call_generic_2 (print, exp, pwps);
-			       SCM_UNPACK (scm_cons (port, pstate->handle)));
+	      }
-		  scm_call_generic_2 (print, exp, pwps);
+	    else
-		}
+	      {
-	      else
+	      print_struct:
-		{
+		scm_print_struct (exp, port, pstate);
-		print_struct:
+	      }
-		  scm_print_struct (exp, port, pstate);
+	    EXIT_NESTED_DATA (pstate);
-		}
+	  }
-	      EXIT_NESTED_DATA (pstate);
+	  break;
-	      break;
-	    }
-
 	case scm_tcs_cons_imcar:
 	case scm_tcs_cons_nimcar:
 	  ENTER_NESTED_DATA (pstate, exp, circref);
@@ -754,9 +744,7 @@ scm_ipruk (char *hdr, SCM ptr, SCM port)
 }
 
 
-/* Print a list.  The list may be either a list of ordinary data, or it may be
+/* Print a list.
-   a list that represents code.  Lists that represent code may contain gloc
-   cells.
  */
 void 
 scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate)
@@ -772,12 +760,12 @@ scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate)
      O(depth * N) instead of O(N^2). */
   hare = SCM_CDR (exp);
   tortoise = exp;
-  while (SCM_ECONSP (hare))
+  while (SCM_CONSP (hare))
     {
       if (SCM_EQ_P (hare, tortoise))
 	goto fancy_printing;
       hare = SCM_CDR (hare);
-      if (SCM_IMP (hare) || SCM_NECONSP (hare))
+      if (SCM_IMP (hare) || SCM_NCONSP (hare))
 	break;
       hare = SCM_CDR (hare);
       tortoise = SCM_CDR (tortoise);
@@ -785,7 +773,7 @@ scm_iprlist (char *hdr,SCM exp,int tlr,SCM port,scm_print_state *pstate)
   
   /* No cdr cycles intrinsic to this list */
   scm_iprin1 (SCM_CAR (exp), port, pstate);
-  for (exp = SCM_CDR (exp); SCM_ECONSP (exp); exp = SCM_CDR (exp))
+  for (exp = SCM_CDR (exp); SCM_CONSP (exp); exp = SCM_CDR (exp))
     {
       register long i;
 
@@ -814,7 +802,7 @@ fancy_printing:
     
     scm_iprin1 (SCM_CAR (exp), port, pstate);
     exp = SCM_CDR (exp); --n;
-    for (; SCM_ECONSP (exp); exp = SCM_CDR (exp))
+    for (; SCM_CONSP (exp); exp = SCM_CDR (exp))
       {
 	register unsigned long i;
 

libguile/procprop.c

@@ -137,7 +137,7 @@ scm_i_procedure_arity (SCM proc)
       if (!SCM_NULLP (proc))
 	r = 1;
       break;
-    case scm_tcs_cons_gloc:
+    case scm_tcs_struct:
       if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
 	{
 	  r = 1;

libguile/procs.c

@@ -198,7 +198,7 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
   if (SCM_NIMP (obj))
     switch (SCM_TYP7 (obj))
       {
-      case scm_tcs_cons_gloc:
+      case scm_tcs_struct:
 	if (!SCM_I_OPERATORP (obj))
 	  break;
       case scm_tcs_closures:

libguile/srcprop.c

@@ -218,7 +218,7 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0,
   if (SCM_MEMOIZEDP (obj))
     obj = SCM_MEMOIZED_EXP (obj);
 #ifndef SCM_RECKLESS
-  else if (SCM_NECONSP (obj))
+  else if (SCM_NCONSP (obj))
     SCM_WRONG_TYPE_ARG (1, obj);
 #endif
   p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL);

libguile/struct.c

@@ -402,8 +402,8 @@ scm_free_structs (void *dummy1 SCM_UNUSED,
 	    }
 	  else
 	    {
-	      scm_t_bits word0 = SCM_CELL_WORD_0 (obj) - scm_tc3_cons_gloc;
+	      /* XXX - use less explicit code. */
-	      /* access as struct */
+	      scm_t_bits word0 = SCM_CELL_WORD_0 (obj) - scm_tc3_struct;
 	      scm_t_bits * vtable_data = (scm_t_bits *) word0;
 	      scm_t_bits * data = SCM_STRUCT_DATA (obj);
 	      scm_t_struct_free free_struct_data
@@ -470,7 +470,8 @@ SCM_DEFINE (scm_make_struct, "make-struct", 2, 0, 1,
   SCM_SET_CELL_WORD_1 (handle, data);
   SCM_SET_STRUCT_GC_CHAIN (handle, 0);
   scm_struct_init (handle, layout, data, tail_elts, init);
-  SCM_SET_CELL_WORD_0 (handle, (scm_t_bits) SCM_STRUCT_DATA (vtable) + scm_tc3_cons_gloc);
+  SCM_SET_CELL_WORD_0 (handle,
+		       (scm_t_bits) SCM_STRUCT_DATA (vtable) + scm_tc3_struct);
   SCM_ALLOW_INTS;
   return handle;
 }
@@ -551,7 +552,7 @@ SCM_DEFINE (scm_make_vtable_vtable, "make-vtable-vtable", 2, 0, 1,
   SCM_SET_STRUCT_GC_CHAIN (handle, 0);
   data [scm_vtable_index_layout] = SCM_UNPACK (layout);
   scm_struct_init (handle, layout, data, tail_elts, scm_cons (layout, init));
-  SCM_SET_CELL_WORD_0 (handle, (scm_t_bits) data + scm_tc3_cons_gloc);
+  SCM_SET_CELL_WORD_0 (handle, (scm_t_bits) data + scm_tc3_struct);
   SCM_ALLOW_INTS;
   return handle;
 }

libguile/struct.h

@@ -63,7 +63,7 @@
 #define scm_struct_i_size	-1 /* Instance size */
 #define scm_struct_i_flags	-1 /* Upper 12 bits used as flags */
 #define scm_vtable_index_layout  0 /* A symbol describing the physical arrangement of this type. */
-#define scm_vtable_index_vcell   1 /* An opaque word, managed by the garbage collector.  */
+#define scm_vtable_index_vcell   1 /* XXX - remove this, it is unused. */
 #define scm_vtable_index_vtable  2 /* A pointer to the handle for this vtable. */
 #define scm_vtable_index_printer 3 /* A printer for this struct type. */
 #define scm_vtable_offset_user   4 /* Where do user fields start? */
@@ -75,10 +75,9 @@ typedef size_t (*scm_t_struct_free) (scm_t_bits * vtable, scm_t_bits * data);
 #define SCM_STRUCTF_LIGHT  (1L << 31) /* Light representation
 					 (no hidden words) */
 
-/* Dirk:FIXME:: the SCM_STRUCTP predicate is also fulfilled for glocs */
+#define SCM_STRUCTP(X)  		(SCM_NIMP(X) && (SCM_TYP3(X) == scm_tc3_struct))
-#define SCM_STRUCTP(X)  		(SCM_NIMP(X) && (SCM_TYP3(X) == scm_tc3_cons_gloc))
 #define SCM_STRUCT_DATA(X) 		((scm_t_bits *) SCM_CELL_WORD_1 (X))
-#define SCM_STRUCT_VTABLE_DATA(X)       ((scm_t_bits *) (SCM_CELL_WORD_0 (X) - scm_tc3_cons_gloc))
+#define SCM_STRUCT_VTABLE_DATA(X)       ((scm_t_bits *) (SCM_CELL_WORD_0 (X) - scm_tc3_struct))
 
 #define SCM_STRUCT_LAYOUT(X) 	        (SCM_PACK (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_layout]))
 #define SCM_SET_STRUCT_LAYOUT(X, v)     (SCM_STRUCT_VTABLE_DATA (X) [scm_vtable_index_layout] = SCM_UNPACK (v))

libguile/tags.h

@@ -117,20 +117,24 @@ typedef signed long scm_t_signed_bits;
  * only (i.e., programmers must keep track of any SCM variables they
  * create that don't contain ordinary scheme values).
  *
- * All immediates and non-immediates must have a 0 in bit 0.  Only
+ * All immediates and pointers to cells of non-immediates have a 0 in
- * non-object values can have a 1 in bit 0.  In some cases, bit 0 of a
+ * bit 0.  All non-immediates that are not pairs have a 1 in bit 0 of
- * word in the heap is used for the GC tag so during garbage
+ * the first word of their cell.  This is how pairs are distinguished
- * collection, that bit might be 1 even in an immediate or
+ * from other non-immediates; a pair can have a immediate in its car
- * non-immediate value.  In other cases, bit 0 of a word in the heap
+ * (thus a 0 in bit 0), or a pointer to the cell of a non-immediate
- * is used to tag a pointer to a GLOC (VM global variable address) or
+ * (again, this pointer has a 0 in bit 0).
- * the header of a struct.  But whenever an SCM variable holds a
- * normal Scheme value, bit 0 is 0.
  *
- * Immediates and non-immediates are distinguished by bits two and four.
+ * Immediates and non-immediates are distinguished by bits 1 and 2.
- * Immediate values must have a 1 in at least one of those bits.  Does
+ * Immediate values must have a 1 in at least one of those bits.
- * this (or any other detail of tagging) seem arbitrary?  Try changing it!
+ * Consequently, a pointer to a cell of a non-immediate must have
- * (Not always impossible but it is fair to say that many details of tags
+ * zeros in bits 1 and 2.  Together with the requirement from above
- * are mutually dependent).  */
+ * that bit 0 must also be zero, this means that pointers to cells of
+ * non-immediates must have their three low bits all zero.  This in
+ * turn means that cells must be aligned on a 8 byte boundary, which
+ * is just right for two 32bit numbers (surprise, surprise).  Does
+ * this (or any other detail of tagging) seem arbitrary?  Try changing
+ * it!  (Not always impossible but it is fair to say that many details
+ * of tags are mutually dependent).  */
 
 #define SCM_IMP(x) 		(6 & SCM_UNPACK (x))
 #define SCM_NIMP(x) 		(!SCM_IMP (x))
@@ -142,17 +146,17 @@ typedef signed long scm_t_signed_bits;
  *
  *
  * 0		Most objects except...
- * 1 		...glocs and structs (this tag valid only in a SCM_CAR or
+ * 1 		... structs (this tag is valid only in the header
- *		in the header of a struct's data).
+ *              of a struct's data, as with all odd tags).
  *
  * 00		heap addresses and many immediates (not integers)
- * 01		glocs/structs, some tc7_ codes
+ * 01		structs, some tc7_ codes
  * 10		immediate integers
  * 11		various tc7_ codes including, tc16_ codes.
  *
  *
  * 000		heap address
- * 001		glocs/structs
+ * 001		structs
  * 010		integer
  * 011		closure
  * 100		immediates
@@ -191,33 +195,35 @@ typedef signed long scm_t_signed_bits;
  * with the 13 immediates above being some of the most interesting.
  *
  * Also noteworthy are the groups of 16 7-bit instructions implied by
- * some of the 3-bit tags.   For example, closure references consist
+ * some of the 3-bit tags.  For example, closure references consist of
- * of an 8-bit aligned address tagged with 011.  There are 16 identical 7-bit
+ * an 8-byte aligned address tagged with 011.  There are 16 identical
- * instructions, all ending 011, which are invoked by evaluating closures.
+ * 7-bit instructions, all ending 011, which are invoked by evaluating
+ * closures.
  *
  * In other words, if you hand the evaluator a closure, the evaluator
- * treats the closure as a graph of virtual machine instructions.
+ * treats the closure as a graph of virtual machine instructions.  A
- * A closure is a pair with a pointer to the body of the procedure
+ * closure is a pair with a pointer to the body of the procedure in
- * in the CDR and a pointer to the environment of the closure in the CAR.
+ * the CDR and a pointer to the environment of the closure in the CAR.
  * The environment pointer is tagged 011 which implies that the least
- * significant 7 bits of the environment pointer also happen to be
+ * significant 7 bits of the environment pointer also happen to be a
- * a virtual machine instruction we could call "SELF" (for self-evaluating
+ * virtual machine instruction we could call "SELF" (for
- * object).
+ * self-evaluating object).
  *
- * A less trivial example are the 16 instructions ending 000.  If those
+ * A less trivial example are the 16 instructions ending 000.  If
- * bits tag the CAR of a pair, then evidently the pair is an ordinary
+ * those bits tag the CAR of a pair, then evidently the pair is an
- * cons pair and should be evaluated as a procedure application.  The sixteen,
+ * ordinary cons pair and should be evaluated as a procedure
- * 7-bit 000 instructions are all "NORMAL-APPLY"  (Things get trickier.
+ * application.  The sixteen, 7-bit 000 instructions are all
- * For example, if the CAR of a procedure application is a symbol, the NORMAL-APPLY
+ * "NORMAL-APPLY" (Things get trickier.  For example, if the CAR of a
- * instruction will, as a side effect, overwrite that CAR with a new instruction
+ * procedure application is a symbol, the NORMAL-APPLY instruction
- * that contains a cached address for the variable named by the symbol.)
+ * will, as a side effect, overwrite that CAR with a new instruction
+ * that contains a cached address for the variable named by the
+ * symbol.)
  *
  * Here is a summary of tags in the CAR of a non-immediate:
  *
  *   HEAP CELL:	G=gc_mark; 1 during mark, 0 other times.
  *
  * cons	   ..........SCM car..............0  ...........SCM cdr.............G
- * gloc    ..........SCM vcell..........001  ...........SCM cdr.............G
  * struct  ..........void * type........001  ...........void * data.........G
  * closure ..........SCM code...........011  ...........SCM env.............G
  * tc7	   ......24.bits of data...Gxxxx1S1  ..........void *data............
@@ -284,17 +290,6 @@ typedef signed long scm_t_signed_bits;
 #define SCM_CONSP(x)  (!SCM_IMP (x) && ((1 & SCM_CELL_TYPE (x)) == 0))
 #define SCM_NCONSP(x) (!SCM_CONSP (x))
 
-
-/* SCM_ECONSP should be used instead of SCM_CONSP at places where GLOCS
- * can be expected to occur.
- */
-#define SCM_ECONSP(x) \
-  (!SCM_IMP (x) \
-   && (SCM_CONSP (x) \
-       || (SCM_TYP3 (x) == 1 \
-	   && (SCM_STRUCT_VTABLE_DATA (x)[scm_vtable_index_vcell] != 0))))
-#define SCM_NECONSP(x) (!SCM_ECONSP (x))
-
 
 
 #define SCM_CELLP(x) 	(((sizeof (scm_cell) - 1) & SCM_UNPACK (x)) == 0)
@@ -303,11 +298,11 @@ typedef signed long scm_t_signed_bits;
 /* See numbers.h for macros relating to immediate integers.
  */
 
-#define SCM_ITAG3(x) 		(7 & SCM_UNPACK (x))
+#define SCM_ITAG3(x) 		 (7 & SCM_UNPACK (x))
-#define SCM_TYP3(x) 		(7 & SCM_CELL_TYPE (x))
+#define SCM_TYP3(x) 		 (7 & SCM_CELL_TYPE (x))
-#define scm_tc3_cons		0
+#define scm_tc3_cons	 	 0
-#define scm_tc3_cons_gloc	1
+#define scm_tc3_struct    	 1
-#define scm_tc3_int_1		2
+#define scm_tc3_int_1		 2
 #define scm_tc3_closure		 3
 #define scm_tc3_imm24		 4
 #define scm_tc3_tc7_1		 5
@@ -497,8 +492,10 @@ extern char *scm_isymnames[];   /* defined in print.c */
 
 
 
-/* Dispatching aids: */
+/* Dispatching aids:
 
+   When switching on SCM_TYP7 of a SCM value, use these fake case
+   labels to catch types that use fewer than 7 bits for tagging.  */
 
 /* For cons pairs with immediate values in the CAR
  */
@@ -523,20 +520,22 @@ extern char *scm_isymnames[];   /* defined in print.c */
  case 64:case 72:case 80:case 88:\
  case 96:case 104:case 112:case 120
 
-/* A CONS_GLOC occurs in code.  It's CAR is a pointer to the
+/* For structs
- * CDR of a variable.  The low order bits of the CAR are 001.
- * The CDR of the gloc is the code continuation.
  */
-#define scm_tcs_cons_gloc 1:case 9:case 17:case 25:\
+#define scm_tcs_struct 1:case 9:case 17:case 25:\
  case 33:case 41:case 49:case 57:\
  case 65:case 73:case 81:case 89:\
  case 97:case 105:case 113:case 121
 
+/* For closures
+ */
 #define scm_tcs_closures   3:case 11:case 19:case 27:\
  case 35:case 43:case 51:case 59:\
  case 67:case 75:case 83:case 91:\
  case 99:case 107:case 115:case 123
 
+/* For subrs
+ */
 #define scm_tcs_subrs scm_tc7_asubr:case scm_tc7_subr_0:case scm_tc7_subr_1:case scm_tc7_cxr:\
  case scm_tc7_subr_3:case scm_tc7_subr_2:case scm_tc7_rpsubr:case scm_tc7_subr_1o:\
  case scm_tc7_subr_2o:case scm_tc7_lsubr_2:case scm_tc7_lsubr