Removed definition of GUILE_PTHREAD_COMPAT inside commentary

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

diff --git a/libguile/objects.c b/libguile/objects.c
index 538aa22..6421e10 100644 (file)
--- a/libguile/objects.c
+++ b/libguile/objects.c
@@ -1,4 +1,4 @@
-/*     Copyright (C) 1995, 1996, 1999 Free Software Foundation, Inc.
+/*     Copyright (C) 1995, 1996, 1999, 2000 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -58,8 +58,11 @@
 #include "smob.h"
 #include "eval.h"
 #include "alist.h"
+#include "ports.h"
+#include "strings.h"
+#include "vectors.h"
 
-#include "scm_validate.h"
+#include "validate.h"
 #include "objects.h"
 \f
 
@@ -94,7 +97,7 @@ scm_class_of (SCM x)
       return scm_class_integer;
 
     case scm_tc3_imm24:
-      if (SCM_ICHRP (x))
+      if (SCM_CHARP (x))
        return scm_class_char;
       else
        {
@@ -157,22 +160,15 @@ scm_class_of (SCM x)
 
        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_port_with_ps)
+           long type = SCM_TYP16 (x);
+           if (type != scm_tc16_port_with_ps)
              return scm_smob_class[SCM_TC2SMOBNUM (type)];
            x = SCM_PORT_WITH_PS_PORT (x);
            /* fall through to ports */
          }
        case scm_tc7_port:
-         return scm_port_class[(SCM_WRTNG & SCM_CAR (x)
-                                ? (SCM_RDNG & SCM_CAR (x)
+         return scm_port_class[(SCM_WRTNG & SCM_UNPACK_CAR (x)
+                                ? (SCM_RDNG & SCM_UNPACK_CAR (x)
                                    ? SCM_INOUT_PCLASS_INDEX | SCM_PTOBNUM (x)
                                    : SCM_OUT_PCLASS_INDEX | SCM_PTOBNUM (x))
                                 : SCM_IN_PCLASS_INDEX | SCM_PTOBNUM (x))];
@@ -201,7 +197,7 @@ scm_class_of (SCM x)
                  SCM class = scm_make_extended_class (SCM_NFALSEP (name)
                                                       ? SCM_ROCHARS (name)
                                                       : 0);
-                 SCM_SET_STRUCT_TABLE_CLASS (handle, class);
+                 SCM_SET_STRUCT_TABLE_CLASS (SCM_CDR (handle), class);
                  return class;
                }
            }
@@ -280,7 +276,7 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
       if (SCM_NIMP (ls))
        do
          {
-           i += (SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls)))
+           i += SCM_UNPACK (SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls)))
                  [scm_si_hashsets + hashset]);
            ls = SCM_CDR (ls);
          }
@@ -359,33 +355,32 @@ scm_call_generic_3 (SCM gf, SCM a1, SCM a2, SCM a3)
   return scm_apply_generic (gf, SCM_LIST3 (a1, a2, a3));
 }
 
-GUILE_PROC (scm_entity_p, "entity?", 1, 0, 0, 
+SCM_DEFINE (scm_entity_p, "entity?", 1, 0, 0, 
             (SCM obj),
-            "")
+"")
 #define FUNC_NAME s_scm_entity_p
 {
-  return SCM_BOOL(SCM_NIMP (obj) && SCM_STRUCTP (obj) && SCM_I_ENTITYP (obj));
+  return SCM_BOOL(SCM_STRUCTP (obj) && SCM_I_ENTITYP (obj));
 }
 #undef FUNC_NAME
 
