Back to index

plt-scheme  4.2.1
Classes | Defines | Typedefs | Functions
xcglue.h File Reference
#include "scheme.h"
This graph shows which files directly or indirectly include this file:

Go to the source code of this file.

Classes

struct  Scheme_Class_Object

Defines

#define POFFSET   1
#define THEOBJ   p[0]
#define objscheme_istype_mzstring   objscheme_istype_string
#define objscheme_istype_mzxstring   objscheme_istype_string
#define objscheme_istype_xpathname   objscheme_istype_pathname
#define objscheme_bundle_pstring   objscheme_bundle_bstring
#define objscheme_bundle_epathname   objscheme_bundle_pathname
#define objscheme_bundle_xpathname   objscheme_bundle_pathname
#define objscheme_unbundle_mzxstring(a, b)   (char *)objscheme_unbundle_mzstring(a, b)
#define objscheme_bundle_integer   scheme_make_integer
#define objscheme_bundle_long   objscheme_bundle_integer
#define objscheme_bundle_int   objscheme_bundle_integer
#define objscheme_bundle_ExactLong   scheme_make_integer_value
#define objscheme_bundle_double   scheme_make_double
#define objscheme_bundle_bool(x)   ((x) ? scheme_true : scheme_false)
#define objscheme_bundle_char   scheme_make_char
#define objscheme_bundle_pair   scheme_make_pair
#define objscheme_unbundle_long   objscheme_unbundle_integer
#define objscheme_unbundle_int   objscheme_unbundle_integer
#define OBJSCHEME_PRIM_METHOD(m, cf)   (SCHEME_PRIMP(m) && ((Scheme_Prim *)((Scheme_Primitive_Proc *)m)->prim_val == cf))
#define COPY_JMPBUF(dest, src)   memcpy(&dest, &src, sizeof(mz_jmp_buf));
#define METHODNAME(x, y)   y" in "x
#define string   xc_string
#define bstring   xc_bstring
#define pstring   xc_pstring
#define mzstring   xc_mzstring
#define mzxstring   xc_mzxstring
#define XC_SCHEME_NULL   scheme_false
#define XC_SCHEME_NULLP(x)   SCHEME_FALSEP(x)
#define XC_NULL_STR   "#f"
#define WXS_USE_ARGUMENT(x)
#define SETUP_VAR_STACK(n)   /* empty */
#define SETUP_VAR_STACK_REMEMBERED(n)   /* empty */
#define SETUP_VAR_STACK_PRE_REMEMBERED(n)   /* empty */
#define SETUP_PRE_VAR_STACK(n)   /* empty */
#define VAR_STACK_PUSH(p, var)   /* empty */
#define VAR_STACK_PUSH_ARRAY(p, var, n)   /* empty */
#define PRE_VAR_STACK_PUSH(p, var)   /* empty */
#define SET_VAR_STACK()   /* empty */
#define WITH_VAR_STACK(x)   x
#define REMEMBER_VAR_STACK()   /* empty */
#define WITH_REMEMBERED_STACK(x)   x
#define READY_TO_RETURN   /* empty */
#define READY_TO_PRE_RETURN   /* empty */
#define CONSTRUCTOR_ARGS(x)   x
#define CONSTRUCTOR_INIT(x)   x
#define ASSELF   /* empty */
#define SELF__   this
#define INIT_NULLED_OUT   /* empty */
#define INIT_NULLED_ARRAY(x)   /* empty */
#define INA_comma   /* empty */

Typedefs

typedef struct Scheme_Class_Object Scheme_Class_Object
typedef Scheme_Prim Scheme_Method_Prim
typedef long ExactLong
typedef Scheme_Object *(* Objscheme_Bundler )(void *)
typedef char byte
typedef unsigned char ubyte
typedef char * xc_string
typedef char * xc_bstring
typedef char * xc_pstring
typedef mzcharxc_mzstring
typedef char * xc_mzxstring
typedef const char * cstring
typedef const char * ncstring
typedef const char * cpstring
typedef const char * ncpstring
typedef const char * cbstring
typedef const char * ncbstring
typedef const mzcharcmzstring
typedef const mzcharncmzstring
typedef char * nstring
typedef char * npstring
typedef char * nbstring
typedef char * wbstring
typedef mzcharwmzstring
typedef char * pathname
typedef char * epathname
typedef char * npathname
typedef char * xpathname
typedef char * nxpathname
typedef char * nepathname
typedef const char * cpathname
typedef const char * cnpathname
typedef char * wpathname
typedef char * wnpathname
typedef long nnlong
typedef int nnint
typedef double nndouble

Functions

