diff --git a/libguile/eval.c b/libguile/eval.c
index 02811b1d5..33062ee25 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -93,6 +93,9 @@ char *alloca ();
 #include "feature.h"
 
 #include "eval.h"
+
+void (*scm_memoize_method) (SCM, SCM);
+
 
 
 /* The evaluator contains a plethora of EVAL symbols.
@@ -1975,6 +1978,55 @@ dispatch:
 	  ENTER_APPLY;
 	  goto evap1;
 
+	case (SCM_ISYMNUM (SCM_IM_DISPATCH)):
+	  {
+	    int i, end, mask;
+	    mask = -1;
+	    proc = SCM_CDR (x);
+	    i = 0;
+	    end = SCM_LENGTH (proc);
+	  find_method:
+	    do
+	      {
+		t.arg1 = SCM_CDDAR (env);
+		arg2 = SCM_VELTS (proc)[i];
+		do
+		  {
+		    if (scm_class_of (SCM_CAR (t.arg1)) != SCM_CAR (arg2))
+		      goto next_method;
+		    t.arg1 = SCM_CDR (t.arg1);
+		    arg2 = SCM_CDR (arg2);
+		  }
+		while (SCM_NIMP (t.arg1));
+		x = SCM_CAR (arg2);
+		env = scm_cons (SCM_CAR (env), SCM_CDR (arg2));
+		goto begin;
+	      next_method:
+		i = (i + 1) & mask;
+	      } while (i != end);
+	  memoize_method:
+	    scm_memoize_method (x, SCM_CDAR (env));
+	    goto loop;
+	  
+	  case (SCM_ISYMNUM (SCM_IM_HASH_DISPATCH)):
+	    {
+	      int hashset = SCM_INUM (SCM_CADR (x));
+	      mask = SCM_INUM (SCM_CADDR (x));
+	      proc = SCM_CDDDR (x);
+	      i = 0;
+	      t.arg1 = SCM_CDDAR (env);
+	      do
+		{
+		  i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (t.arg1)))[scm_si_hashsets + hashset];
+		  t.arg1 = SCM_CDR (t.arg1);
+		}
+	      while (SCM_NIMP (t.arg1));
+	      i &= mask;
+	      end = i;
+	    }
+	    goto find_method;
+	  }
+	  
 	default:
 	  goto badfun;
 	}
diff --git a/libguile/gc.c b/libguile/gc.c
index 46b4507ed..823c3ce4c 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -1113,9 +1113,19 @@ scm_gc_sweep ()
 		if ((SCM_CDR (vcell) == 0) || (SCM_CDR (vcell) == 1))
 		  {
 		    SCM *p = (SCM *) SCM_GCCDR (scmptr);
- 		    m += p[scm_struct_i_n_words] * sizeof (SCM);
-		    /* I feel like I'm programming in BCPL here... */
-		    free ((char *) p[scm_struct_i_ptr]);
+		    if (((SCM*) vcell)[scm_vtable_index_layout]
+			& SCM_STRUCTF_LIGHT)
+		      {
+			SCM layout = ((SCM*)vcell)[scm_vtable_index_layout];
+			m += SCM_LENGTH (layout) / 2;
+			free ((char *) p);
+		      }
+		    else
+		      {
+			m += p[scm_struct_i_n_words] * sizeof (SCM);
+			/* I feel like I'm programming in BCPL here... */
+			free ((char *) p[scm_struct_i_ptr]);
+		      }
 		  }
 	      }
 	      break;
diff --git a/libguile/objects.c b/libguile/objects.c
index cbb6b4ca9..a55209b13 100644
--- a/libguile/objects.c
+++ b/libguile/objects.c
@@ -49,6 +49,8 @@
 
 #include "struct.h"
 #include "procprop.h"
+#include "chars.h"
+#include "kw.h"
 
 #include "objects.h"
 
@@ -56,6 +58,124 @@
 SCM scm_metaclass_standard;
 SCM scm_metaclass_operator;
 
