HCoop / bpt / guile.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Merge branch 'master' into boehm-demers-weiser-gc
[bpt/guile.git] / libguile / environments.c
diff --git a/libguile/environments.c b/libguile/environments.c
index 9ea4c4e..78ccd28 100644 (file)
--- a/libguile/environments.c
+++ b/libguile/environments.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1999,2000,2001, 2003 Free Software Foundation, Inc.
+/* Copyright (C) 1999,2000,2001, 2003, 2006, 2008 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public
@@ -12,15 +12,17 @@
  *
  * You should have received a copy of the GNU Lesser General Public
  * License along with this library; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  */
 
 \f
+#ifdef HAVE_CONFIG_H
+# include <config.h>
+#endif
 
 #include "libguile/_scm.h"
 #include "libguile/alist.h"
 #include "libguile/eval.h"
-#include "libguile/gh.h"
 #include "libguile/hash.h"
 #include "libguile/list.h"
 #include "libguile/ports.h"
@@ -96,7 +98,7 @@ scm_error_environment_immutable_location (const char *func, SCM env, SCM symbol)
 SCM
 scm_make_environment (void *type)
 {
-  return scm_cell (scm_tc16_environment, (scm_t_bits) type);
+  SCM_RETURN_NEWSMOB (scm_tc16_environment, type);
 }
 
 
@@ -163,7 +165,7 @@ scm_c_environment_ref (SCM env, SCM sym)
 static SCM
 environment_default_folder (SCM proc, SCM symbol, SCM value, SCM tail)
 {
-  return gh_call3 (proc, symbol, value, tail);
+  return scm_call_3 (proc, symbol, value, tail);
 }
 
 
@@ -364,7 +366,7 @@ scm_c_environment_cell(SCM env, SCM sym, int for_write)
 static void
 environment_default_observer (SCM env, SCM proc)
 {
-  gh_call1 (proc, env);
+  scm_call_1 (proc, env);
 }
 
 
