guile-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: compiling with -DSCM_DEBUG=1


From: Ken Raeburn
Subject: Re: compiling with -DSCM_DEBUG=1
Date: Sat, 5 Sep 2009 19:42:49 -0400

Okay, I found some more time to look into it. I have a patch that now passes "make && make install && make check" with SCM_DEBUG==1.

There was an additional issue in goops.c where SCM_C[AD]R get used with objects that have just been verified to be structs, not pairs. Since there don't seem to be high-level macros for modifying those fields, I used the low-level cell-word access macros instead.

Ken

    Fix run-time errors in building and tests with SCM_DEBUG==1.

* eval.i.c (CEVAL): Stop comparing arg list and specifiers when out of
      specifiers.
    * objects.c (scm_mcache_lookup_cmethod): Likewise.

* goops.c (scm_sys_modify_instance, scm_sys_modify_class): Don't use
      SCM_CAR and SCM_CDR to access fields of a class object.

diff --git a/libguile/eval.i.c b/libguile/eval.i.c
index 25abf6c..c9d3beb 100644
--- a/libguile/eval.i.c
+++ b/libguile/eval.i.c
@@ -847,7 +847,7 @@ dispatch:
                {
                  SCM args = arg1; /* list of arguments */
                  z = SCM_SIMPLE_VECTOR_REF (method_cache, hash_value);
-                 while (!scm_is_null (args))
+                 while (scm_is_pair (z) && !scm_is_null (args))
                    {
                      /* More arguments than specifiers => CLASS != ENV */
                      SCM class_of_arg = scm_class_of (SCM_CAR (args));
diff --git a/libguile/goops.c b/libguile/goops.c
index d1beab3..eecb652 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -1652,12 +1652,13 @@ SCM_DEFINE (scm_sys_modify_instance, "%modify- instance", 2, 0, 0,
    */
   SCM_CRITICAL_SECTION_START;
   {
-    SCM car = SCM_CAR (old);
-    SCM cdr = SCM_CDR (old);
-    SCM_SETCAR (old, SCM_CAR (new));
-    SCM_SETCDR (old, SCM_CDR (new));
-    SCM_SETCAR (new, car);
-    SCM_SETCDR (new, cdr);
+    scm_t_bits word0, word1;
+    word0 = SCM_CELL_WORD_0 (old);
+    word1 = SCM_CELL_WORD_1 (old);
+    SCM_SET_CELL_WORD_0 (old, SCM_CELL_WORD_0 (new));
+    SCM_SET_CELL_WORD_1 (old, SCM_CELL_WORD_1 (new));
+    SCM_SET_CELL_WORD_0 (new, word0);
+    SCM_SET_CELL_WORD_1 (new, word1);
   }
   SCM_CRITICAL_SECTION_END;
   return SCM_UNSPECIFIED;
@@ -1674,13 +1675,14 @@ SCM_DEFINE (scm_sys_modify_class, "%modify- class", 2, 0, 0,

   SCM_CRITICAL_SECTION_START;
   {
-    SCM car = SCM_CAR (old);
-    SCM cdr = SCM_CDR (old);
-    SCM_SETCAR (old, SCM_CAR (new));
-    SCM_SETCDR (old, SCM_CDR (new));
+    scm_t_bits word0, word1;
+    word0 = SCM_CELL_WORD_0 (old);
+    word1 = SCM_CELL_WORD_1 (old);
+    SCM_SET_CELL_WORD_0 (old, SCM_CELL_WORD_0 (new));
+    SCM_SET_CELL_WORD_1 (old, SCM_CELL_WORD_1 (new));
     SCM_STRUCT_DATA (old)[scm_vtable_index_vtable] = SCM_UNPACK (old);
-    SCM_SETCAR (new, car);
-    SCM_SETCDR (new, cdr);
+    SCM_SET_CELL_WORD_0 (new, word0);
+    SCM_SET_CELL_WORD_1 (new, word1);
     SCM_STRUCT_DATA (new)[scm_vtable_index_vtable] = SCM_UNPACK (new);
   }
   SCM_CRITICAL_SECTION_END;
diff --git a/libguile/objects.c b/libguile/objects.c
index e82fb9d..7f20899 100644
--- a/libguile/objects.c
+++ b/libguile/objects.c
@@ -131,7 +131,7 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
       long j = n;
       z = SCM_SIMPLE_VECTOR_REF (methods, i);
       ls = args; /* list of arguments */
-      if (!scm_is_null (ls))
+      if (!scm_is_null (ls) && scm_is_pair (z))
        do
          {
            /* More arguments than specifiers => CLASS != ENV */
@@ -140,7 +140,7 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
            ls = SCM_CDR (ls);
            z = SCM_CDR (z);
          }
-       while (j-- && !scm_is_null (ls));
+       while (j-- && !scm_is_null (ls) && scm_is_pair (z));
/* Fewer arguments than specifiers => CAR != CLASS or `no- method' */
       if (!scm_is_pair (z)
|| (!SCM_CLASSP (SCM_CAR (z)) && !scm_is_symbol (SCM_CAR (z))))





reply via email to

[Prev in Thread] Current Thread [Next in Thread]