void scheme_install_xc_global (char *name, Scheme_Object *val, Scheme_Env *env)
Scheme_Objectscheme_lookup_xc_global (char *name, Scheme_Env *env)
void objscheme_init (Scheme_Env *)
Scheme_Objectobjscheme_def_prim_class (void *env, char *name, char *superclass, Scheme_Method_Prim *initf, int nmethods)
void objscheme_add_global_class (Scheme_Object *sclass, char *name, void *env)
void objscheme_add_global_interface (Scheme_Object *sclass, char *name, void *env)
void scheme_add_method_w_arity (Scheme_Object *c, const char *name, Scheme_Method_Prim *f, int mina, int maxa)
void scheme_add_method (Scheme_Object *c, const char *name, Scheme_Method_Prim *f)
void scheme_made_class (Scheme_Object *c)
Scheme_Objectscheme_class_to_interface (Scheme_Object *c, char *name)
Scheme_Objectscheme_make_uninited_object (Scheme_Object *sclass)
void objscheme_save_object (void *, Scheme_Object *)
Scheme_Class_Objectobjscheme_find_object (void *)
void objscheme_check_valid (Scheme_Object *sclass, const char *name, int n, Scheme_Object **argv)
int objscheme_is_shutdown (Scheme_Object *o)
void objscheme_register_primpointer (void *obj_addr, void *prim_ptr_address)
void objscheme_destroy (void *, Scheme_Object *obj)
Scheme_Objectobjscheme_find_method (Scheme_Object *obj, Scheme_Object *sclass, char *name, void **cache)
int objscheme_is_subclass (Scheme_Object *a, Scheme_Object *sup)
int objscheme_is_a (Scheme_Object *o, Scheme_Object *c)
Scheme_Objectobjscheme_unbox (Scheme_Object *, const char *where)
Scheme_Objectobjscheme_nullable_unbox (Scheme_Object *, const char *where)
Scheme_Objectobjscheme_box (Scheme_Object *)
void objscheme_set_box (Scheme_Object *, Scheme_Object *)
int objscheme_istype_bool (Scheme_Object *, const char *stopifbad)
int objscheme_istype_integer (Scheme_Object *, const char *stopifbad)
int objscheme_istype_number (Scheme_Object *, const char *stopifbad)
int objscheme_istype_ExactLong (Scheme_Object *, const char *stopifbad)
int objscheme_istype_double (Scheme_Object *, const char *stopifbad)
int objscheme_istype_pair (Scheme_Object *, const char *stopifbad)
int objscheme_istype_string (Scheme_Object *, const char *stopifbad)
int objscheme_istype_bstring (Scheme_Object *, const char *stopifbad)
int objscheme_istype_pstring (Scheme_Object *, const char *stopifbad)
int objscheme_istype_pathname (Scheme_Object *, const char *stopifbad)
int objscheme_istype_epathname (Scheme_Object *, const char *stopifbad)
int objscheme_istype_char (Scheme_Object *, const char *stopifbad)
int objscheme_istype_closed_prim (Scheme_Object *, const char *stopifbad)
int objscheme_istype_proc2 (Scheme_Object *, const char *stopifbad)
int objscheme_istype_box (Scheme_Object *, const char *stopifbad)
int objscheme_istype_nonnegative_symbol_integer (Scheme_Object *, const char *symname, const char *stopifbad)
int objscheme_istype_nonnegative_symbol_double (Scheme_Object *, const char *symname, const char *stopifbad)
Scheme_Objectobjscheme_car (Scheme_Object *, const char *where)
Scheme_Objectobjscheme_bundle_string (char *)
Scheme_Objectobjscheme_bundle_bstring (char *)
Scheme_Objectobjscheme_bundle_mzstring (mzchar *)
Scheme_Objectobjscheme_bundle_pathname (char *)
Scheme_Objectobjscheme_bundle_nonnegative_symbol_double (double d, const char *symname)
long objscheme_unbundle_integer (Scheme_Object *, const char *)
long objscheme_unbundle_integer_in (Scheme_Object *, long, long, const char *)
long objscheme_unbundle_nonnegative_integer (Scheme_Object *, const char *)
long objscheme_unbundle_nonnegative_symbol_integer (Scheme_Object *, const char *symname, const char *)
ExactLong objscheme_unbundle_ExactLong (Scheme_Object *, const char *)
double objscheme_unbundle_double (Scheme_Object *, const char *)
double objscheme_unbundle_double_in (Scheme_Object *, double, double, const char *)
double objscheme_unbundle_nonnegative_double (Scheme_Object *, const char *)
double objscheme_unbundle_nonnegative_symbol_double (Scheme_Object *, const char *symname, const char *)
int objscheme_unbundle_bool (Scheme_Object *, const char *)
char * objscheme_unbundle_string (Scheme_Object *, const char *)
char * objscheme_unbundle_bstring (Scheme_Object *, const char *)
char * objscheme_unbundle_pstring (Scheme_Object *, const char *)
mzcharobjscheme_unbundle_mzstring (Scheme_Object *, const char *)
char * objscheme_unbundle_mutable_bstring (Scheme_Object *, const char *)
mzcharobjscheme_unbundle_mutable_mzstring (Scheme_Object *, const char *)
char * objscheme_unbundle_nullable_string (Scheme_Object *, const char *)
char * objscheme_unbundle_nullable_bstring (Scheme_Object *, const char *)
char * objscheme_unbundle_nullable_pstring (Scheme_Object *, const char *)
mzcharobjscheme_unbundle_nullable_mzstring (Scheme_Object *, const char *)
char * objscheme_unbundle_pathname (Scheme_Object *, const char *)
char * objscheme_unbundle_nullable_pathname (Scheme_Object *, const char *)
char * objscheme_unbundle_write_pathname (Scheme_Object *, const char *)
char * objscheme_unbundle_nullable_write_pathname (Scheme_Object *, const char *)
char * objscheme_unbundle_epathname (Scheme_Object *, const char *)
char * objscheme_unbundle_nullable_epathname (Scheme_Object *, const char *)
char * objscheme_unbundle_xpathname (Scheme_Object *, const char *)
char * objscheme_unbundle_nullable_xpathname (Scheme_Object *, const char *)
mzchar objscheme_unbundle_char (Scheme_Object *, const char *)
void objscheme_install_bundler (Objscheme_Bundler f, long id)
Scheme_Objectobjscheme_bundle_by_type (void *realobj, long type)

Class Documentation

struct Scheme_Class_Object

Definition at line 26 of file xcglue.h.

Collaboration diagram for Scheme_Class_Object:
Class Members
void * __type
void * primdata
long primflag
Scheme_Object so

Define Documentation

#define ASSELF   /* empty */

Definition at line 287 of file xcglue.h.

#define bstring   xc_bstring

Definition at line 182 of file xcglue.h.

#define CONSTRUCTOR_ARGS (   x)    x

Definition at line 285 of file xcglue.h.

#define CONSTRUCTOR_INIT (   x)    x

Definition at line 286 of file xcglue.h.

#define COPY_JMPBUF (   dest,
  src 
)    memcpy(&dest, &src, sizeof(mz_jmp_buf));

Definition at line 163 of file xcglue.h.

#define INA_comma   /* empty */

Definition at line 291 of file xcglue.h.

#define INIT_NULLED_ARRAY (   x)    /* empty */

Definition at line 290 of file xcglue.h.

#define INIT_NULLED_OUT   /* empty */

Definition at line 289 of file xcglue.h.

#define METHODNAME (   x,
  y 
)    y" in "x

Definition at line 169 of file xcglue.h.

#define mzstring   xc_mzstring

Definition at line 184 of file xcglue.h.

#define mzxstring   xc_mzxstring

Definition at line 185 of file xcglue.h.

#define objscheme_bundle_bool (   x)    ((x) ? scheme_true : scheme_false)

Definition at line 154 of file xcglue.h.

Definition at line 155 of file xcglue.h.

