mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 13:00:26 +02:00
Code Activity

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

Browse source 
(scm_class_of): Look up port class in scm_port_class.
(SCM_IN_PCLASS_INDEX, SCM_OUT_PCLASS_INDEX,
SCM_INOUT_PCLASS_INDEX): Added.
This commit is contained in:
Mikael Djurfeldt 1999-07-24 11:36:30 +00:00
parent 0e8a8468a3
commit d0efbe6199
2 changed files with 12 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

7
libguile/objects.c
View file

@ -67,6 +67,7 @@ SCM scm_class_vector, scm_class_null;
SCM scm_class_integer, scm_class_real, scm_class_complex; SCM scm_class_integer, scm_class_real, scm_class_complex;
SCM scm_class_unknown; SCM scm_class_unknown;
SCM *scm_port_class = 0;
SCM *scm_smob_class = 0; SCM *scm_smob_class = 0;
SCM (*scm_make_extended_class) (char *type_name); SCM (*scm_make_extended_class) (char *type_name);
@ -139,7 +140,11 @@ scm_class_of (SCM x)
return scm_class_procedure_with_setter; return scm_class_procedure_with_setter;
case scm_tc7_port: 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: case scm_tc7_smob:
{ {
SCM type = SCM_TYP16 (x); SCM type = SCM_TYP16 (x);

6
libguile/objects.h
View file

@ -181,6 +181,11 @@ struct scm_metaclass_operator {
#define SCM_CLASS_OF(x) SCM_STRUCT_VTABLE (x) #define SCM_CLASS_OF(x) SCM_STRUCT_VTABLE (x)
#define SCM_OBJ_CLASS_REDEF(x) (SCM_STRUCT_VTABLE_DATA(x)[scm_si_redefined]) #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. */ /* Plugin proxy classes for basic types. */
extern SCM scm_metaclass_standard; extern SCM scm_metaclass_standard;
extern SCM scm_metaclass_operator; 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_vector, scm_class_null;
extern SCM scm_class_real, scm_class_complex, scm_class_integer; extern SCM scm_class_real, scm_class_complex, scm_class_integer;
extern SCM scm_class_unknown; extern SCM scm_class_unknown;
extern SCM *scm_port_class;
extern SCM *scm_smob_class; extern SCM *scm_smob_class;
/* Plugin Goops functions. */ /* Plugin Goops functions. */