guile/guile-core libguile/ChangeLog libguile/go...

[Dirk Herrmann]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Dirk Herrmann <address@hidden>  00/11/24 02:55:23

Modified files:
        guile-core/libguile: ChangeLog goops.c goops.h 
        guile-core/oop : ChangeLog goops.scm 
        guile-core/oop/goops: dispatch.scm 

Log message:
        * Goops does not provide its own version of logand any more.
        * Removed use of deprecated stuff from goops.

CVSWeb URLs:
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/ChangeLog.diff?r1=1.1175&r2=1.1176
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/goops.c.diff?r1=1.4&r2=1.5
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/goops.h.diff?r1=1.2&r2=1.3
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/oop/ChangeLog.diff?r1=1.2&r2=1.3
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/oop/goops.scm.diff?r1=1.2&r2=1.3
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/oop/goops/dispatch.scm.diff?r1=1.2&r2=1.3

Patches:
Index: guile/guile-core/libguile/ChangeLog
diff -u guile/guile-core/libguile/ChangeLog:1.1175 
guile/guile-core/libguile/ChangeLog:1.1176
--- guile/guile-core/libguile/ChangeLog:1.1175  Thu Nov 23 07:26:24 2000
+++ guile/guile-core/libguile/ChangeLog Fri Nov 24 02:55:22 2000
@@ -1,3 +1,19 @@
+2000-11-24  Dirk Herrmann  <address@hidden>
+
+       * goops.c:  Include validate.h.
+
+       (DEFVAR, scm_add_method):  Don't use deprecated scm_eval2.
+
+       (scm_sys_fast_slot_ref, scm_sys_fast_slot_set_x,
+       scm_m_atdispatch):  Provide FUNC_NAME definition.  Don't use
+       deprecated SCM_OUTOFRANGE macro.
+
+       (scm_sloppy_num2ulong, scm_sys_logand):  Removed.  Guile's logand
+       function now provides the desired behaviour.
+
+       * goops.c (filter_cpl, remove_duplicate_slots), goops.h
+       (SCM_SUBCLASSP):  Don't use deprecated scm_sloppy_memq.
+
 2000-11-23  Dirk Herrmann  <address@hidden>
 
        * symbols.h (SCM_LENGTH_MAX):  Deprecated.
Index: guile/guile-core/libguile/goops.c
diff -u guile/guile-core/libguile/goops.c:1.4 
guile/guile-core/libguile/goops.c:1.5
--- guile/guile-core/libguile/goops.c:1.4       Fri Nov 17 08:25:03 2000
+++ guile/guile-core/libguile/goops.c   Fri Nov 24 02:55:23 2000
@@ -69,6 +69,7 @@
 #include "libguile/vectors.h"
 #include "libguile/weaks.h"
 
+#include "libguile/validate.h"
 #include "libguile/goops.h"
 
 #define CLASSP(x)   (SCM_STRUCTP (x) \
@@ -81,8 +82,8 @@
 
 
 #define DEFVAR(v,val) \
-{ scm_eval2 (SCM_LIST3 (scm_sym_define_public, (v), (val)), \
-            scm_goops_lookup_closure); }
+{ scm_i_eval (SCM_LIST3 (scm_sym_define_public, (v), (val)), \
+             scm_top_level_env (scm_goops_lookup_closure)); }
 /* Temporary hack until we get the new module system */
 /*fixme* Should optimize by keeping track of the variable object itself */
 #define GETVAR(v) (SCM_CDDR (scm_apply (scm_goops_lookup_closure, \
@@ -217,7 +218,7 @@
   while (SCM_NIMP (ls))
     {
       SCM el = SCM_CAR (ls);
-      if (SCM_IMP (scm_sloppy_memq (el, res)))
+      if (SCM_IMP (scm_memq (el, res)))
        res = scm_cons (el, res);
       ls = SCM_CDR (ls);
     }
@@ -258,7 +259,7 @@
                    "bad slot name ~S",
                    SCM_LIST1 (tmp));
   
-  if (SCM_NULLP (scm_sloppy_memq (tmp, slots_already_seen))) {
+  if (SCM_NULLP (scm_memq (tmp, slots_already_seen))) {
     res               = scm_cons (SCM_CAR (l), res);
     slots_already_seen = scm_cons (tmp, slots_already_seen);
   }
@@ -991,6 +992,7 @@
 
 SCM
 scm_sys_fast_slot_ref (SCM obj, SCM index)
+#define FUNC_NAME s_sys_fast_slot_ref
 {
   register long i;
 
@@ -998,15 +1000,18 @@
              obj, SCM_ARG1, s_sys_fast_slot_ref);
   SCM_ASSERT (SCM_INUMP (index), index, SCM_ARG2, s_sys_fast_slot_ref);
   i = SCM_INUM (index);
-  SCM_ASSERT (i >= 0 && i < SCM_NUMBER_OF_SLOTS (obj),
-             index, SCM_OUTOFRANGE, s_sys_fast_slot_ref);
+  
+  SCM_ASSERT_RANGE (2, index, i >= 0 && i < SCM_NUMBER_OF_SLOTS (obj));
   return scm_at_assert_bound_ref (obj, index);
 }
