* 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 17c852f..3c70ea0 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
@@ -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 "scm_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;
@@ -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
        {
@@ -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:
@@ -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_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))];
@@ -183,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 */
@@ -280,8 +276,8 @@ scm_mcache_lookup_cmethod (SCM cache, SCM args)
       if (SCM_NIMP (ls))
        do
          {
-           i += (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));
@@ -299,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);
@@ -392,9 +388,9 @@ SCM_DEFINE (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;
+    SCM_SET_ENTITY_PROCEDURE (obj, proc);
   else
     SCM_OPERATOR_CLASS (obj)->procedure = proc;
   return SCM_UNSPECIFIED;
@@ -443,9 +439,9 @@ SCM_DEFINE (scm_make_class_object, "make-class-object", 2, 0, 0,
 #define FUNC_NAME s_scm_make_class_object
 {
   unsigned long flags = 0;
-  SCM_VALIDATE_STRUCT(1,metaclass);
-  SCM_VALIDATE_STRING(2,layout);
-  if (metaclass == scm_metaclass_operator)
+  SCM_VALIDATE_STRUCT (1,metaclass);
+  SCM_VALIDATE_STRING (2,layout);
+  if (SCM_EQ_P (metaclass, scm_metaclass_operator))
     flags = SCM_CLASSF_OPERATOR;
   return scm_i_make_class_object (metaclass, layout, flags);
 }
@@ -457,9 +453,9 @@ SCM_DEFINE (scm_make_subclass_object, "make-subclass-object", 2, 0, 0,
 #define FUNC_NAME s_scm_make_subclass_object
 {
   SCM pl;
-  SCM_VALIDATE_STRUCT(1,class);
-  SCM_VALIDATE_STRING(2,layout);
-  pl = SCM_STRUCT_DATA (class)[scm_vtable_index_layout];
+  SCM_VALIDATE_STRUCT (1,class);
+  SCM_VALIDATE_STRING (2,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),
@@ -472,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);
@@ -494,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:
+*/