* Unified ssymbols and msymbols to a single symbol type 'scm_tc7_symbol'.

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

diff --git a/libguile/objects.c b/libguile/objects.c
index 17d669b..3c70ea0 100644 (file)
--- a/libguile/objects.c
+++ b/libguile/objects.c
@@ -49,18 +49,21 @@
  * libguile.  See the comments in objects.h.
  */
 
-#include "_scm.h"
-
-#include "struct.h"
-#include "procprop.h"
-#include "chars.h"
-#include "keywords.h"
-#include "smob.h"
-#include "eval.h"
-#include "alist.h"
-
-#include "validate.h"
-#include "objects.h"
+#include "libguile/_scm.h"
+
+#include "libguile/struct.h"
+#include "libguile/procprop.h"
+#include "libguile/chars.h"
+#include "libguile/keywords.h"
+#include "libguile/smob.h"
+#include "libguile/eval.h"
+#include "libguile/alist.h"
+#include "libguile/ports.h"
+#include "libguile/strings.h"
+#include "libguile/vectors.h"
+
+#include "libguile/validate.h"
+#include "libguile/objects.h"
 \f
 
 SCM scm_metaclass_standard;
@@ -117,7 +120,7 @@ scm_class_of (SCM x)
          return scm_class_pair;
        case scm_tcs_closures:
          return scm_class_procedure;
-       case scm_tcs_symbols:
+       case scm_tc7_symbol:
          return scm_class_symbol;
        case scm_tc7_vector:
        case scm_tc7_wvect:
@@ -164,8 +167,8 @@ scm_class_of (SCM x)
            /* fall through to ports */
          }
        case scm_tc7_port:
-         return scm_port_class[(SCM_WRTNG & SCM_UNPACK_CAR (x)
-                                ? (SCM_RDNG & SCM_UNPACK_CAR (x)
+         return scm_port_class[(SCM_WRTNG & SCM_CELL_WORD_0 (x)
+                                ? (SCM_RDNG & SCM_CELL_WORD_0 (x)
                                    ? SCM_INOUT_PCLASS_INDEX | SCM_PTOBNUM (x)
                                    : SCM_OUT_PCLASS_INDEX | SCM_PTOBNUM (x))
                                 : SCM_IN_PCLASS_INDEX | SCM_PTOBNUM (x))];
@@ -176,7 +179,7 @@ scm_class_of (SCM x)
          else if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS)
            {
              /* Goops object */
-             if (SCM_OBJ_CLASS_REDEF (x) != SCM_BOOL_F)
+             if (! SCM_FALSEP (SCM_OBJ_CLASS_REDEF (x)))
                scm_change_object_class (x,
                                         SCM_CLASS_OF (x),         /* old */
                                         SCM_OBJ_CLASS_REDEF (x)); /* new */
@@ -273,8 +276,8 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
       if (SCM_NIMP (ls))
        do
          {
-           i += SCM_UNPACK (SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls)))
-                 [scm_si_hashsets + hashset]);
+           i += SCM_STRUCT_DATA (scm_class_of (SCM_CAR (ls)))
+                [scm_si_hashsets + hashset];
            ls = SCM_CDR (ls);
          }
        while (--j && SCM_NIMP (ls));
@@ -292,7 +295,7 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
        do
          {
            /* More arguments than specifiers => CLASS != ENV */
-           if (scm_class_of (SCM_CAR (ls)) != SCM_CAR (z))
+           if (! SCM_EQ_P (scm_class_of (SCM_CAR (ls)), SCM_CAR (z)))
              goto next_method;
            ls = SCM_CDR (ls);
            z = SCM_CDR (z);
@@ -387,7 +390,7 @@ SCM_DEFINE (scm_set_object_procedure_x, "set-object-procedure!", 2, 0, 0,
               FUNC_NAME);
   SCM_VALIDATE_PROC (2,proc);
   if (SCM_I_ENTITYP (obj))
-    SCM_ENTITY_PROCEDURE (obj) = proc;
+    SCM_SET_ENTITY_PROCEDURE (obj, proc);
   else
     SCM_OPERATOR_CLASS (obj)->procedure = proc;
   return SCM_UNSPECIFIED;
@@ -438,7 +441,7 @@ SCM_DEFINE (scm_make_class_object, "make-class-object", 2, 0, 0,
   unsigned long flags = 0;
   SCM_VALIDATE_STRUCT (1,metaclass);
   SCM_VALIDATE_STRING (2,layout);
-  if (metaclass == scm_metaclass_operator)
+  if (SCM_EQ_P (metaclass, scm_metaclass_operator))
     flags = SCM_CLASSF_OPERATOR;
   return scm_i_make_class_object (metaclass, layout, flags);
 }
@@ -452,7 +455,7 @@ SCM_DEFINE (scm_make_subclass_object, "make-subclass-object", 2, 0, 0,
   SCM pl;
   SCM_VALIDATE_STRUCT (1,class);
   SCM_VALIDATE_STRING (2,layout);
-  pl = SCM_STRUCT_DATA (class)[scm_vtable_index_layout];
+  pl = SCM_PACK (SCM_STRUCT_DATA (class) [scm_vtable_index_layout]);
   /* Convert symbol->string */
   pl = scm_makfromstr (SCM_CHARS (pl), (scm_sizet) SCM_LENGTH (pl), 0);
   return scm_i_make_class_object (SCM_STRUCT_VTABLE (class),
@@ -465,13 +468,11 @@ void
 scm_init_objects ()
 {
   SCM ms = scm_makfrom0str (SCM_METACLASS_STANDARD_LAYOUT);
-  SCM ml = scm_make_struct_layout (ms);
-  SCM mt = scm_make_vtable_vtable (ml, SCM_INUM0,
+  SCM mt = scm_make_vtable_vtable (ms, SCM_INUM0,
                                   SCM_LIST3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
   
   SCM os = scm_makfrom0str (SCM_METACLASS_OPERATOR_LAYOUT);
-  SCM ol = scm_make_struct_layout (os);
-  SCM ot = scm_make_vtable_vtable (ol, SCM_INUM0,
+  SCM ot = scm_make_vtable_vtable (os, SCM_INUM0,
                                   SCM_LIST3 (SCM_BOOL_F, SCM_EOL, SCM_EOL));
   
   SCM es = scm_makfrom0str (SCM_ENTITY_LAYOUT);
@@ -487,5 +488,11 @@ scm_init_objects ()
   SCM_SET_CLASS_DESTRUCTOR (et, scm_struct_free_entity);
   scm_sysintern ("<entity>", et);
 
-#include "objects.x"
+#include "libguile/objects.x"
 }
+
+/*
+  Local Variables:
+  c-file-style: "gnu"
+  End:
+*/