+#undef FUNC_NAME
+
 
 SCM_PROC (s_sys_fast_slot_set_x, "%fast-slot-set!", 3, 0, 0, 
scm_sys_fast_slot_set_x);
 
 SCM
 scm_sys_fast_slot_set_x (SCM obj, SCM index, SCM value)
+#define FUNC_NAME s_sys_fast_slot_set_x
 {
   register long i;
 
@@ -1014,13 +1019,14 @@
              obj, SCM_ARG1, s_sys_fast_slot_set_x);
   SCM_ASSERT (SCM_INUMP (index), index, SCM_ARG2, s_sys_fast_slot_set_x);
   i = SCM_INUM (index);
-  SCM_ASSERT (i >= 0 && i < SCM_NUMBER_OF_SLOTS (obj),
-             index, SCM_OUTOFRANGE, s_sys_fast_slot_set_x);
-
+  SCM_ASSERT_RANGE (2, index, i >= 0 && i < SCM_NUMBER_OF_SLOTS (obj));
   SCM_SLOT (obj, i) = value;
+
   return SCM_UNSPECIFIED;
 }
+#undef FUNC_NAME
 
+
 /** Utilities **/
 
 /* In the future, this function will return the effective slot
@@ -1129,56 +1135,6 @@
   return SCM_BOOL_F;
 }
 
-/* The current libguile logand doesn't handle bignums.
- * This (primitive) version handles them up to 32 bits.
- */
-
-SCM_PROC1 (s_sys_logand, "%logand", scm_tc7_asubr, scm_sys_logand);
-
-static unsigned long
-scm_sloppy_num2ulong (SCM num, char *pos, const char *s_caller)
-{
-  unsigned long res;
-
-  if (SCM_INUMP (num))
-    {
-      if (SCM_INUM (num) < 0)
-       goto out_of_range;
-      res = SCM_INUM (num);
-      return res;
-    }
-  SCM_ASRTGO (SCM_NIMP (num), wrong_type_arg);
-  if (SCM_BIGP (num))
-    {
-      scm_sizet l;
-
-      res = 0;
-      for (l = SCM_NUMDIGS (num); l--;)
-       res = SCM_BIGUP (res) + SCM_BDIGITS (num)[l];
-      return res;
-    }
- wrong_type_arg:
-  scm_wrong_type_arg (s_caller, (int) pos, num);
- out_of_range:
-  scm_out_of_range (s_caller, num);
-}
-
-static SCM
-scm_sys_logand (SCM n1, SCM n2)
-{
-  if (SCM_UNBNDP (n2))
-    {
-      if (SCM_UNBNDP (n1))
-       return SCM_MAKINUM (-1);
-      return n1;
-    }
-  {
-    unsigned long u1 = scm_sloppy_num2ulong (n1, (char *) 1, s_sys_logand);
-    unsigned long u2 = scm_sloppy_num2ulong (n2, (char *) 2, s_sys_logand);
-    return scm_ulong2num (u1 & u2);
-  }
-}
-
                /* ======================================== */
 
 SCM_PROC (s_slot_ref_using_class, "slot-ref-using-class", 3, 0, 0, 
scm_slot_ref_using_class);
@@ -1951,6 +1907,7 @@
 
 SCM
 scm_m_atdispatch (SCM xorig, SCM env)
+#define FUNC_NAME s_atdispatch
 {
   SCM args, n, v, gf, x = SCM_CDR (xorig);
   SCM_ASSYNT (scm_ilength (x) == 4, xorig, scm_s_expression, s_atdispatch);
@@ -1960,7 +1917,7 @@
   x = SCM_CDR (x);
   n = SCM_XEVALCAR (x, env);
   SCM_ASSYNT (SCM_INUMP (n), n, SCM_ARG2, s_atdispatch);
-  SCM_ASSYNT (SCM_INUM (n) >= 1, n, SCM_OUTOFRANGE, s_atdispatch);
+  SCM_ASSERT_RANGE (0, n, SCM_INUM (n) >= 1);
   x = SCM_CDR (x);
   v = SCM_XEVALCAR (x, env);
   SCM_ASSYNT (SCM_NIMP (v) && SCM_VECTORP (v), v, SCM_ARG3, s_atdispatch);
@@ -1970,6 +1927,8 @@
              gf, SCM_ARG4, s_atdispatch);
   return SCM_LIST5 (SCM_IM_DISPATCH, args, n, v, gf);
 }
