Add br-if-logtest opcode

[bpt/guile.git] / libguile / goops.c

diff --git a/libguile/goops.c b/libguile/goops.c
index 74ded73..450ae0d 100644 (file)
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012
+/* Copyright (C) 1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013,2014
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
@@ -155,8 +155,6 @@ static SCM class_hashtable;
 static SCM class_fluid;
 static SCM class_dynamic_state;
 static SCM class_frame;
-static SCM class_objcode;
-static SCM class_vm;
 static SCM class_vm_cont;
 static SCM class_bytevector;
 static SCM class_uvec;
@@ -266,10 +264,6 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
          return class_dynamic_state;
         case scm_tc7_frame:
          return class_frame;
-        case scm_tc7_objcode:
-         return class_objcode;
-        case scm_tc7_vm:
-         return class_vm;
         case scm_tc7_vm_cont:
          return class_vm_cont;
        case scm_tc7_bytevector:
@@ -301,9 +295,6 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
          else
            return scm_class_procedure;
 
-       case scm_tc7_rtl_program:
-          return scm_class_procedure;
-
        case scm_tc7_smob:
          {
            scm_t_bits type = SCM_TYP16 (x);
@@ -649,7 +640,7 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0,
        get_n_set = SCM_CDR (get_n_set), slots = SCM_CDR (slots))
     {
       SCM slot_name  = SCM_CAR (slots);
-      SCM slot_value = SCM_PACK (0);
+      SCM slot_value = SCM_GOOPS_UNBOUND;
 
       if (!scm_is_null (SCM_CDR (slot_name)))
        {
@@ -673,12 +664,12 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0,
              slot_value = scm_i_get_keyword (tmp,
                                              initargs,
                                              n_initargs,
-                                             SCM_PACK (0),
+                                             SCM_GOOPS_UNBOUND,
                                              FUNC_NAME);
            }
        }
 
-      if (SCM_UNPACK (slot_value))
+      if (!SCM_GOOPS_UNBOUNDP (slot_value))
        /* set slot to provided value */
        set_slot_value (class, obj, SCM_CAR (get_n_set), slot_value);
       else
@@ -686,14 +677,10 @@ SCM_DEFINE (scm_sys_initialize_object, "%initialize-object", 2, 0, 0,
          /* set slot to its :init-form if it exists */
          tmp = SCM_CADAR (get_n_set);
          if (scm_is_true (tmp))
-           {
-             slot_value = get_slot_value (class, obj, SCM_CAR (get_n_set));
-             if (SCM_GOOPS_UNBOUNDP (slot_value))
-                set_slot_value (class,
-                                obj,
-                                SCM_CAR (get_n_set),
-                                scm_call_0 (tmp));
-           }
+            set_slot_value (class,
+                            obj,
+                            SCM_CAR (get_n_set),
+                            scm_call_0 (tmp));
        }
     }
 
@@ -1720,16 +1707,24 @@ SCM_KEYWORD (k_name, "name");
 
 SCM_GLOBAL_SYMBOL (scm_sym_args, "args");
 
-
 SCM_SYMBOL (sym_delayed_compile, "delayed-compile");
+
+static SCM delayed_compile_var;
+
+static void
+init_delayed_compile_var (void)
+{
+  delayed_compile_var
+    = scm_c_private_lookup ("oop goops dispatch", "delayed-compile");
+}
+
 static SCM
 make_dispatch_procedure (SCM gf)
 {
-  static SCM var = SCM_BOOL_F;
-  if (scm_is_false (var))
-    var = scm_module_variable (scm_c_resolve_module ("oop goops dispatch"),
-                               sym_delayed_compile);
-  return scm_call_1 (SCM_VARIABLE_REF (var), gf);
+  static scm_i_pthread_once_t once = SCM_I_PTHREAD_ONCE_INIT;
+  scm_i_pthread_once (&once, init_delayed_compile_var);
+
+  return scm_call_1 (scm_variable_ref (delayed_compile_var), gf);
 }
 
 static void
@@ -2518,10 +2513,6 @@ create_standard_classes (void)
               scm_class_class, scm_class_top,             SCM_EOL);
   make_stdcls (&class_frame,              "<frame>",
               scm_class_class, scm_class_top,             SCM_EOL);
-  make_stdcls (&class_objcode,            "<objcode>",
-              scm_class_class, scm_class_top,             SCM_EOL);
-  make_stdcls (&class_vm,                 "<vm>",
-              scm_class_class, scm_class_top,             SCM_EOL);
   make_stdcls (&class_vm_cont,            "<vm-continuation>",
               scm_class_class, scm_class_top,             SCM_EOL);
   make_stdcls (&class_bytevector,         "<bytevector>",