diff --git a/libguile/objects.c b/libguile/objects.c index 245d042d8..e1181745e 100644 --- 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 b0c5d7e56..9dc6c2a67 100644 --- 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. */