Definition at line 153 of file xcglue.h.

Definition at line 113 of file xcglue.h.

Definition at line 152 of file xcglue.h.

Definition at line 151 of file xcglue.h.

Definition at line 149 of file xcglue.h.

Definition at line 150 of file xcglue.h.

Definition at line 156 of file xcglue.h.

Definition at line 110 of file xcglue.h.

Definition at line 114 of file xcglue.h.

Definition at line 95 of file xcglue.h.

Definition at line 96 of file xcglue.h.

Definition at line 99 of file xcglue.h.

#define OBJSCHEME_PRIM_METHOD (   m,
  cf 
)    (SCHEME_PRIMP(m) && ((Scheme_Prim *)((Scheme_Primitive_Proc *)m)->prim_val == cf))

Definition at line 161 of file xcglue.h.

Definition at line 159 of file xcglue.h.

Definition at line 158 of file xcglue.h.

#define objscheme_unbundle_mzxstring (   a,
  b 
)    (char *)objscheme_unbundle_mzstring(a, b)

Definition at line 131 of file xcglue.h.

#define POFFSET   1

Definition at line 36 of file xcglue.h.

#define PRE_VAR_STACK_PUSH (   p,
  var 
)    /* empty */

Definition at line 278 of file xcglue.h.

#define pstring   xc_pstring

Definition at line 183 of file xcglue.h.

#define READY_TO_PRE_RETURN   /* empty */

Definition at line 284 of file xcglue.h.

#define READY_TO_RETURN   /* empty */

Definition at line 283 of file xcglue.h.

#define REMEMBER_VAR_STACK ( )    /* empty */

Definition at line 281 of file xcglue.h.

#define SELF__   this

Definition at line 288 of file xcglue.h.

#define SET_VAR_STACK ( )    /* empty */

Definition at line 279 of file xcglue.h.

#define SETUP_PRE_VAR_STACK (   n)    /* empty */

Definition at line 275 of file xcglue.h.

#define SETUP_VAR_STACK (   n)    /* empty */

Definition at line 272 of file xcglue.h.

#define SETUP_VAR_STACK_PRE_REMEMBERED (   n)    /* empty */

Definition at line 274 of file xcglue.h.

#define SETUP_VAR_STACK_REMEMBERED (   n)    /* empty */

Definition at line 273 of file xcglue.h.

#define string   xc_string

Definition at line 181 of file xcglue.h.

#define THEOBJ   p[0]

Definition at line 37 of file xcglue.h.

#define VAR_STACK_PUSH (   p,
  var 
)    /* empty */

Definition at line 276 of file xcglue.h.

#define VAR_STACK_PUSH_ARRAY (   p,
  var,
 
)    /* empty */

Definition at line 277 of file xcglue.h.

#define WITH_REMEMBERED_STACK (   x)    x

Definition at line 282 of file xcglue.h.

#define WITH_VAR_STACK (   x)    x

Definition at line 280 of file xcglue.h.

#define WXS_USE_ARGUMENT (   x)

Definition at line 218 of file xcglue.h.

#define XC_NULL_STR   "#f"

Definition at line 213 of file xcglue.h.

Definition at line 211 of file xcglue.h.

#define XC_SCHEME_NULLP (   x)    SCHEME_FALSEP(x)

Definition at line 212 of file xcglue.h.


Typedef Documentation

typedef char byte

Definition at line 172 of file xcglue.h.

typedef const char* cbstring

Definition at line 188 of file xcglue.h.

Definition at line 189 of file xcglue.h.

typedef const char* cnpathname

Definition at line 203 of file xcglue.h.

typedef const char* cpathname

Definition at line 202 of file xcglue.h.

typedef const char* cpstring

Definition at line 187 of file xcglue.h.

typedef const char* cstring

Definition at line 186 of file xcglue.h.

typedef char* epathname

Definition at line 197 of file xcglue.h.

typedef long ExactLong

Definition at line 39 of file xcglue.h.

typedef char* nbstring

Definition at line 192 of file xcglue.h.

typedef const char * ncbstring

Definition at line 188 of file xcglue.h.

typedef const mzchar * ncmzstring

Definition at line 189 of file xcglue.h.

typedef const char * ncpstring

Definition at line 187 of file xcglue.h.

typedef const char * ncstring

Definition at line 186 of file xcglue.h.

typedef char* nepathname

Definition at line 201 of file xcglue.h.

typedef double nndouble

Definition at line 209 of file xcglue.h.

typedef int nnint

Definition at line 208 of file xcglue.h.

typedef long nnlong

Definition at line 207 of file xcglue.h.

typedef char* npathname

Definition at line 198 of file xcglue.h.

typedef char* npstring

Definition at line 191 of file xcglue.h.

typedef char* nstring

Definition at line 190 of file xcglue.h.

typedef char* nxpathname

Definition at line 200 of file xcglue.h.

Definition at line 165 of file xcglue.h.

typedef char* pathname

Definition at line 196 of file xcglue.h.

Definition at line 34 of file xcglue.h.

typedef unsigned char ubyte

Definition at line 174 of file xcglue.h.

typedef char* wbstring

Definition at line 193 of file xcglue.h.

typedef mzchar* wmzstring

Definition at line 194 of file xcglue.h.

typedef char* wnpathname

Definition at line 205 of file xcglue.h.

typedef char* wpathname

Definition at line 204 of file xcglue.h.

typedef char* xc_bstring

Definition at line 177 of file xcglue.h.

typedef mzchar* xc_mzstring

Definition at line 179 of file xcglue.h.

typedef char* xc_mzxstring

Definition at line 180 of file xcglue.h.

typedef char* xc_pstring

Definition at line 178 of file xcglue.h.

typedef char* xc_string

Definition at line 176 of file xcglue.h.

typedef char* xpathname

Definition at line 199 of file xcglue.h.


Function Documentation

void objscheme_add_global_class ( Scheme_Object sclass,
char *  name,
void env 
)

Definition at line 596 of file xcglue.c.

Here is the call graph for this function:

void objscheme_add_global_interface ( Scheme_Object sclass,
char *  name,
void env 
)

Definition at line 601 of file xcglue.c.

{
  /* do nothing */
}

Here is the caller graph for this function:

Definition at line 828 of file xcglue.c.

{
  return scheme_box(v);
}

