* objects.c, objects.h (scm_port_class): Added.

(scm_class_of): Look up port class in scm_port_class.
(SCM_IN_PCLASS_INDEX, SCM_OUT_PCLASS_INDEX,
SCM_INOUT_PCLASS_INDEX): Added.

diff --git a/libguile/objects.c b/libguile/objects.c
index 245d042..e118174 100644 (file)
--- a/libguile/objects.c
+++ b/libguile/objects.c
@@ -67,6 +67,7 @@ SCM scm_class_vector, scm_class_null;
 SCM scm_class_integer, scm_class_real, scm_class_complex;
 SCM scm_class_unknown;
 
+SCM *scm_port_class = 0;
 SCM *scm_smob_class = 0;
 
 SCM (*scm_make_extended_class) (char *type_name);
@@ -139,7 +140,11 @@ scm_class_of (SCM x)
          return scm_class_procedure_with_setter;
 
        case scm_tc7_port:
-         return scm_class_unknown;
+         return scm_port_class[(SCM_CAR (x) | SCM_WRTNG
+                                ? (SCM_CAR (x) | SCM_RDNG
+                                   ? SCM_INOUT_PCLASS_INDEX | SCM_PTOBNUM (x)
+                                   : SCM_OUT_PCLASS_INDEX | SCM_PTOBNUM (x))
+                                : SCM_IN_PCLASS_INDEX | SCM_PTOBNUM (x))];
        case scm_tc7_smob:
          {
            SCM type = SCM_TYP16 (x);

diff --git a/libguile/objects.h b/libguile/objects.h
index b0c5d7e..9dc6c2a 100644 (file)
--- a/libguile/objects.h
+++ b/libguile/objects.h
@@ -181,6 +181,11 @@ struct scm_metaclass_operator {
 #define SCM_CLASS_OF(x)        SCM_STRUCT_VTABLE (x)
 #define SCM_OBJ_CLASS_REDEF(x) (SCM_STRUCT_VTABLE_DATA(x)[scm_si_redefined])
 
+/* Port classes */
+#define SCM_IN_PCLASS_INDEX    0x000
+#define SCM_OUT_PCLASS_INDEX   0x100
+#define SCM_INOUT_PCLASS_INDEX 0x200
+
 /* Plugin proxy classes for basic types. */
 extern SCM scm_metaclass_standard;
 extern SCM scm_metaclass_operator;
@@ -190,6 +195,7 @@ extern SCM scm_class_procedure_with_setter;
 extern SCM scm_class_vector, scm_class_null;
 extern SCM scm_class_real, scm_class_complex, scm_class_integer;
 extern SCM scm_class_unknown;
+extern SCM *scm_port_class;
 extern SCM *scm_smob_class;
 
 /* Plugin Goops functions. */