+/* These variables are filled in by the object system when loaded. */
+SCM scm_class_boolean, scm_class_char, scm_class_pair;
+SCM scm_class_procedure, scm_class_string, scm_class_symbol;
+SCM scm_class_vector, scm_class_null;
+SCM scm_class_real, scm_class_complex, scm_class_integer;
+SCM scm_class_keyword, scm_class_unknown;
+
+void (*scm_change_object_class) (SCM, SCM, SCM);
+
+/* This function is used for efficient type dispatch.  */
+SCM
+scm_class_of (SCM x)
+{
+  switch (SCM_ITAG3 (x))
+    {
+    case scm_tc3_int_1:
+    case scm_tc3_int_2:
+      return scm_class_integer;
+
+    case scm_tc3_imm24:
+      if (SCM_ICHRP (x))
+	return scm_class_char;
+      else
+	{
+	  switch (SCM_ISYMNUM (x))
+	    {
+	    case SCM_ISYMNUM (SCM_BOOL_F):
+	    case SCM_ISYMNUM (SCM_BOOL_T):
+	      return scm_class_boolean;
+	    case SCM_ISYMNUM (SCM_EOL):
+	      return scm_class_null;
+	    default:
+	      return scm_class_unknown;
+	    }
+	}
+
+    case scm_tc3_cons:
+      switch (SCM_TYP7 (x))
+	{
+	case scm_tcs_cons_nimcar:
+	  return scm_class_pair;
+	case scm_tcs_closures:
+	  return scm_class_procedure;
+	case scm_tcs_symbols:
+	  return scm_class_symbol;
+	case scm_tc7_vector:
+	case scm_tc7_wvect:
+	case scm_tc7_bvect:
+	case scm_tc7_byvect:
+	case scm_tc7_svect:
+	case scm_tc7_ivect:
+	case scm_tc7_uvect:
+	case scm_tc7_fvect:
+	case scm_tc7_dvect:
+	case scm_tc7_cvect:
+	  return scm_class_vector;
+	case scm_tc7_string:
+	case scm_tc7_substring:
+	  return scm_class_string;
+	case 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:
+	  return scm_class_procedure;
+
+	case scm_tc7_port:
+	  return scm_class_unknown;
+	case scm_tc7_smob:
+	  {
+	    SCM type = SCM_TYP16 (x);
+	    if (type == scm_tc16_flo)
+	      {
+		if (SCM_CAR (x) & SCM_IMAG_PART)
+		  return scm_class_complex;
+		else
+		  return scm_class_real;
+	      }
+	    else if (type == scm_tc16_bigpos || type == scm_tc16_bigneg)
+	      return scm_class_integer;
+	    else if (type == scm_tc16_kw)
+	      return scm_class_keyword;
+	    else
+	      return scm_class_unknown;
+	  }
+	case scm_tcs_cons_gloc:
+	  /* must be a struct */
+	  if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS)
+	  {
+	    if (CLASS_REDEF (SCM_CLASS_OF (x)) != SCM_BOOL_F)
+	      scm_change_object_class (x,
+				       SCM_CLASS_OF (x),
+				       CLASS_REDEF (SCM_CLASS_OF (x)));
+	    return SCM_CLASS_OF (x);
+	  }
+	default:
+	  if (SCM_CONSP (x))
+	    return scm_class_pair;
+	  else
+	    return scm_class_unknown;
+	}
+
+    case scm_tc3_cons_gloc:
+    case scm_tc3_tc7_1:
+    case scm_tc3_tc7_2:
+    case scm_tc3_closure:
+      /* Never reached */
+      break;
+    }
+  return scm_class_unknown;
+}
+
 SCM_PROC (s_entity_p, "entity?", 1, 0, 0, scm_entity_p);
 
 SCM
diff --git a/libguile/objects.h b/libguile/objects.h
index 8f778838c..e70c1a4a4 100644
--- a/libguile/objects.h
+++ b/libguile/objects.h
@@ -159,9 +159,27 @@ struct scm_metaclass_operator {
  */
 #define SCM_ENTITY_LAYOUT ""
 
+/* The following three definitions are Goops dependencies needed by
+   scm_class_of. */
+#define SCM_CLASSF_GOOPS       (0x10 << 24)
+#define scm_si_redefined       17
+#define scm_si_hashsets        19
+#define SCM_CLASS_OF(x)        SCM_STRUCT_VTABLE (x)
+
+#define CLASS_REDEF(c) (SCM_STRUCT_DATA(c)[scm_si_redefined])
+
 extern SCM scm_metaclass_standard;
 extern SCM scm_metaclass_operator;
+extern SCM scm_class_boolean, scm_class_char, scm_class_pair;
+extern SCM scm_class_procedure, scm_class_string, scm_class_symbol;
+extern SCM scm_class_vector, scm_class_null;
+extern SCM scm_class_real, scm_class_complex, scm_class_integer;
+extern SCM scm_class_keyword, scm_class_unknown;
 
+extern void (*scm_change_object_class) (SCM, SCM, SCM);
+extern void (*scm_memoize_method) (SCM x, SCM args);
+
+extern SCM scm_class_of (SCM obj);
 extern SCM scm_entity_p (SCM obj);
 extern SCM scm_set_object_procedure_x (SCM obj, SCM procs);
 extern SCM scm_make_class_object (SCM metaclass, SCM layout);
diff --git a/libguile/struct.h b/libguile/struct.h
index ea2221880..3e3708b5f 100644
--- a/libguile/struct.h
+++ b/libguile/struct.h
@@ -65,6 +65,8 @@
 #define scm_vtable_offset_user   4 /* Where do user fields start? */
 
 #define SCM_STRUCTF_ENTITY (1L << 30) /* Indicates presence of proc slots */
+#define SCM_STRUCTF_LIGHT  (1L << 31) /* Light representation
+					 (no hidden words) */
 
 #define SCM_STRUCTP(X)  		(SCM_TYP3(X) == scm_tc3_cons_gloc)
 #define SCM_STRUCT_DATA(X) 		((SCM*)(SCM_CDR(X)))
diff --git a/libguile/tags.h b/libguile/tags.h
index 2c97f4f78..715d7b131 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -472,6 +472,8 @@ enum scm_tags
 #define SCM_EOF_VAL 		SCM_MAKIFLAG(19)
 #define SCM_EOL			SCM_MAKIFLAG(20)
 #define SCM_UNSPECIFIED		SCM_MAKIFLAG(21)
+#define SCM_IM_DISPATCH		SCM_MAKISYM(22)
+#define SCM_IM_HASH_DISPATCH	SCM_MAKISYM(23)
 
 
 #define SCM_UNBNDP(x) 	(SCM_UNDEFINED==(x))