Definition at line 841 of file xcglue.c.

{
  if (!s)
    return XC_SCHEME_NULL;
  else
    return scheme_make_byte_string(s);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Scheme_Object* objscheme_bundle_by_type ( void realobj,
long  type 
)

Definition at line 1419 of file xcglue.c.

{
  long i;

  i = id % bhashsize;
  while(bhash[i].id && bhash[i].id != id) {
    i = (i + bhashstep) % bhashsize;
  }

  if (!bhash[i].id)
    return NULL;

  return bhash[i].f(realobj);
}

Definition at line 857 of file xcglue.c.

{
  if (!s)
    return XC_SCHEME_NULL;
  else
    return scheme_make_char_string(s);
}

Here is the call graph for this function:

Scheme_Object* objscheme_bundle_nonnegative_symbol_double ( double  d,
const char *  symname 
)

Definition at line 865 of file xcglue.c.

{
  if (d < 0)
    return scheme_intern_symbol(symname);
  else
    return scheme_make_double(d);
}

Definition at line 849 of file xcglue.c.

{
  if (!s)
    return XC_SCHEME_NULL;
  else
    return scheme_make_path(s);
}

Here is the caller graph for this function:

Definition at line 833 of file xcglue.c.

{
  if (!s)
    return XC_SCHEME_NULL;
  else
    return scheme_make_utf8_string(s);
}

Here is the caller graph for this function:

Scheme_Object* objscheme_car ( Scheme_Object ,
const char *  where 
)

Definition at line 1213 of file xcglue.c.

{  
  (void)objscheme_istype_pair(obj, where);
  return scheme_car(obj);
}

Here is the call graph for this function:

void objscheme_check_valid ( Scheme_Object sclass,
const char *  name,
int  n,
Scheme_Object **  argv 
)

Definition at line 1311 of file xcglue.c.

{
  Scheme_Class_Object *obj = (Scheme_Class_Object *)argv[0];

  if (!SCHEME_STRUCTP((Scheme_Object *)obj)
      || !scheme_is_struct_instance(object_struct, (Scheme_Object *)obj)) {
    scheme_wrong_type(name ? name : "unbundle", "primitive object", 0, n, argv);
    return;
  }

  if (sclass) {
    Scheme_Object *osclass;
    osclass = scheme_struct_type_property_ref(object_property, (Scheme_Object *)obj);
    if (!objscheme_is_subclass(osclass, sclass)) {
      scheme_wrong_type(name ? name : "unbundle", ((Scheme_Class *)sclass)->name, 0, n, argv);
      return;
    }
  }

  if (SCHEME_FALSEP((Scheme_Object *)obj->primflag)) {
    scheme_signal_error("%s: object is not yet initialized: %V",
                     name ? name : "unbundle",
                     obj);
  }
  if (obj->primflag < 0) {
    scheme_signal_error("%s: %sobject%s: %V",
                     name ? name : "unbundle",
                     (obj->primflag == -1) ? "invalidated " : "",
                     (obj->primflag == -2) ? " (shutdown by a custodian)" : "",
                     obj);
    return;
  }
}

Here is the call graph for this function:

Scheme_Object* objscheme_def_prim_class ( void env,
char *  name,
char *  superclass,
Scheme_Method_Prim initf,
int  nmethods 
)

Definition at line 576 of file xcglue.c.

{
  Scheme_Object *obj;
  Scheme_Object *sclass;

  if (superclass)
    obj = scheme_lookup_xc_global(superclass, (Scheme_Env *) global_env);
  else
    obj = NULL;

  sclass = scheme_make_class(name, obj, initf, nmethods);

  scheme_install_xc_global(name, sclass, (Scheme_Env *) global_env);

  return sclass;
}

Here is the call graph for this function:

Definition at line 1352 of file xcglue.c.

{
#ifdef SUPPORT_ARBITRARY_OBJECTS
  int i;
#endif
  Scheme_Class_Object *obj;

  --num_objects_allocated;

  obj = (Scheme_Class_Object *)obj_in;

#ifdef SUPPORT_ARBITRARY_OBJECTS
  if (!obj) {
    i = HASH(realobj);
    if (i < 0)
      i = -i;
    
    while (NOT_SAME_PTR(hash[i].realobj, realobj) 
          || SAME_PTR(hash[i].realobj, GONE)) {
      if (!hash[i].realobj)
       break;
      i++;
      if (i >= hashsize)
       i = 0;
    }
    
    if (hash[i].realobj) {
      obj = hash[i].obj;
      hash[i].realobj = GONE;
    }
  }
#endif

  if (obj) {
    if (obj->primflag < 0)
      return;

    obj->primflag = -1;
    obj->primdata = NULL;
  }
}
Scheme_Object* objscheme_find_method ( Scheme_Object obj,
Scheme_Object sclass,
char *  name,
void **  cache 
)

Definition at line 606 of file xcglue.c.

{
  Scheme_Object *s, *p[2], *dispatcher;

  if (!obj)
    return NULL;

  dispatcher = scheme_struct_type_property_ref(dispatcher_property, (Scheme_Object *)obj);
  if (!dispatcher)
    return NULL;

  if (*cache)
    s = (Scheme_Object *)*cache;
  else {
    s = scheme_intern_symbol(name);
    p[0] = s;
    s = scheme_struct_type_property_ref(preparer_property, (Scheme_Object *)obj);
    if (!s)
      return NULL;
    s = scheme_apply(s, 1, p);
    scheme_register_extension_global((void *)cache, sizeof(Scheme_Object*));
    *cache = s;
  }

  p[0] = obj;
  p[1] = s;
  return _scheme_apply(dispatcher, 2, p);
}

Definition at line 491 of file xcglue.c.

{
  long i;

#ifdef SUPPORT_ARBITRARY_OBJECTS
  wxREGGLOB(hash);
  hash = (ObjectHash *)scheme_malloc_atomic(sizeof(ObjectHash) * hashsize);
  for (i = 0; i < hashsize; i++) {
    hash[i].realobj = NULL;
  }
#endif
  
  wxREGGLOB(bhash);
  bhash = (BundlerHash *)scheme_malloc_atomic(sizeof(BundlerHash) 
                                         * bhashsize);
  for (i = 0; i < bhashsize; i++) {
    bhash[i].id = 0;
  }

  objscheme_class_type = scheme_make_type("<primitive-class>");

  wxREGGLOB(object_property);
  object_property = scheme_make_struct_type_property(scheme_intern_symbol("primitive-object"));
  
  wxREGGLOB(preparer_property);
  preparer_property = scheme_make_struct_type_property(scheme_intern_symbol("primitive-preparer"));

  wxREGGLOB(dispatcher_property);
  dispatcher_property = scheme_make_struct_type_property(scheme_intern_symbol("primitive-dispatcher"));

  wxREGGLOB(object_struct);
  object_struct = scheme_make_struct_type(scheme_intern_symbol("primitive-object"), 
                                     NULL, NULL,
                                     0, 2 + EXTRA_PRIM_OBJECT_FIELD, NULL,
                                     NULL, NULL);
  
#ifdef MZ_PRECISE_GC
  GC_register_traversers(objscheme_class_type, gc_class_size, gc_class_mark, gc_class_fixup, 0, 0);
#endif

  scheme_install_xc_global("initialize-primitive-object",
                        scheme_make_prim_w_arity(init_prim_obj,
                                              "initialize-primitive-object",
                                              1, -1),
                        env);

  scheme_install_xc_global("primitive-class-prepare-struct-type!",
                        scheme_make_prim_w_arity(class_prepare_struct_type,
                                              "primitive-class-prepare-struct-type!",
                                              6, 6),
                        env);
  
  scheme_install_xc_global("primitive-class-find-method",
                        scheme_make_prim_w_arity(class_find_meth,
                                              "primitive-class-find-method",
                                              2, 2),
                        env);
  
  scheme_install_xc_global("primitive-class->superclass",
                        scheme_make_prim_w_arity(class_sup,
                                              "primitive-class->superclass",
                                              1, 1),
                        env);
  
  scheme_install_xc_global("primitive-class?",
                        scheme_make_prim_w_arity(class_p,
                                              "primitive-class?",
                                              1, 1),
                        env);

#if EXTRA_PRIM_OBJECT_FIELD
  scheme_install_xc_global("primitive-object-extra-get",
                        scheme_make_prim_w_arity(extra_get,
                                              "primitive-object-extra-get",
                                              1, 1),
                        env);
  
  scheme_install_xc_global("primitive-object-extra-set!",
                        scheme_make_prim_w_arity(extra_set,
                                              "primitive-object-extra-set!",
                                              2, 2),
                        env);  
#endif
}

Here is the call graph for this function:

Definition at line 1405 of file xcglue.c.

{
  long i;

  i = id % bhashsize;
  while(bhash[i].id && bhash[i].id != id) {
    i = (i + bhashstep) % bhashsize;
  }

  bhash[i].id = id;
  bhash[i].f = f;
  bhashcount++;
}

Here is the caller graph for this function:

Definition at line 823 of file tree.cxx.

{
  Scheme_Object *a;

  if (!SCHEME_STRUCTP(o) || !scheme_is_struct_instance(object_struct, o))
    return 0;

  a = scheme_struct_type_property_ref(object_property, o);
  
  while (a && (a != c)) {
    a = ((Objscheme_Class *)a)->sup;
  }

  return !!a;
}

Definition at line 1345 of file xcglue.c.

{
  Scheme_Class_Object *obj = (Scheme_Class_Object *)o;

  return (obj->primflag < 0);
}

Definition at line 429 of file xcglue.c.

{
  while (a && (a != b)) {
    a = ((Scheme_Class *)a)->sup;
  }

  return !!a;
}

Here is the caller graph for this function:

int objscheme_istype_bool ( Scheme_Object ,
const char *  stopifbad 
)

Definition at line 638 of file xcglue.c.

{
  return 1; /* Anything can be a boolean */
}

Here is the caller graph for this function:

int objscheme_istype_box ( Scheme_Object ,
const char *  stopifbad 
)

Definition at line 757 of file xcglue.c.

{
  if (SCHEME_BOXP(obj))
    return 1;
  else if (stopifbad)
    scheme_wrong_type(stopifbad, "box", -1, 0, &obj);
  return 0;
}

Here is the caller graph for this function:

int objscheme_istype_bstring ( Scheme_Object ,
const char *  stopifbad 
)

Definition at line 696 of file xcglue.c.

{
  if (SCHEME_BYTE_STRINGP(obj))
    return 1;
  else if (stopifbad)
    scheme_wrong_type(stopifbad, "byte string", -1, 0, &obj);
  return 0;
}

Here is the caller graph for this function:

int objscheme_istype_char ( Scheme_Object ,
const char *  stopifbad 
)

Definition at line 734 of file xcglue.c.

{
  if (SCHEME_CHARP(obj))
    return 1;
  else if (stopifbad)
    scheme_wrong_type(stopifbad, "character", -1, 0, &obj);
  return 0;
}

Here is the caller graph for this function:

int objscheme_istype_closed_prim ( Scheme_Object ,
const char *  stopifbad 
)

Definition at line 743 of file xcglue.c.

{
  if (SAME_TYPE(SCHEME_TYPE(obj), scheme_closed_prim_type))
    return 1;
  else if (stopifbad)
    scheme_wrong_type(stopifbad, "procedure", -1, 0, &obj);
  return 0;
}
int objscheme_istype_double ( Scheme_Object ,
const char *  stopifbad 
)

Definition at line 669 of file xcglue.c.

{
  if (SCHEME_DBLP(obj))
    return 1;
  else if (stopifbad)
    scheme_wrong_type(stopifbad, "inexact real number", -1, 0, &obj);
  return 0;
}
int objscheme_istype_epathname ( Scheme_Object ,
const char *  stopifbad 
)

Definition at line 725 of file xcglue.c.

{
  if (SCHEME_PATHP(obj))
    return 1;
  else if (stopifbad)
    scheme_wrong_type(stopifbad, "path", -1, 0, &obj);
  return 0;
}

Here is the caller graph for this function:

int objscheme_istype_ExactLong ( Scheme_Object ,
const char *  stopifbad 
)

Definition at line 653 of file xcglue.c.

{
  return objscheme_istype_integer(obj, stopifbad);
}

Here is the call graph for this function:

Here is the caller graph for this function:

int objscheme_istype_integer ( Scheme_Object ,
const char *  stopifbad 
)

Definition at line 643 of file xcglue.c.

{
  if (SCHEME_INTP(obj) || SCHEME_BIGNUMP(obj))
    return 1;
  else if (stopifbad) {
    scheme_wrong_type(stopifbad, "exact integer", -1, 0, &obj);
  }
  return 0;
}

Here is the caller graph for this function:

int objscheme_istype_nonnegative_symbol_double ( Scheme_Object ,
const char *  symname,
const char *  stopifbad 
)

Definition at line 796 of file xcglue.c.

{
  if (SCHEME_SYMBOLP(obj)) {
    int l;
    l = strlen(sym);
    if (SCHEME_SYM_LEN(obj) == l) {
      if (!strcmp(sym, SCHEME_SYM_VAL(obj))) {
       return 1;
      }
    }
  }

  if (objscheme_istype_number(obj, NULL)) {
    double v;
    v = objscheme_unbundle_double(obj, where);
    if (v >= 0)
      return 1;
  }

  if (where) {
    char *b;
    b = (char *)scheme_malloc_atomic(50);
    strcpy(b, "non-negative number or '");
    strcat(b, sym);
    scheme_wrong_type(where, b, -1, 0, &obj);
  }

  return 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

int objscheme_istype_nonnegative_symbol_integer ( Scheme_Object ,
const char *  symname,
const char *  stopifbad 
)

Definition at line 766 of file xcglue.c.

{
  if (SCHEME_SYMBOLP(obj)) {
    int l;
    l = strlen(sym);
    if (SCHEME_SYM_LEN(obj) == l) {
      if (!strcmp(sym, SCHEME_SYM_VAL(obj))) {
       return 1;
      }
    }
  }

  if (objscheme_istype_integer(obj, NULL)) {
    long v;
    v = objscheme_unbundle_integer(obj, where);
    if (v >= 0)
      return 1;
  }

  if (where) {
    char *b;
    b = (char *)scheme_malloc_atomic(50);
    strcpy(b, "non-negative exact integer or '");
    strcat(b, sym);
    scheme_wrong_type(where, b, -1, 0, &obj);
  }

  return 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

int objscheme_istype_number ( Scheme_Object ,
const char *  stopifbad 
)

Definition at line 658 of file xcglue.c.

{
  if (SCHEME_INTP(obj) || SCHEME_DBLP(obj) || SCHEME_BIGNUMP(obj)
      || SCHEME_RATIONALP(obj))
    return 1;
  else if (stopifbad) {
    scheme_wrong_type(stopifbad, "real number", -1, 0, &obj);
  }
  return 0;
}

Here is the caller graph for this function:

int objscheme_istype_pair ( Scheme_Object ,
const char *  stopifbad 
)

Definition at line 678 of file xcglue.c.

{
  if (SCHEME_PAIRP(obj))
    return 1;
  else if (stopifbad)
    scheme_wrong_type(stopifbad, "pair", -1, 0, &obj);
  return 0;
}

Here is the caller graph for this function:

int objscheme_istype_pathname ( Scheme_Object ,
const char *  stopifbad 
)

Definition at line 715 of file xcglue.c.

{
  if (SCHEME_PATHP(obj)
      || SCHEME_CHAR_STRINGP(obj))
    return 1;
  else if (stopifbad)
    scheme_wrong_type(stopifbad, "path or string", -1, 0, &obj);
  return 0;
}

Here is the caller graph for this function:

int objscheme_istype_proc2 ( Scheme_Object ,
const char *  stopifbad 
)

Definition at line 752 of file xcglue.c.

{
  return scheme_check_proc_arity(stopifbad, 2, -1, 0, &obj);
}

Here is the caller graph for this function:

int objscheme_istype_pstring ( Scheme_Object ,
const char *  stopifbad 
)

Definition at line 705 of file xcglue.c.

{
  if (SCHEME_BYTE_STRINGP(obj)
      || SCHEME_CHAR_STRINGP(obj))
    return 1;
  else if (stopifbad)
    scheme_wrong_type(stopifbad, "string or byte string", -1, 0, &obj);
  return 0;
}

Here is the caller graph for this function:

int objscheme_istype_string ( Scheme_Object ,
const char *  stopifbad 
)

Definition at line 687 of file xcglue.c.

{
  if (SCHEME_CHAR_STRINGP(obj))
    return 1;
  else if (stopifbad)
    scheme_wrong_type(stopifbad, "string", -1, 0, &obj);
  return 0;
}

Here is the caller graph for this function:

Definition at line 1225 of file xcglue.c.

{  
  if (!SCHEME_BOXP(obj)) {
    if (where)
      scheme_wrong_type(where, "box or " XC_NULL_STR, -1, 0, &obj);
    return NULL;
  } else
    return scheme_unbox(obj);
    
}

Here is the caller graph for this function:

void objscheme_register_primpointer ( void obj_addr,
void prim_ptr_address 
)

Definition at line 1394 of file xcglue.c.

{
#ifdef MZ_PRECISE_GC
  GC_finalization_weak_ptr((void **)prim_obj, (void **)prim_ptr_address - (void **)prim_obj);
#else
  GC_general_register_disappearing_link((void **)prim_ptr_address, NULL);
#endif
}

Here is the call graph for this function:

Definition at line 1238 of file xcglue.c.

{
  (void)objscheme_istype_box(b, "set-box!");
  SCHEME_PTR_VAL(b) = v;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Scheme_Object* objscheme_unbox ( Scheme_Object ,
const char *  where 
)

Definition at line 1219 of file xcglue.c.

{  
  (void)objscheme_istype_box(obj, where);
  return scheme_unbox(obj);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 1027 of file xcglue.c.

{  
  (void)objscheme_istype_bool(obj, where);
  return NOT_SAME_OBJ(obj, scheme_false);
}

Here is the call graph for this function:

char* objscheme_unbundle_bstring ( Scheme_Object ,
const char *   
)

Definition at line 1062 of file xcglue.c.

{
  (void)objscheme_istype_bstring(obj, where);
  return SCHEME_BYTE_STR_VAL(obj);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 1207 of file xcglue.c.

{
  (void)objscheme_istype_char(obj, where);
  return SCHEME_CHAR_VAL(obj);
}

Here is the call graph for this function:

Here is the caller graph for this function:

double objscheme_unbundle_double ( Scheme_Object ,
const char *   
)

Definition at line 958 of file xcglue.c.

{
  (void)objscheme_istype_number(obj, where);
  if (SCHEME_DBLP(obj))
    return SCHEME_DBL_VAL(obj);
  else if (SCHEME_RATIONALP(obj))
    return scheme_rational_to_double(obj);
  else if (SCHEME_BIGNUMP(obj))
    return scheme_bignum_to_double(obj);
  else
    return (double)SCHEME_INT_VAL(obj);
}

Here is the call graph for this function:

double objscheme_unbundle_double_in ( Scheme_Object ,
double  ,
double  ,
const char *   
)

Definition at line 994 of file xcglue.c.

{
  if (objscheme_istype_number(obj, NULL)) {
    double v;
    v = objscheme_unbundle_double(obj, stopifbad);
    if ((v >= minv) && (v <= maxv))
      return v;
  }

  if (stopifbad) {
    char buffer[100];
    sprintf(buffer, "real number in [%f, %f]", minv, maxv);
    scheme_wrong_type(stopifbad, buffer, -1, 0, &obj);
  }

  return 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

char* objscheme_unbundle_epathname ( Scheme_Object ,
const char *   
)

Definition at line 1087 of file xcglue.c.

{
  (void)objscheme_istype_epathname(obj, where);
  return SCHEME_PATH_VAL(obj);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 944 of file xcglue.c.

{
  long v;

  (void)objscheme_istype_integer(obj, where);
  if (!scheme_get_int_val(obj, &v)) {
    if (where)
      scheme_arg_mismatch(where, "argument integer is out of platform-specific bounds", obj);
  }

  return v;
}

Here is the call graph for this function:

Here is the caller graph for this function:

long objscheme_unbundle_integer ( Scheme_Object ,
const char *   
)

Definition at line 875 of file xcglue.c.

{
  (void)objscheme_istype_integer(obj, where);
  if (SCHEME_BIGNUMP(obj)) {
    if (SCHEME_PINT_VAL(obj) < 0)
      return -0xfffFFFF;
    else
      return 0xfffFFFF;
  } else
    return SCHEME_INT_VAL(obj);
}

Here is the call graph for this function:

long objscheme_unbundle_integer_in ( Scheme_Object ,
long  ,
long  ,
const char *   
)

Definition at line 902 of file xcglue.c.

{
  if (objscheme_istype_integer(obj, NULL)) {
    long v;
    v = objscheme_unbundle_integer(obj, stopifbad);
    if ((v >= minv) && (v <= maxv))
      return v;
  }

  if (stopifbad) {
    char buffer[100];
    sprintf(buffer, "exact integer in [%ld, %ld]", minv, maxv);
    scheme_wrong_type(stopifbad, buffer, -1, 0, &obj);
  }

  return 0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 1068 of file xcglue.c.

{
  if (!SCHEME_MUTABLE_BYTE_STRINGP(obj)) {
    scheme_wrong_type(where, "mutable byte string", -1, 0, &obj);
  }
  return SCHEME_BYTE_STR_VAL(obj);
}

Here is the caller graph for this function:

Definition at line 1054 of file xcglue.c.

{
  if (!SCHEME_MUTABLE_CHAR_STRINGP(obj)) {
    scheme_wrong_type(where, "mutable string", -1, 0, &obj);
  }
  return SCHEME_CHAR_STR_VAL(obj);
}

Definition at line 1048 of file xcglue.c.

{
  (void)objscheme_istype_string(obj, where);
  return SCHEME_CHAR_STR_VAL(obj);
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 1012 of file xcglue.c.

{
  if (objscheme_istype_number(obj, NULL)) {
    double v;
    v = objscheme_unbundle_double(obj, where);
    if (v >= 0)
      return v;
  }

  if (where)
    scheme_wrong_type(where, "non-negative number", -1, 0, &obj);

  return -1.0;
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 887 of file xcglue.c.

{
  if (objscheme_istype_integer(obj, NULL)) {
    long v;
    v = objscheme_unbundle_integer(obj, where);
    if (v >= 0)
      return v;
  }

  if (where)
    scheme_wrong_type(where, "non-negative exact integer", -1, 0, &obj);

  return -1;
}

Here is the call graph for this function:

Here is the caller graph for this function:

double objscheme_unbundle_nonnegative_symbol_double ( Scheme_Object ,
const char *  symname,
const char *   
)

Definition at line 971 of file xcglue.c.

{
  if (SCHEME_SYMBOLP(obj)) {
    int l;
    l = strlen(sym);
    if (SCHEME_SYM_LEN(obj) == l) {
      if (!strcmp(sym, SCHEME_SYM_VAL(obj))) {
       return -1;
      }
    }
  }

  if (objscheme_istype_number(obj, NULL)) {
    double v;
    v = objscheme_unbundle_double(obj, where);
    if (v >= 0)
      return v;
  }

  (void)objscheme_istype_nonnegative_symbol_double(obj, sym, where);
  return -1;
}

Here is the call graph for this function:

long objscheme_unbundle_nonnegative_symbol_integer ( Scheme_Object ,
const char *  symname,
const char *   
)

Definition at line 921 of file xcglue.c.

{
  if (SCHEME_SYMBOLP(obj)) {
    int l;
    l = strlen(sym);
    if (SCHEME_SYM_LEN(obj) == l) {
      if (!strcmp(sym, SCHEME_SYM_VAL(obj))) {
       return -1;
      }
    }
  }

  if (objscheme_istype_number(obj, NULL)) {
    long v;
    v = objscheme_unbundle_integer(obj, where);
    if (v >= 0)
      return v;
  }

  (void)objscheme_istype_nonnegative_symbol_integer(obj, sym, where);
  return -1;
}

Here is the call graph for this function:

Definition at line 1119 of file xcglue.c.

{
  if (XC_SCHEME_NULLP(obj))
    return NULL;
  else if (!where || SCHEME_BYTE_STRINGP(obj))
    return objscheme_unbundle_bstring(obj, where);
  else {
    scheme_wrong_type(where, "byte string or "  XC_NULL_STR, -1, 0, &obj);
    return NULL;
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 1181 of file xcglue.c.

{
  if (XC_SCHEME_NULLP(obj))
    return NULL;
  else if (!where || SCHEME_PATHP(obj))
    return objscheme_unbundle_epathname(obj, where);
  else  {
    scheme_wrong_type(where, "path or " XC_NULL_STR, -1, 0, &obj);
    return NULL;
  }
    
}

Here is the call graph for this function:

Definition at line 1131 of file xcglue.c.

{
  if (XC_SCHEME_NULLP(obj))
    return NULL;
  else if (!where || SCHEME_CHAR_STRINGP(obj))
    return objscheme_unbundle_mzstring(obj, where);
  else {
    scheme_wrong_type(where, "string or "  XC_NULL_STR, -1, 0, &obj);
    return NULL;
  }
}

Here is the call graph for this function:

Definition at line 1155 of file xcglue.c.

{
  if (XC_SCHEME_NULLP(obj))
    return NULL;
  else if (!where || SCHEME_PATHP(obj) || SCHEME_CHAR_STRINGP(obj))
    return objscheme_unbundle_pathname_guards(obj, where, SCHEME_GUARD_FILE_READ);
  else  {
    scheme_wrong_type(where, "path, string, or " XC_NULL_STR, -1, 0, &obj);
    return NULL;
  }
    
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 1143 of file xcglue.c.

{
  if (XC_SCHEME_NULLP(obj))
    return NULL;
  else if (!where || SCHEME_PATH_STRINGP(obj))
    return objscheme_unbundle_pstring(obj, where);
  else {
    scheme_wrong_type(where, SCHEME_PATH_STRING_STR " or "  XC_NULL_STR, -1, 0, &obj);
    return NULL;
  }
}

Here is the call graph for this function:

Definition at line 1107 of file xcglue.c.

{
  if (XC_SCHEME_NULLP(obj))
    return NULL;
  else if (!where || SCHEME_CHAR_STRINGP(obj))
    return objscheme_unbundle_string(obj, where);
  else {
    scheme_wrong_type(where, "string or "  XC_NULL_STR, -1, 0, &obj);
    return NULL;
  }
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 1194 of file xcglue.c.

{
  if (XC_SCHEME_NULLP(obj))
    return NULL;
  else if (!where || SCHEME_PATHP(obj) || SCHEME_CHAR_STRINGP(obj))
    return objscheme_unbundle_pathname_guards(obj, where, SCHEME_GUARD_FILE_WRITE);
  else  {
    scheme_wrong_type(where, "path, string, or " XC_NULL_STR, -1, 0, &obj);
    return NULL;
  }
    
}

Here is the call graph for this function:

Here is the caller graph for this function:

Definition at line 1168 of file xcglue.c.

{
  if (XC_SCHEME_NULLP(obj))
    return NULL;
  else if (SCHEME_PATHP(obj) || SCHEME_CHAR_STRINGP(obj))
    return objscheme_unbundle_xpathname(obj, NULL);
  else  if (where) {
    scheme_wrong_type(where, "path, string, or " XC_NULL_STR, -1, 0, &obj);
    return NULL;
  } else
    return NULL;
}

Here is the call graph for this function:

Here is the caller graph for this function:

char* objscheme_unbundle_pathname ( Scheme_Object ,
const char *   
)

Definition at line 1082 of file xcglue.c.

Here is the call graph for this function:

Here is the caller graph for this function:

char* objscheme_unbundle_pstring ( Scheme_Object ,
const char *   
)

Definition at line 1040 of file xcglue.c.

Here is the call graph for this function:

Here is the caller graph for this function:

char* objscheme_unbundle_string ( Scheme_Object ,
const char *   
)

Definition at line 1033 of file xcglue.c.

Here is the call graph for this function:

Definition at line 1102 of file xcglue.c.

Here is the call graph for this function:

Here is the caller graph for this function:

char* objscheme_unbundle_xpathname ( Scheme_Object ,
const char *   
)

Definition at line 1093 of file xcglue.c.

{
  (void)objscheme_istype_xpathname(obj, where);
  if (!SCHEME_PATHP(obj))
    obj = scheme_char_string_to_path(obj);

  return SCHEME_PATH_VAL(obj);
}

Here is the call graph for this function:

Here is the caller graph for this function:

void scheme_add_method ( Scheme_Object c,
const char *  name,
Scheme_Method_Prim f 
)

Definition at line 413 of file xcglue.c.

{
  scheme_add_method_w_arity(c, name, f, 0, -1);
}

Here is the call graph for this function:

void scheme_add_method_w_arity ( Scheme_Object c,
const char *  name,
Scheme_Method_Prim f,
int  mina,
int  maxa 
)

Definition at line 388 of file xcglue.c.

{
  Scheme_Object *s;
  Scheme_Class *sclass;
  int count;

  sclass = (Scheme_Class *)c;

  s = scheme_make_prim_w_arity(f, name, mina + 1, (maxa < 0) ? -1 : (maxa + 1));
  scheme_prim_is_method(s);

  sclass->methods[sclass->num_installed] = s;

  count = strlen(name);
  if ((count > 7) && !strcmp(name + count - 7, " method"))
    count -= 7;
  s = scheme_intern_exact_symbol(name, count);

  sclass->names[sclass->num_installed] = s;

  sclass->num_installed++;
}

Definition at line 424 of file xcglue.c.

{
  return scheme_false;
}

Here is the caller graph for this function:

void scheme_install_xc_global ( char *  name,
Scheme_Object val,
Scheme_Env env 
)

Definition at line 164 of file wxscheme.cxx.

    {
      scheme_add_global(name, val, env);
    }

Here is the caller graph for this function:

Scheme_Object* scheme_lookup_xc_global ( char *  name,
Scheme_Env env 
)

Definition at line 169 of file wxscheme.cxx.

Here is the caller graph for this function:

Definition at line 419 of file xcglue.c.

{
  /* done */
}

Definition at line 310 of file xcglue.c.

{
  Scheme_Object *obj;
  Scheme_Object *stype;

  stype = ((Scheme_Class *)sclass)->struct_type;
  if (!stype) {
    scheme_arg_mismatch("make-primitive-object",
                     "struct-type not yet prepared: ",
                     sclass);
    return NULL;
  }

  obj = scheme_make_struct_instance(stype, 0, NULL);

  return obj;  
}