Back to index

plt-scheme  4.2.1
xcglue.h
Go to the documentation of this file.
00001 
00002 #ifndef OBJ_SCHEME_H
00003 #define OBJ_SCHEME_H
00004 
00005 #include "scheme.h"
00006 
00007 #ifdef __cplusplus
00008 extern "C" 
00009 {
00010 #endif
00011 
00012 /* Provided by the embedding client: */
00013 void scheme_install_xc_global(char *name, Scheme_Object *val, Scheme_Env *env);
00014 Scheme_Object *scheme_lookup_xc_global(char *name, Scheme_Env *env);
00015 
00016 /* initialization: */
00017 void objscheme_init(Scheme_Env *);
00018 
00019 /******************************************************************/
00020 /*                   Utilites used by xctocc                      */
00021 /******************************************************************/
00022 
00023   /* >>>>>>>>>>>> WARNING <<<<<<<<<<<<<<
00024      The following struct declaration is crafted to
00025      overlay over a Scheme_Structure. */
00026 typedef struct Scheme_Class_Object {
00027   Scheme_Object so; /* scheme_structure_type */
00028   void *__type; /* struct type */
00029   long primflag; /* field 0 */
00030   void *primdata; /* field 1 */
00031   /* ... */
00032 } Scheme_Class_Object;
00033   
00034 typedef Scheme_Prim Scheme_Method_Prim;
00035 
00036 #define POFFSET 1
00037 #define THEOBJ p[0]
00038 
00039 typedef long ExactLong;
00040 
00041 void objscheme_init(Scheme_Env *env);
00042 
00043 /* Defining a primitive class: */
00044 Scheme_Object *
00045 objscheme_def_prim_class(void *env, char *name, char *superclass,
00046                       Scheme_Method_Prim *initf, int nmethods);
00047 void objscheme_add_global_class(Scheme_Object *sclass, char *name,
00048                             void *env);
00049 void objscheme_add_global_interface(Scheme_Object *sclass, char *name,
00050                                 void *env);
00051 
00052 void scheme_add_method_w_arity(Scheme_Object *c, const char *name,
00053                             Scheme_Method_Prim *f, 
00054                             int mina, int maxa);
00055 void scheme_add_method(Scheme_Object *c, const char *name,
00056                      Scheme_Method_Prim *f);
00057 void scheme_made_class(Scheme_Object *c);
00058 Scheme_Object* scheme_class_to_interface(Scheme_Object *c, char *name);
00059 
00060 Scheme_Object *scheme_make_uninited_object(Scheme_Object *sclass);
00061 
00062 /* Maintaining the Scheme - C++ connection */
00063 void objscheme_save_object(void *, Scheme_Object *);
00064 Scheme_Class_Object *objscheme_find_object(void *);
00065 void objscheme_check_valid(Scheme_Object *sclass, const char *name, int n, Scheme_Object **argv);
00066 int objscheme_is_shutdown(Scheme_Object *o);
00067 
00068 void objscheme_register_primpointer(void *obj_addr, void *prim_ptr_address);
00069 
00070 void objscheme_destroy(void *, Scheme_Object *obj);
00071 
00072 /* Finding a method: */
00073 Scheme_Object *objscheme_find_method(Scheme_Object *obj, 
00074                                  Scheme_Object *sclass,
00075                                  char *name, 
00076                                  void **cache);
00077 
00078 int objscheme_is_subclass(Scheme_Object *a, Scheme_Object *sup);
00079 int objscheme_is_a(Scheme_Object *o, Scheme_Object *c);
00080 
00081 Scheme_Object *objscheme_unbox(Scheme_Object *, const char *where);
00082 Scheme_Object *objscheme_nullable_unbox(Scheme_Object *, const char *where);
00083 Scheme_Object *objscheme_box(Scheme_Object *);
00084 void objscheme_set_box(Scheme_Object *, Scheme_Object *);
00085 
00086 int objscheme_istype_bool(Scheme_Object *, const char *stopifbad);
00087 int objscheme_istype_integer(Scheme_Object *, const char *stopifbad);
00088 int objscheme_istype_number(Scheme_Object *, const char *stopifbad);
00089 int objscheme_istype_ExactLong(Scheme_Object *, const char *stopifbad);
00090 int objscheme_istype_double(Scheme_Object *, const char *stopifbad);
00091 int objscheme_istype_pair(Scheme_Object *, const char *stopifbad);
00092 int objscheme_istype_string(Scheme_Object *, const char *stopifbad);
00093 int objscheme_istype_bstring(Scheme_Object *, const char *stopifbad);
00094 int objscheme_istype_pstring(Scheme_Object *, const char *stopifbad);
00095 #define objscheme_istype_mzstring objscheme_istype_string
00096 #define objscheme_istype_mzxstring objscheme_istype_string
00097 int objscheme_istype_pathname(Scheme_Object *, const char *stopifbad);
00098 int objscheme_istype_epathname(Scheme_Object *, const char *stopifbad);
00099 #define objscheme_istype_xpathname objscheme_istype_pathname
00100 int objscheme_istype_char(Scheme_Object *, const char *stopifbad);
00101 int objscheme_istype_closed_prim(Scheme_Object *, const char *stopifbad);
00102 int objscheme_istype_proc2(Scheme_Object *, const char *stopifbad);
00103 int objscheme_istype_box(Scheme_Object *, const char *stopifbad);
00104 int objscheme_istype_nonnegative_symbol_integer(Scheme_Object *, const char *symname, const char *stopifbad);
00105 int objscheme_istype_nonnegative_symbol_double(Scheme_Object *, const char *symname, const char *stopifbad);
00106 
00107 Scheme_Object *objscheme_car(Scheme_Object *, const char *where);
00108 Scheme_Object *objscheme_bundle_string(char *);
00109 Scheme_Object *objscheme_bundle_bstring(char *);
00110 #define objscheme_bundle_pstring objscheme_bundle_bstring
00111 Scheme_Object *objscheme_bundle_mzstring(mzchar *);
00112 Scheme_Object *objscheme_bundle_pathname(char *);
00113 #define objscheme_bundle_epathname objscheme_bundle_pathname
00114 #define objscheme_bundle_xpathname objscheme_bundle_pathname
00115 Scheme_Object *objscheme_bundle_nonnegative_symbol_double(double d, const char *symname);
00116 
00117 long objscheme_unbundle_integer(Scheme_Object *, const char *);
00118 long objscheme_unbundle_integer_in(Scheme_Object *, long, long, const char *);
00119 long objscheme_unbundle_nonnegative_integer(Scheme_Object *, const char *);
00120 long objscheme_unbundle_nonnegative_symbol_integer(Scheme_Object *, const char *symname, const char *);
00121 ExactLong objscheme_unbundle_ExactLong(Scheme_Object *, const char *);
00122 double objscheme_unbundle_double(Scheme_Object *, const char *);
00123 double objscheme_unbundle_double_in(Scheme_Object *, double, double, const char *);
00124 double objscheme_unbundle_nonnegative_double(Scheme_Object *, const char *);
00125 double objscheme_unbundle_nonnegative_symbol_double(Scheme_Object *, const char *symname, const char *);
00126 int objscheme_unbundle_bool(Scheme_Object *, const char *);
00127 char *objscheme_unbundle_string(Scheme_Object *, const char *);
00128 char *objscheme_unbundle_bstring(Scheme_Object *, const char *);
00129 char *objscheme_unbundle_pstring(Scheme_Object *, const char *);
00130 mzchar *objscheme_unbundle_mzstring(Scheme_Object *, const char *);
00131 #define objscheme_unbundle_mzxstring(a, b) (char *)objscheme_unbundle_mzstring(a, b)
00132 mzchar *objscheme_unbundle_mzstring(Scheme_Object *, const char *);
00133 char *objscheme_unbundle_mutable_bstring(Scheme_Object *, const char *);
00134 mzchar *objscheme_unbundle_mutable_mzstring(Scheme_Object *, const char *);
00135 char *objscheme_unbundle_nullable_string(Scheme_Object *, const char *);
00136 char *objscheme_unbundle_nullable_bstring(Scheme_Object *, const char *);
00137 char *objscheme_unbundle_nullable_pstring(Scheme_Object *, const char *);
00138 mzchar *objscheme_unbundle_nullable_mzstring(Scheme_Object *, const char *);
00139 char *objscheme_unbundle_pathname(Scheme_Object *, const char *);
00140 char *objscheme_unbundle_nullable_pathname(Scheme_Object *, const char *);
00141 char *objscheme_unbundle_write_pathname(Scheme_Object *, const char *);
00142 char *objscheme_unbundle_nullable_write_pathname(Scheme_Object *, const char *);
00143 char *objscheme_unbundle_epathname(Scheme_Object *, const char *);
00144 char *objscheme_unbundle_nullable_epathname(Scheme_Object *, const char *);
00145 char *objscheme_unbundle_xpathname(Scheme_Object *, const char *);
00146 char *objscheme_unbundle_nullable_xpathname(Scheme_Object *, const char *);
00147 mzchar objscheme_unbundle_char(Scheme_Object *, const char *);
00148 
00149 #define objscheme_bundle_integer scheme_make_integer
00150 #define objscheme_bundle_long objscheme_bundle_integer
00151 #define objscheme_bundle_int objscheme_bundle_integer
00152 #define objscheme_bundle_ExactLong scheme_make_integer_value
00153 #define objscheme_bundle_double scheme_make_double
00154 #define objscheme_bundle_bool(x) ((x) ? scheme_true : scheme_false)
00155 #define objscheme_bundle_char scheme_make_char
00156 #define objscheme_bundle_pair scheme_make_pair
00157 
00158 #define objscheme_unbundle_long objscheme_unbundle_integer
00159 #define objscheme_unbundle_int objscheme_unbundle_integer
00160 
00161 #define OBJSCHEME_PRIM_METHOD(m, cf) (SCHEME_PRIMP(m) && ((Scheme_Prim *)((Scheme_Primitive_Proc *)m)->prim_val == cf))
00162 
00163 #define COPY_JMPBUF(dest, src) memcpy(&dest, &src, sizeof(mz_jmp_buf));
00164 
00165 typedef Scheme_Object *(*Objscheme_Bundler)(void *);
00166 void objscheme_install_bundler(Objscheme_Bundler f, long id);
00167 Scheme_Object *objscheme_bundle_by_type(void *realobj, long type);
00168 
00169 #define METHODNAME(x, y) y" in "x
00170 
00171 #ifndef _MSC_VER
00172 typedef char byte;
00173 #endif
00174 typedef unsigned char ubyte;
00175 
00176 typedef char *xc_string;
00177 typedef char *xc_bstring;
00178 typedef char *xc_pstring;
00179 typedef mzchar *xc_mzstring;
00180 typedef char *xc_mzxstring;
00181 #define string xc_string
00182 #define bstring xc_bstring
00183 #define pstring xc_pstring
00184 #define mzstring xc_mzstring
00185 #define mzxstring xc_mzxstring
00186 typedef const char *cstring, *ncstring; 
00187 typedef const char *cpstring, *ncpstring; 
00188 typedef const char *cbstring, *ncbstring; 
00189 typedef const mzchar *cmzstring, *ncmzstring; 
00190 typedef char *nstring;
00191 typedef char *npstring;
00192 typedef char *nbstring;
00193 typedef char *wbstring;
00194 typedef mzchar *wmzstring;
00195 
00196 typedef char *pathname;
00197 typedef char *epathname;
00198 typedef char *npathname;
00199 typedef char *xpathname;
00200 typedef char *nxpathname;
00201 typedef char *nepathname;
00202 typedef const char *cpathname;
00203 typedef const char *cnpathname;
00204 typedef char *wpathname;
00205 typedef char *wnpathname;
00206 
00207 typedef long nnlong;
00208 typedef int nnint;
00209 typedef double nndouble;
00210 
00211 #define XC_SCHEME_NULL scheme_false
00212 #define XC_SCHEME_NULLP(x) SCHEME_FALSEP(x)
00213 #define XC_NULL_STR "#f"
00214 
00215 #ifdef __GNUG__
00216 # define WXS_USE_ARGUMENT(x) x = x; /* compiler optimizes it away */
00217 #else
00218 # define WXS_USE_ARGUMENT(x) 
00219 #endif
00220 
00221 #ifdef MZ_PRECISE_GC
00222 # ifndef GC_STACK_CALLEE_RESTORE
00223 #  define _SETUP_VAR_STACK(var, n, vs)    void *var[n + 2]; \
00224                                           var[0] = vs; \
00225                                           var[1] = (void *)n
00226 #  define SETUP_VAR_STACK(n)              _SETUP_VAR_STACK(__gc_var_stack__, n, GC_variable_stack)
00227 #  define SETUP_VAR_STACK_REMEMBERED(n)   _SETUP_VAR_STACK(__gc_var_stack__, n, __remembered_vs__)
00228 #  define SETUP_VAR_STACK_PRE_REMEMBERED(n)  _SETUP_VAR_STACK(__gc_var_stack__, n, __remembered_vs__[0])
00229 #  define SETUP_PRE_VAR_STACK(n)          _SETUP_VAR_STACK(__gc_pre_var_stack__, n, GC_variable_stack); \
00230                                           GC_variable_stack = __gc_pre_var_stack__
00231 #  define VAR_STACK_PUSH(p, var)          __gc_var_stack__[p+2] = &(var)
00232 #  define VAR_STACK_PUSH_ARRAY(p, var, n) __gc_var_stack__[p+2] = 0; \
00233                                           __gc_var_stack__[p+3] = &(var); \
00234                                           __gc_var_stack__[p+4] = (void *)(n)
00235 #  define PRE_VAR_STACK_PUSH(p, var)      __gc_pre_var_stack__[p+2] = &(var)
00236 #  define SET_VAR_STACK()                 GC_variable_stack = __gc_var_stack__
00237 #  define WITH_VAR_STACK(x)               (SET_VAR_STACK(), x)
00238 #  define REMEMBER_VAR_STACK()            void **__remembered_vs__ = GC_variable_stack
00239 #  define WITH_REMEMBERED_STACK(x)        (GC_variable_stack = __remembered_vs__, x)
00240 #  define READY_TO_RETURN                  /* empty */
00241 #  define READY_TO_PRE_RETURN              /* empty */
00242 # else
00243 #  define _SETUP_VAR_STACK(var, n, vs)    void *var[n + 2]; \
00244                                           var[0] = vs; \
00245                                           var[1] = (void *)n; \
00246                                           GC_variable_stack = var
00247 #  define SETUP_VAR_STACK(n)              _SETUP_VAR_STACK(__gc_var_stack__, n, GC_variable_stack)
00248 #  define SETUP_VAR_STACK_REMEMBERED(n)   SETUP_VAR_STACK(n)
00249 #  define SETUP_VAR_STACK_PRE_REMEMBERED(n) _SETUP_VAR_STACK(__gc_var_stack__, n, __gc_pre_var_stack__[0])
00250 #  define SETUP_PRE_VAR_STACK(n)          _SETUP_VAR_STACK(__gc_pre_var_stack__, n, GC_variable_stack)
00251 #  define VAR_STACK_PUSH(p, var)          __gc_var_stack__[p+2] = &(var)
00252 #  define VAR_STACK_PUSH_ARRAY(p, var, n) __gc_var_stack__[p+2] = 0; \
00253                                           __gc_var_stack__[p+3] = &(var); \
00254                                           __gc_var_stack__[p+4] = (void *)(n)
00255 #  define PRE_VAR_STACK_PUSH(p, var)      __gc_pre_var_stack__[p+2] = &(var)
00256 #  define SET_VAR_STACK()                 /* empty */
00257 #  define WITH_VAR_STACK(x)               x
00258 #  define REMEMBER_VAR_STACK()            /* empty */
00259 #  define WITH_REMEMBERED_STACK(x)        x
00260 #  define READY_TO_RETURN                 GC_variable_stack = (void **)__gc_var_stack__[0]
00261 #  define READY_TO_PRE_RETURN             READY_TO_RETURN
00262 # endif
00263 
00264 # define CONSTRUCTOR_ARGS(x)             ()
00265 # define CONSTRUCTOR_INIT(x)             /* empty */
00266 # define ASSELF                          sElF->
00267 # define SELF__                          sElF
00268 # define INIT_NULLED_OUT                 = NULLED_OUT
00269 # define INIT_NULLED_ARRAY(x)            = x
00270 # define INA_comma                       ,
00271 #else
00272 # define SETUP_VAR_STACK(n)              /* empty */
00273 # define SETUP_VAR_STACK_REMEMBERED(n)   /* empty */
00274 # define SETUP_VAR_STACK_PRE_REMEMBERED(n) /* empty */
00275 # define SETUP_PRE_VAR_STACK(n)          /* empty */
00276 # define VAR_STACK_PUSH(p, var)          /* empty */
00277 # define VAR_STACK_PUSH_ARRAY(p, var, n) /* empty */
00278 # define PRE_VAR_STACK_PUSH(p, var)      /* empty */
00279 # define SET_VAR_STACK()                 /* empty */
00280 # define WITH_VAR_STACK(x)               x
00281 # define REMEMBER_VAR_STACK()            /* empty */
00282 # define WITH_REMEMBERED_STACK(x)        x
00283 # define READY_TO_RETURN                 /* empty */
00284 # define READY_TO_PRE_RETURN             /* empty */
00285 # define CONSTRUCTOR_ARGS(x)             x
00286 # define CONSTRUCTOR_INIT(x)             x
00287 # define ASSELF                          /* empty */
00288 # define SELF__                          this
00289 # define INIT_NULLED_OUT                 /* empty */
00290 # define INIT_NULLED_ARRAY(x)            /* empty */
00291 # define INA_comma                       /* empty */
00292 #endif
00293 
00294 #ifdef __cplusplus
00295 };
00296 #endif
00297 
00298 #endif