mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-15 16:20:17 +02:00
Code Activity

* objects.c (scm_class_of): Treat scm_tc16_port_with_ps as ports.

Browse source
This commit is contained in:
Mikael Djurfeldt 1999-08-24 02:10:47 +00:00
parent f99c9c2824
commit 55d5475044
1 changed files with 9 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

16
libguile/objects.c
View file

@ -142,12 +142,6 @@ scm_class_of (SCM x)
case scm_tc7_pws: case scm_tc7_pws:
return scm_class_procedure_with_setter; return scm_class_procedure_with_setter;
case scm_tc7_port:
return scm_port_class[(SCM_WRTNG & SCM_CAR (x)
? (SCM_RDNG & SCM_CAR (x)
? 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);
@ -158,9 +152,17 @@ scm_class_of (SCM x)
else else
return scm_class_real; return scm_class_real;
} }
else else if (type != scm_tc16_port_with_ps)
return scm_smob_class[SCM_TC2SMOBNUM (type)]; 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)
? SCM_INOUT_PCLASS_INDEX | SCM_PTOBNUM (x)
: SCM_OUT_PCLASS_INDEX | SCM_PTOBNUM (x))
: SCM_IN_PCLASS_INDEX | SCM_PTOBNUM (x))];
case scm_tcs_cons_gloc: case scm_tcs_cons_gloc:
/* must be a struct */ /* must be a struct */
if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS_VALID) if (SCM_OBJ_CLASS_FLAGS (x) & SCM_CLASSF_GOOPS_VALID)