+#undef FUNC_NAME
+
 
 #ifdef USE_THREADS
 static void
@@ -2663,8 +2622,8 @@
 void
 scm_add_method (SCM gf, SCM m)
 {
-  scm_eval2 (SCM_LIST3 (sym_internal_add_method_x, gf, m),
-            scm_goops_lookup_closure);
+  scm_i_eval (SCM_LIST3 (sym_internal_add_method_x, gf, m),
+             scm_top_level_env (scm_goops_lookup_closure));
 }
 
 #ifdef GUILE_DEBUG
Index: guile/guile-core/libguile/goops.h
diff -u guile/guile-core/libguile/goops.h:1.2 
guile/guile-core/libguile/goops.h:1.3
--- guile/guile-core/libguile/goops.h:1.2       Wed Oct 25 08:51:06 2000
+++ guile/guile-core/libguile/goops.h   Fri Nov 24 02:55:23 2000
@@ -134,7 +134,7 @@
                                   | SCM_CLASSF_SIMPLE_METHOD))
 
 #define SCM_SLOT(x, i)         (SCM_INST(x)[i])
-#define SCM_SUBCLASSP(c1, c2)  SCM_NNULLP (scm_sloppy_memq (c2, SCM_SLOT (c1, 
scm_si_cpl)))
+#define SCM_SUBCLASSP(c1, c2)  SCM_NNULLP (scm_memq (c2, SCM_SLOT (c1, 
scm_si_cpl)))
 #define SCM_IS_A_P(x, c)       (SCM_NIMP (x) \
                                && SCM_INSTANCEP (x) \
                                && SCM_SUBCLASSP (SCM_CLASS_OF (x), c))
Index: guile/guile-core/oop/ChangeLog
diff -u guile/guile-core/oop/ChangeLog:1.2 guile/guile-core/oop/ChangeLog:1.3
--- guile/guile-core/oop/ChangeLog:1.2  Mon Nov  6 18:19:13 2000
+++ guile/guile-core/oop/ChangeLog      Fri Nov 24 02:55:23 2000
@@ -1,3 +1,10 @@
+2000-11-24  Dirk Herrmann  <address@hidden>
+
+       * goops.scm:  Don't export removed %logand any more.
+
+       * goops/dispatch.scm (cache-try-hash!):  Use logand instead of
+       %logand.
+
 2000-11-06  Mikael Djurfeldt  <address@hidden>
 
        * goops.scm (internal-add-method!): Set n-specialized of a generic
Index: guile/guile-core/oop/goops.scm
diff -u guile/guile-core/oop/goops.scm:1.2 guile/guile-core/oop/goops.scm:1.3
--- guile/guile-core/oop/goops.scm:1.2  Mon Nov  6 18:18:52 2000
+++ guile/guile-core/oop/goops.scm      Fri Nov 24 02:55:23 2000
@@ -77,8 +77,7 @@
     generic-function-methods method-generic-function method-specializers
     primitive-generic-generic enable-primitive-generic!
     method-procedure accessor-method-slot-definition
-    slot-exists? make find-method get-keyword
-    %logand)
+    slot-exists? make find-method get-keyword)
 
 
 (define min-fixnum (- (expt 2 29)))
Index: guile/guile-core/oop/goops/dispatch.scm
diff -u guile/guile-core/oop/goops/dispatch.scm:1.2 
guile/guile-core/oop/goops/dispatch.scm:1.3
--- guile/guile-core/oop/goops/dispatch.scm:1.2 Mon Nov  6 18:19:03 2000
+++ guile/guile-core/oop/goops/dispatch.scm     Fri Nov 24 02:55:23 2000
@@ -191,8 +191,8 @@
             (do ((ls entries (cdr ls))
                  (misses 0 0))
                 ((null? ls) max-misses)
-              (do ((i (%logand mask (cache-hashval hashset (car ls)))
-                      (%logand mask (+ i 1))))
+              (do ((i (logand mask (cache-hashval hashset (car ls)))
+                      (logand mask (+ i 1))))
                   ((not (struct? (car (vector-ref cache i))))
                    (vector-set! cache i (car ls)))
                 (set! misses (+ 1 misses))