mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 22:10:21 +02:00
Code Activity

* tag.c: (scm_tag): deprecation expired - removed.

Browse source
This commit is contained in:
Rob Browning 2001-04-28 17:29:31 +00:00
parent 61fa6c373f
commit a0ea0f6515
1 changed files with 0 additions and 125 deletions
Download patch file Download diff file Expand all files Collapse all files

125
libguile/tag.c
View file

@ -90,133 +90,8 @@ CONST_INUM (scm_utag_port_base, "utag_port_base", 253);
CONST_INUM (scm_utag_flag_base, "utag_flag_base", 254);
CONST_INUM (scm_utag_struct_base, "utag_struct_base", 255);
#if (SCM_DEBUG_DEPRECATED == 0)
SCM_DEFINE (scm_tag, "tag", 1, 0, 0,
(SCM x),
"Return an integer corresponding to the type of X. Deprecated.")
#define FUNC_NAME s_scm_tag
{
switch (SCM_ITAG3 (x))
{
case scm_tc3_int_1:
case scm_tc3_int_2:
return SCM_CDR (scm_utag_immediate_integer) ;
case scm_tc3_imm24:
if (SCM_CHARP (x))
return SCM_CDR (scm_utag_immediate_char) ;
else
{
SCM tag = SCM_MAKINUM ((SCM_UNPACK (x) >> 8) & 0xff);
return SCM_MAKINUM (SCM_INUM (SCM_CDR (scm_utag_flag_base) ) | (SCM_UNPACK (tag) << 8));
}
case scm_tc3_cons:
switch (SCM_TYP7 (x))
{
case scm_tcs_cons_nimcar:
return SCM_CDR (scm_utag_pair) ;
case scm_tcs_closures:
return SCM_CDR (scm_utag_closure) ;
case scm_tc7_symbol:
return SCM_CDR (scm_utag_symbol) ;
case scm_tc7_vector:
return SCM_CDR (scm_utag_vector) ;
case scm_tc7_wvect:
return SCM_CDR (scm_utag_wvect) ;
#ifdef HAVE_ARRAYS
case scm_tc7_bvect:
return SCM_CDR (scm_utag_bvect) ;
case scm_tc7_byvect:
return SCM_CDR (scm_utag_byvect) ;
case scm_tc7_svect:
return SCM_CDR (scm_utag_svect) ;
case scm_tc7_ivect:
return SCM_CDR (scm_utag_ivect) ;
case scm_tc7_uvect:
return SCM_CDR (scm_utag_uvect) ;
case scm_tc7_fvect:
return SCM_CDR (scm_utag_fvect) ;
case scm_tc7_dvect:
return SCM_CDR (scm_utag_dvect) ;
case scm_tc7_cvect:
return SCM_CDR (scm_utag_cvect) ;
#endif
case scm_tc7_string:
return SCM_CDR (scm_utag_string) ;
case scm_tc7_substring:
return SCM_CDR (scm_utag_substring) ;
case scm_tc7_asubr:
return SCM_CDR (scm_utag_asubr) ;
case scm_tc7_subr_0:
return SCM_CDR (scm_utag_subr_0) ;
case scm_tc7_subr_1:
return SCM_CDR (scm_utag_subr_1) ;
case scm_tc7_cxr:
return SCM_CDR (scm_utag_cxr) ;
case scm_tc7_subr_3:
return SCM_CDR (scm_utag_subr_3) ;
case scm_tc7_subr_2:
return SCM_CDR (scm_utag_subr_2) ;
case scm_tc7_rpsubr:
return SCM_CDR (scm_utag_rpsubr) ;
case scm_tc7_subr_1o:
return SCM_CDR (scm_utag_subr_1o) ;
case scm_tc7_subr_2o:
return SCM_CDR (scm_utag_subr_2o) ;
case scm_tc7_lsubr_2:
return SCM_CDR (scm_utag_lsubr_2) ;
case scm_tc7_lsubr:
return SCM_CDR (scm_utag_lsubr) ;
case scm_tc7_port:
{
int tag;
tag = (SCM_TYP16 (x) >> 8) & 0xff;
return SCM_MAKINUM (SCM_INUM (SCM_CDR (scm_utag_port_base)) | (tag << 8));
}
case scm_tc7_smob:
{
int tag;
tag = (SCM_TYP16 (x) >> 8) & 0xff;
return SCM_MAKINUM (SCM_INUM (SCM_CDR (scm_utag_smob_base))
| (tag << 8));
}
case scm_tcs_cons_gloc:
/* must be a struct */
{
int tag = (int) SCM_STRUCT_VTABLE_DATA (x) >> 3;
return SCM_MAKINUM (SCM_INUM (SCM_CDR (scm_utag_struct_base))
| (tag << 8));
}
default:
if (SCM_CONSP (x))
return SCM_CDR (scm_utag_pair);
else
return SCM_MAKINUM (-1);
}
case scm_tc3_cons_gloc:
case scm_tc3_tc7_1:
case scm_tc3_tc7_2:
case scm_tc3_closure:
/* Never reached */
break;
}
return SCM_MAKINUM (-1);
}
#undef FUNC_NAME
#endif /* SCM_DEBUG_DEPRECATED == 0 */
void
scm_init_tag ()
{