@@ -443,20 +445,6 @@ SCM_DEFINE (scm_environment_unobserve, "environment-unobserve", 1, 0, 0,
 #undef FUNC_NAME
 
 
-static SCM
-environment_mark (SCM env)
-{
-  return (*(SCM_ENVIRONMENT_FUNCS (env)->mark)) (env);
-}
-
-
-static size_t
-environment_free (SCM env)
-{
-  (*(SCM_ENVIRONMENT_FUNCS (env)->free)) (env);
-  return 0;
-}
-
 
 static int
 environment_print (SCM env, SCM port, scm_print_state *pstate)
@@ -468,14 +456,6 @@ environment_print (SCM env, SCM port, scm_print_state *pstate)
 
 /* observers */
 
-static SCM
-observer_mark (SCM observer)
-{
-  scm_gc_mark (SCM_OBSERVER_ENVIRONMENT (observer));
-  scm_gc_mark (SCM_OBSERVER_DATA (observer));
-  return SCM_BOOL_F;
-}
-
 
 static int
 observer_print (SCM type, SCM port, scm_print_state *pstate SCM_UNUSED)
@@ -511,6 +491,7 @@ obarray_enter (SCM obarray, SCM symbol, SCM data)
   SCM entry = scm_cons (symbol, data);
   SCM slot = scm_cons (entry, SCM_HASHTABLE_BUCKET (obarray, hash));
   SCM_SET_HASHTABLE_BUCKET  (obarray, hash, slot);
+  SCM_HASHTABLE_INCREMENT (obarray);
   if (SCM_HASHTABLE_N_ITEMS (obarray) > SCM_HASHTABLE_UPPER (obarray))
     scm_i_rehash (obarray, scm_i_hash_symbol, 0, "obarray_enter");
 
@@ -544,6 +525,7 @@ obarray_replace (SCM obarray, SCM symbol, SCM data)
 
   slot = scm_cons (new_entry, SCM_HASHTABLE_BUCKET (obarray, hash));
   SCM_SET_HASHTABLE_BUCKET (obarray, hash, slot);
+  SCM_HASHTABLE_INCREMENT (obarray);
   if (SCM_HASHTABLE_N_ITEMS (obarray) > SCM_HASHTABLE_UPPER (obarray))
     scm_i_rehash (obarray, scm_i_hash_symbol, 0, "obarray_replace");
 
@@ -643,10 +625,12 @@ struct core_environments_base {
 static SCM
 core_environments_observe (SCM env, scm_environment_observer proc, SCM data, int weak_p)
 {
-  SCM observer = scm_double_cell (scm_tc16_observer,
-                                 SCM_UNPACK (env),
-                                 SCM_UNPACK (data),
-                                 (scm_t_bits) proc);
+  SCM observer;
+
+  SCM_NEWSMOB3 (observer, scm_tc16_observer,
+               SCM_UNPACK (env),
+               SCM_UNPACK (data),
+               (scm_t_bits) proc);
 
   if (!weak_p)
     {
@@ -685,9 +669,10 @@ core_environments_unobserve (SCM env, SCM observer)
          if (scm_is_eq (first, observer))
            {
              /* Remove the first observer */
-             handling_weaks
-               ? SCM_SET_CORE_ENVIRONMENT_WEAK_OBSERVERS (env, rest)
-               : SCM_SET_CORE_ENVIRONMENT_OBSERVERS (env, rest);
+             if (handling_weaks)
+               SCM_SET_CORE_ENVIRONMENT_WEAK_OBSERVERS (env, rest);
+              else
+                SCM_SET_CORE_ENVIRONMENT_OBSERVERS (env, rest);
              return;
            }
 
@@ -716,20 +701,6 @@ core_environments_unobserve (SCM env, SCM observer)
 }
 
 
-static SCM
-core_environments_mark (SCM env)
-{
-  scm_gc_mark (CORE_ENVIRONMENT_OBSERVERS (env));
-  return CORE_ENVIRONMENT_WEAK_OBSERVER_VECTOR (env);
-}
-
-
-static void
-core_environments_finalize (SCM env SCM_UNUSED)
-{
-}
-
-
 static void
 core_environments_preinit (struct core_environments_base *body)
 {
@@ -959,22 +930,6 @@ leaf_environment_cell (SCM env, SCM sym, int for_write SCM_UNUSED)
 }
 
 
-static SCM
-leaf_environment_mark (SCM env)
-{
-  scm_gc_mark (LEAF_ENVIRONMENT (env)->obarray);
-  return core_environments_mark (env);
-}
-
-
-static void
-leaf_environment_free (SCM env)
-{
-  core_environments_finalize (env);
-  scm_gc_free (LEAF_ENVIRONMENT (env), sizeof (struct leaf_environment),
-              "leaf environment");
-}
-
 
 static int
 leaf_environment_print (SCM type, SCM port, scm_print_state *pstate SCM_UNUSED)
@@ -999,8 +954,6 @@ static struct scm_environment_funcs leaf_environment_funcs = {
   leaf_environment_cell,
   core_environments_observe,
   core_environments_unobserve,
-  leaf_environment_mark,
-  leaf_environment_free,
   leaf_environment_print
 };
 
@@ -1312,29 +1265,6 @@ eval_environment_cell (SCM env, SCM sym, int for_write)
 #undef FUNC_NAME
 
 
-static SCM
-eval_environment_mark (SCM env)
-{
-  struct eval_environment *body = EVAL_ENVIRONMENT (env);
-
-  scm_gc_mark (body->obarray);
-  scm_gc_mark (body->imported);
-  scm_gc_mark (body->imported_observer);
-  scm_gc_mark (body->local);
-  scm_gc_mark (body->local_observer);
-
-  return core_environments_mark (env);
-}
-
-
-static void
-eval_environment_free (SCM env)
-{
-  core_environments_finalize (env);
-  scm_gc_free (EVAL_ENVIRONMENT (env), sizeof (struct eval_environment),
-              "eval environment");
-}
-
 
 static int
 eval_environment_print (SCM type, SCM port, scm_print_state *pstate SCM_UNUSED)
@@ -1359,8 +1289,6 @@ static struct scm_environment_funcs eval_environment_funcs = {
     eval_environment_cell,
     core_environments_observe,
     core_environments_unobserve,
-    eval_environment_mark,
-    eval_environment_free,
     eval_environment_print
 };
 
@@ -1735,24 +1663,6 @@ import_environment_cell (SCM env, SCM sym, int for_write)
 #undef FUNC_NAME
 
 
-static SCM
-import_environment_mark (SCM env)
-{
-  scm_gc_mark (IMPORT_ENVIRONMENT (env)->imports);
-  scm_gc_mark (IMPORT_ENVIRONMENT (env)->import_observers);
-  scm_gc_mark (IMPORT_ENVIRONMENT (env)->conflict_proc);
-  return core_environments_mark (env);
-}
-
-
-static void
-import_environment_free (SCM env)
-{
-  core_environments_finalize (env);
-  scm_gc_free (IMPORT_ENVIRONMENT (env), sizeof (struct import_environment),
-              "import environment");
-}
-
 
 static int
 import_environment_print (SCM type, SCM port, 
@@ -1778,8 +1688,6 @@ static struct scm_environment_funcs import_environment_funcs = {
   import_environment_cell,
   core_environments_observe,
   core_environments_unobserve,
-  import_environment_mark,
-  import_environment_free,
   import_environment_print
 };
 
@@ -2037,27 +1945,6 @@ export_environment_cell (SCM env, SCM sym, int for_write)
 #undef FUNC_NAME
 
 
-static SCM
-export_environment_mark (SCM env)
-{
-  struct export_environment *body = EXPORT_ENVIRONMENT (env);
-
-  scm_gc_mark (body->private);
-  scm_gc_mark (body->private_observer);
-  scm_gc_mark (body->signature);
-
-  return core_environments_mark (env);
-}
-
-
-static void
-export_environment_free (SCM env)
-{
-  core_environments_finalize (env);
-  scm_gc_free (EXPORT_ENVIRONMENT (env), sizeof (struct export_environment),
-              "export environment");
-}
-
 
 static int
 export_environment_print (SCM type, SCM port,
@@ -2083,8 +1970,6 @@ static struct scm_environment_funcs export_environment_funcs = {
   export_environment_cell,
   core_environments_observe,
   core_environments_unobserve,
-  export_environment_mark,
-  export_environment_free,
   export_environment_print
 };
 
@@ -2314,13 +2199,10 @@ scm_environments_prehistory ()
 {
   /* create environment smob */
   scm_tc16_environment = scm_make_smob_type ("environment", 0);
-  scm_set_smob_mark (scm_tc16_environment, environment_mark);
-  scm_set_smob_free (scm_tc16_environment, environment_free);
   scm_set_smob_print (scm_tc16_environment, environment_print);
 
   /* create observer smob */
   scm_tc16_observer = scm_make_smob_type ("observer", 0);
-  scm_set_smob_mark (scm_tc16_observer, observer_mark);
   scm_set_smob_print (scm_tc16_observer, observer_print);
 
   /* create system environment */
Unnamed repository; edit this file 'description' to name the repository.