-GUILE_PROC (scm_operator_p, "operator?", 1, 0, 0, 
+SCM_DEFINE (scm_operator_p, "operator?", 1, 0, 0, 
             (SCM obj),
-            "")
+"")
 #define FUNC_NAME s_scm_operator_p
 {
-  return SCM_BOOL(SCM_NIMP (obj)
-                  && SCM_STRUCTP (obj)
+  return SCM_BOOL(SCM_STRUCTP (obj)
                   && SCM_I_OPERATORP (obj)
                   && !SCM_I_ENTITYP (obj));
 }
 #undef FUNC_NAME
 
-GUILE_PROC (scm_set_object_procedure_x, "set-object-procedure!", 2, 0, 0, 
+SCM_DEFINE (scm_set_object_procedure_x, "set-object-procedure!", 2, 0, 0, 
             (SCM obj, SCM proc),
-            "")
+"")
 #define FUNC_NAME s_scm_set_object_procedure_x
 {
-  SCM_ASSERT (SCM_NIMP (obj) && SCM_STRUCTP (obj)
+  SCM_ASSERT (SCM_STRUCTP (obj)
              && ((SCM_CLASS_FLAGS (obj) & SCM_CLASSF_OPERATOR)
                  || (SCM_I_ENTITYP (obj)
                      && !(SCM_OBJ_CLASS_FLAGS (obj)
@@ -393,7 +388,7 @@ GUILE_PROC (scm_set_object_procedure_x, "set-object-procedure!", 2, 0, 0,
              obj,
              SCM_ARG1,
               FUNC_NAME);
-  SCM_VALIDATE_PROC(2,proc);
+  SCM_VALIDATE_PROC (2,proc);
   if (SCM_I_ENTITYP (obj))
     SCM_ENTITY_PROCEDURE (obj) = proc;
   else
@@ -403,12 +398,12 @@ GUILE_PROC (scm_set_object_procedure_x, "set-object-procedure!", 2, 0, 0,
 #undef FUNC_NAME
 
 #ifdef GUILE_DEBUG
-GUILE_PROC (scm_object_procedure, "object-procedure", 1, 0, 0, 
+SCM_DEFINE (scm_object_procedure, "object-procedure", 1, 0, 0, 
             (SCM obj),
-            "")
+"")
 #define FUNC_NAME s_scm_object_procedure
 {
-  SCM_ASSERT (SCM_NIMP (obj) && SCM_STRUCTP (obj)
+  SCM_ASSERT (SCM_STRUCTP (obj)
              && ((SCM_CLASS_FLAGS (obj) & SCM_CLASSF_OPERATOR)
                  || SCM_I_ENTITYP (obj)),
              obj, SCM_ARG1, FUNC_NAME);
@@ -438,28 +433,28 @@ scm_i_make_class_object (SCM meta,
   return c;
 }
 
-GUILE_PROC (scm_make_class_object, "make-class-object", 2, 0, 0, 
+SCM_DEFINE (scm_make_class_object, "make-class-object", 2, 0, 0, 
             (SCM metaclass, SCM layout),
-            "")
+"")
 #define FUNC_NAME s_scm_make_class_object
 {
   unsigned long flags = 0;
-  SCM_VALIDATE_STRUCT(1,metaclass);
-  SCM_VALIDATE_STRING(2,layout);
+  SCM_VALIDATE_STRUCT (1,metaclass);
+  SCM_VALIDATE_STRING (2,layout);
   if (metaclass == scm_metaclass_operator)
     flags = SCM_CLASSF_OPERATOR;
   return scm_i_make_class_object (metaclass, layout, flags);
 }
 #undef FUNC_NAME
 
-GUILE_PROC (scm_make_subclass_object, "make-subclass-object", 2, 0, 0, 
+SCM_DEFINE (scm_make_subclass_object, "make-subclass-object", 2, 0, 0, 
             (SCM class, SCM layout),
-            "")
+"")
 #define FUNC_NAME s_scm_make_subclass_object
 {
   SCM pl;
-  SCM_VALIDATE_STRUCT(1,class);
-  SCM_VALIDATE_STRING(2,layout);
+  SCM_VALIDATE_STRUCT (1,class);
+  SCM_VALIDATE_STRING (2,layout);
   pl = SCM_STRUCT_DATA (class)[scm_vtable_index_layout];
   /* Convert symbol->string */
   pl = scm_makfromstr (SCM_CHARS (pl), (scm_sizet) SCM_LENGTH (pl), 0);
@@ -497,3 +492,9 @@ scm_init_objects ()
 
 #include "objects.x"
 }
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/