Back to index

plt-scheme  4.2.1
mzc.h
Go to the documentation of this file.
00001 
00002 #include <stdlib.h>
00003 #include <stdarg.h>
00004 
00005 #define GLOBAL_VARREF(x) ((x)->val ? (Scheme_Object *)(x)->val : \
00006   (scheme_unbound_global(x), (Scheme_Object *)NULL))
00007 #define CHECK_GLOBAL_BOUND(x) \
00008     if (!(x)->val) scheme_raise_exn(MZEXN_UNIT, \
00009                                 "invoke-unit: cannot link to undefined identifier: %S", \
00010                                 (Scheme_Object*)(x)->key);
00011 
00012 #ifdef NO_INLINE_KEYWORD
00013 # define MZC_INLINE /* */
00014 #else
00015 # define MZC_INLINE MSC_IZE(inline)
00016 #endif
00017 
00018 #define MZC_GLOBAL_PREPARE(vec, pos) (SCHEME_VEC_ELS(vec)[pos] = SCHEME_PTR_VAL(SCHEME_VEC_ELS(vec)[pos]))
00019 static MZC_INLINE Scheme_Object *MZC_GLOBAL_LOOKUP(Scheme_Object *vec, int pos) {
00020   Scheme_Bucket *bucket = (Scheme_Bucket *)SCHEME_VEC_ELS(vec)[pos];
00021   Scheme_Object *o = bucket->val;
00022   if (o)
00023     return o;
00024   else {
00025     scheme_unbound_global(bucket);
00026     return NULL;
00027   }
00028 }
00029 
00030 static MZC_INLINE Scheme_Object *MZC_GLOBAL_ASSIGN(Scheme_Object *vec, int pos, Scheme_Object *val) {
00031   Scheme_Bucket *bucket = (Scheme_Bucket *)SCHEME_VEC_ELS(vec)[pos];
00032   scheme_set_global_bucket("set!", bucket, val, 0);
00033   return scheme_void;
00034 }
00035 
00036 #define MZC_KNOWN_SAFE_VECTOR_REF(vec, pos) (SCHEME_VEC_ELS(vec)[pos])
00037 
00038 #define MZC_APPLY_MAGIC(val, n) \
00039   scheme_eval_compiled_sized_string_with_magic(top_level_bytecode_ ## n, sizeof(top_level_bytecode_ ## n), NULL, \
00040                                                scheme_intern_symbol(top_level_magic_sym_ ## n), val, 1)
00041 
00042 #define DO_FUEL_POLL ((scheme_fuel_counter-- <= 0) ? (scheme_process_block(0), 0) : 0)
00043 
00044 #define _scheme_direct_apply_primitive_multi_poll(prim, argc, argv) \
00045     (DO_FUEL_POLL, _scheme_direct_apply_primitive_multi(prim, argc, argv))
00046 #define _scheme_direct_apply_primitive_poll(prim, argc, argv) \
00047     (DO_FUEL_POLL, _scheme_direct_apply_primitive(prim, argc, argv))
00048 #define _scheme_direct_apply_primitive_closure_multi_poll(prim, argc, argv) \
00049     (DO_FUEL_POLL, _scheme_direct_apply_primitive_closure_multi(prim, argc, argv))
00050 #define _scheme_direct_apply_primitive_closure_poll(prim, argc, argv) \
00051     (DO_FUEL_POLL, _scheme_direct_apply_primitive_closure(prim, argc, argv))
00052 
00053 #ifdef KEEP_CLOSURE_COUNT
00054 static int closure_alloc_cnt;
00055 static void print_closures()
00056 {
00057   printf("closures allocated in " MZC_SRC_FILE ": %d\n", closure_alloc_cnt);
00058 }
00059 # define CLOSURE_ALLOC_PP closure_alloc_inc(), 
00060 static void closure_alloc_inc()
00061 {
00062   if (!closure_alloc_cnt)
00063     atexit(print_closures);
00064   closure_alloc_cnt++;
00065 }
00066 #else
00067 # define CLOSURE_ALLOC_PP 
00068 #endif
00069 
00070 typedef struct {
00071   Scheme_Primitive_Proc prim;
00072 #ifdef MZ_PRECISE_GC
00073   int count;
00074 #endif
00075 } Scheme_Primitive_Closure_Post;
00076 
00077 # define MZC_INSTALL_DATA_PTR(rec) rec
00078 # define MZC_PARAM_TO_SWITCH(void_param) *(unsigned long *)(((Scheme_Primitive_Closure *)void_param)->val)
00079 # define MZC_ENV_POINTER(t, ct, void_param) (&(((const ct *)void_param)->data))
00080 
00081 
00082 #ifdef SIXTY_FOUR_BIT_INTEGERS
00083 # define MZ_LOG_WORD_SIZE 4
00084 #else
00085 # define MZ_LOG_WORD_SIZE 2
00086 #endif
00087 
00088 #define _scheme_make_c_proc_closure(cfunc, rec, name, amin, amax, flags) \
00089   (CLOSURE_ALLOC_PP (Scheme_Object *)_scheme_fill_prim_closure_post(((Scheme_Primitive_Closure *)&rec->prim), cfunc, \
00090                                                             name, amin, amax, flags, \
00091                                                                     sizeof(rec->data)>>MZ_LOG_WORD_SIZE))
00092 
00093 #define _scheme_make_c_proc_closure_empty(cfunc, rec, name, amin, amax, flags) \
00094   (CLOSURE_ALLOC_PP (Scheme_Object *)_scheme_fill_prim_closure(&rec->prim, cfunc, name, amin, amax, flags))
00095 
00096 #define _scheme_make_c_case_proc_closure(cfunc, rec, name, ccnt, cses, flags) \
00097   (CLOSURE_ALLOC_PP (Scheme_Object *)_scheme_fill_prim_case_closure_post(((Scheme_Primitive_Closure *)&rec->prim), cfunc, \
00098                                                                 name, ccnt, cses, flags, \
00099                                                                          sizeof(rec->data)>>MZ_LOG_WORD_SIZE))
00100 
00101 #define _scheme_make_c_case_proc_closure_empty(cfunc, rec, name, ccnt, cses, flags) \
00102   (CLOSURE_ALLOC_PP (Scheme_Object *)_scheme_fill_prim_case_closure(&rec->prim, cfunc, name, ccnt, cses, flags))
00103 
00104 #define NO_MULTIPLE_VALUES(res) \
00105        if (res == SCHEME_MULTIPLE_VALUES) \
00106            scheme_wrong_return_arity(NULL, 1, scheme_multiple_count, scheme_multiple_array, NULL);
00107 #define CHECK_MULTIPLE_VALUES(res, expected) \
00108        if (res != SCHEME_MULTIPLE_VALUES || scheme_multiple_count != expected) \
00109         scheme_wrong_return_arity(NULL, expected, \
00110                                   (res == SCHEME_MULTIPLE_VALUES ? scheme_multiple_count : 1), \
00111                                                           (res == SCHEME_MULTIPLE_VALUES ? scheme_multiple_array : (Scheme_Object**)res), \
00112                                   NULL);
00113 
00114 #define SCHEME_DETATCH_MV_BUFFER(mv, pr) if (SAME_OBJ(mv, pr->values_buffer)) pr->values_buffer = NULL
00115 
00116 #define SCHEME_CURRENT_ENV(pr) scheme_get_env(NULL)
00117 
00118 typedef struct {
00119   Scheme_Object * val;
00120   Scheme_Object ** array;
00121   int count;
00122 } _Scheme_Begin0_Rec;
00123 
00124 typedef struct {
00125   Scheme_Cont_Frame_Data cf;
00126   Scheme_Object *val;
00127 } _Scheme_WCM_Rec;
00128 
00129 #define _scheme_apply_ckp(f, argc, argv) (SCHEME_CLSD_PRIMP(f) ? _scheme_apply_prim_closure(f, argc, argv) : _scheme_apply(f, argc, argv))
00130 #define _scheme_apply_multi_ckp(f, argc, argv) (SCHEME_CLSD_PRIMP(f) ? _scheme_apply_prim_closure_multi(f, argc, argv) : _scheme_apply_multi(f, argc, argv))
00131 
00132 #define MZC_EQP(ltp, av, bv) (SAME_OBJ(av, bv))
00133 #define MZC_EQVP(ltp, av, bv) (SAME_OBJ(av, bv) || scheme_eqv(av, bv))
00134 #define MZC_EQUALP(ltp, av, bv) scheme_equal(av, bv)
00135 #define MZC_NOTP(p, av) (SCHEME_FALSEP(av))
00136 #define MZC_NULLP(p, av) (SCHEME_NULLP(av))
00137 #define MZC_PAIRP(p, av) (SCHEME_PAIRP(av))
00138 #define MZC_SYMBOLP(p, av) (SCHEME_SYMBOLP(av))
00139 #define MZC_STRINGP(p, av) (SCHEME_CHAR_STRINGP(av))
00140 #define MZC_BYTESP(p, av) (SCHEME_BYTE_STRINGP(av))
00141 #define MZC_VECTORP(p, av) (SCHEME_VECTORP(av))
00142 #define MZC_NUMBERP(p, av) (SCHEME_NUMBERP(av))
00143 #define MZC_PROCEDUREP(p, av) (SCHEME_PROCP(av))
00144 #define MZC_EOFP(p, av) (SCHEME_EOFP(av))
00145 #define MZC_CHARP(p, av) (SCHEME_CHARP(av))
00146 
00147 #define MZC_CONS(p, av, bv) scheme_make_pair(av, bv)
00148 #define MZC_LIST1(p, av) scheme_make_pair(av, scheme_null)
00149 #define MZC_LIST2(p, av, bv) scheme_make_pair(av, scheme_make_pair(bv, scheme_null))
00150 #define MZC_APPEND(p, av, bv) scheme_append(av, bv)
00151 
00152 #define MZC_FOR_SYNTAX_IN_ENV(ignored, proc) scheme_apply_for_syntax_in_env(proc, env)
00153 
00154 #if MZC_UNSAFE
00155 /* Unsafe versions */
00156 #define MZC_CAR(p, av) SCHEME_CAR(av)
00157 #define MZC_CDR(p, av) SCHEME_CDR(av)
00158 #define MZC_CADR(p, av) SCHEME_CAR(SCHEME_CDR(av))
00159 #define MZC_CDDR(p, av) SCHEME_CDR(SCHEME_CDR(av))
00160 #define MZC_CDAR(p, av) SCHEME_CDR(SCHEME_CAR(av))
00161 #define MZC_CAAR(p, av) SCHEME_CAR(SCHEME_CAR(av))
00162 #define MZC_CADDR(p, av) SCHEME_CADR(SCHEME_CDR(av))
00163 #define MZC_SET_CAR(p, av, bv) (SCHEME_CAR(av)=bv, scheme_void)
00164 #define MZC_SET_CDR(p, av, bv) (SCHEME_CDR(av)=bv, scheme_void)
00165 
00166 # define MZC_VECTOR_REF(p, v, i) SCHEME_VEC_ELS(v)[SCHEME_INT_VAL(i)]
00167 # define MZC_VECTOR_SET(p, v, i, x) (SCHEME_VEC_ELS(v)[SCHEME_INT_VAL(i)] = x, scheme_void)
00168 
00169 # define MZC_STRING_REF(p, v, i) scheme_make_character(SCHEME_CHAR_STR_VAL(v)[SCHEME_INT_VAL(i)])
00170 # define MZC_STRING_SET(p, v, i, x) (SCHEME_CHAR_STR_VAL(v)[SCHEME_INT_VAL(i)] = SCHEME_CHAR_VAL(x), scheme_void)
00171 
00172 # define MZC_BYTES_REF(p, v, i) scheme_make_integer(SCHEME_BYTE_STR_VAL(v)[SCHEME_INT_VAL(i)])
00173 # define MZC_BYTES_SET(p, v, i, x) (SCHEME_BYTE_STR_VAL(v)[SCHEME_INT_VAL(i)] = SCHEME_INT_VAL(x), scheme_void)
00174 
00175 #define MZC_CHAR_TO_INTEGER(p, v) scheme_make_integer((unsigned char)SCHEME_CHAR_VAL(v))
00176 /* End unsafe versions */
00177 #else
00178 /* Safe versions */
00179 #define MZC_CAR(p, av) (SCHEME_PAIRP(av) ? SCHEME_CAR(av) : (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
00180 #define MZC_CDR(p, av) (SCHEME_PAIRP(av) ? SCHEME_CDR(av) : (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
00181 #define MZC_CADR(p, av) ((SCHEME_PAIRP(av) && SCHEME_PAIRP(SCHEME_CDR(av))) ? SCHEME_CAR(SCHEME_CDR(av)) : (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
00182 #define MZC_CDDR(p, av) ((SCHEME_PAIRP(av) && SCHEME_PAIRP(SCHEME_CDR(av))) ? SCHEME_CDR(SCHEME_CDR(av)) : (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
00183 #define MZC_CDAR(p, av) ((SCHEME_PAIRP(av) && SCHEME_PAIRP(SCHEME_CAR(av))) ? SCHEME_CDR(SCHEME_CAR(av)) : (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
00184 #define MZC_CAAR(p, av) ((SCHEME_PAIRP(av) && SCHEME_PAIRP(SCHEME_CAR(av))) ? SCHEME_CAR(SCHEME_CAR(av)) : (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
00185 #define MZC_CADDR(p, av) ((SCHEME_PAIRP(av) && SCHEME_PAIRP(SCHEME_CDR(av)) && SCHEME_PAIRP(SCHEME_CDR(SCHEME_CDR(av)))) ? SCHEME_CADR(SCHEME_CDR(av)) : (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
00186 #define MZC_SET_CAR(p, av, bv) (SCHEME_MUTABLE_PAIRP(av) ? (SCHEME_CAR(av)=bv, scheme_void) : (arg[0] = av, arg[1] = bv, _scheme_direct_apply_primitive_multi(p, 2, arg)))
00187 #define MZC_SET_CDR(p, av, bv) (SCHEME_MUTABLE_PAIRP(av) ? (SCHEME_CDR(av)=bv, scheme_void) : (arg[0] = av, arg[1] = bv, _scheme_direct_apply_primitive_multi(p, 2, arg)))
00188 
00189 #define MZC_CHAR_TO_INTEGER(p, v) (SCHEME_CHARP(v) ? scheme_make_integer((unsigned char)SCHEME_CHAR_VAL(v)) \
00190                                    : (arg[0] = v, _scheme_direct_apply_primitive_multi(p, 1, arg)))
00191 
00192 # define MZC_VECTOR_REF(p, v, i) ((SCHEME_INTP(i) && SCHEME_VECTORP(v) && (SCHEME_INT_VAL(i) >= 0) \
00193                                   && (SCHEME_INT_VAL(i) < SCHEME_VEC_SIZE(v)) \
00194                                  ? SCHEME_VEC_ELS(v)[SCHEME_INT_VAL(i)] \
00195                               : (arg[0] = v, arg[1] = i, _scheme_direct_apply_primitive_multi(p, 2, arg))))
00196 # define MZC_VECTOR_SET(p, v, i, x) ((SCHEME_INTP(i) && SCHEME_VECTORP(v) && (SCHEME_INT_VAL(i) >= 0) \
00197                                     && (SCHEME_INT_VAL(i) < SCHEME_VEC_SIZE(v)) \
00198                                     ? (SCHEME_VEC_ELS(v)[SCHEME_INT_VAL(i)] = x, scheme_void) \
00199                                 : (arg[0] = v, arg[1] = i, arg[2] = x, _scheme_direct_apply_primitive_multi(p, 3, arg))))
00200 # define MZC_STRING_REF(p, v, i) ((SCHEME_INTP(i) && SCHEME_CHAR_STRINGP(v) && (SCHEME_INT_VAL(i) >= 0) \
00201                                   && (SCHEME_INT_VAL(i) < SCHEME_CHAR_STRLEN_VAL(v)) \
00202                                   ? scheme_make_character(SCHEME_CHAR_STR_VAL(v)[SCHEME_INT_VAL(i)]) \
00203                               : (arg[0] = v, arg[1] = i, _scheme_direct_apply_primitive_multi(p, 2, arg))))
00204 # define MZC_STRING_SET(p, v, i, x) ((SCHEME_INTP(i) && SCHEME_MUTABLE_CHAR_STRINGP(v) && SCHEME_CHARP(x) && (SCHEME_INT_VAL(i) >= 0) \
00205                                       && (SCHEME_INT_VAL(i) < SCHEME_CHAR_STRLEN_VAL(v)) \
00206                                      ? (SCHEME_CHAR_STR_VAL(v)[SCHEME_INT_VAL(i)] = SCHEME_CHAR_VAL(x), scheme_void) \
00207                                  : (arg[0] = v, arg[1] = i, arg[2] = x, _scheme_direct_apply_primitive_multi(p, 3, arg))))
00208 # define MZC_BYTES_REF(p, v, i) ((SCHEME_INTP(i) && SCHEME_BYTE_STRINGP(v) && (SCHEME_INT_VAL(i) >= 0) \
00209                                   && (SCHEME_INT_VAL(i) < SCHEME_BYTE_STRLEN_VAL(v)) \
00210                                   ? scheme_make_integer(SCHEME_BYTE_STR_VAL(v)[SCHEME_INT_VAL(i)]) \
00211                               : (arg[0] = v, arg[1] = i, _scheme_direct_apply_primitive_multi(p, 2, arg))))
00212 # define MZC_BYTES_SET(p, v, i, x) ((SCHEME_INTP(i) && SCHEME_MUTABLE_BYTE_STRINGP(v) && SCHEME_INTP(x) \
00213                                       && (SCHEME_INT_VAL(x) >= 0) && (SCHEME_INT_VAL(x) <= 255) \
00214                                       && (SCHEME_INT_VAL(i) >= 0) && (SCHEME_INT_VAL(i) < SCHEME_BYTE_STRLEN_VAL(v)) \
00215                                      ? (SCHEME_BYTE_STR_VAL(v)[SCHEME_INT_VAL(i)] = SCHEME_INT_VAL(x), scheme_void) \
00216                                  : (arg[0] = v, arg[1] = i, arg[2] = x, _scheme_direct_apply_primitive_multi(p, 3, arg))))
00217 /* End safe versions */
00218 #endif
00219 
00220 #define _MZC_DBLP(obj) SAME_TYPE(_SCHEME_TYPE(obj), scheme_double_type)
00221      
00222 #define MZC_ZEROP(zp, av) (SCHEME_INTP(av) \
00223                                 ? (av == scheme_make_integer(0)) \
00224                                 : (_MZC_DBLP(av) \
00225                                    ? !SCHEME_DBL_VAL(av) \
00226                                    : (arg[0] = av, SCHEME_TRUEP(_scheme_direct_apply_primitive_multi(zp, 1, arg)))))
00227 
00228 #define MZC_ARITH_COMPARE(cp, av, bv, compareop) \
00229                                      ((SCHEME_INTP(av) && SCHEME_INTP(bv)) \
00230                                       ? (SCHEME_INT_VAL(av) compareop SCHEME_INT_VAL(bv)) \
00231                                       : ((SCHEME_DBLP(av) && SCHEME_DBLP(bv)) \
00232                                          ? (SCHEME_DBL_VAL(av) compareop SCHEME_DBL_VAL(bv)) \
00233                                          : (arg[0] = av, arg[1] = bv, SCHEME_TRUEP(_scheme_direct_apply_primitive_multi(cp, 2, arg)))))
00234 
00235 #define MZC_LTP(cp, av, bv) MZC_ARITH_COMPARE(cp, av, bv, <)
00236 #define MZC_GTP(cp, av, bv) MZC_ARITH_COMPARE(cp, av, bv, >)
00237 #define MZC_LTEP(cp, av, bv) MZC_ARITH_COMPARE(cp, av, bv, <=)
00238 #define MZC_GTEP(cp, av, bv) MZC_ARITH_COMPARE(cp, av, bv, >=)
00239 #define MZC_EQLP(cp, av, bv) MZC_ARITH_COMPARE(cp, av, bv, ==)
00240 
00241 #if MZC_FIXNUM
00242 /* Numerically incorrect */
00243 #define MZC_ADD1(p, av) (SCHEME_INTP(av) \
00244                          ? scheme_make_integer(SCHEME_INT_VAL(av)+1) \
00245                          : (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
00246 #define MZC_SUB1(p, av) (SCHEME_INTP(av) \
00247                          ? scheme_make_integer(SCHEME_INT_VAL(av)-1) \
00248                          : (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
00249 
00250 #define MZC_ARITH_OP(cp, av, bv, op, revop) \
00251                       ((SCHEME_INTP(av) && SCHEME_INTP(bv)) \
00252                         ? scheme_make_integer(SCHEME_INT_VAL(av) op SCHEME_INT_VAL(bv)) \
00253                         : ((SCHEME_DBLP(av) && SCHEME_DBLP(bv)) \
00254                            ? scheme_make_double(SCHEME_DBL_VAL(av) op SCHEME_DBL_VAL(bv)) \
00255                            : (arg[0] = av, arg[1] = bv, _scheme_direct_apply_primitive_multi(cp, 2, arg))))
00256 
00257 #define MZC_TIMES2(cp, av, bv) MZC_ARITH_OP(cp, av, bv, *, /)
00258 
00259 /* End numerically incorrect */
00260 #else
00261 /* Numerically correct */
00262 #define MZC_ADD1(p, av) ((SCHEME_INTP(av) && (SCHEME_INT_VAL(av) < 0x3FFFFFFF)) \
00263                          ? scheme_make_integer(SCHEME_INT_VAL(av)+1) \
00264                          : (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
00265 #define MZC_SUB1(p, av) ((SCHEME_INTP(av) && (SCHEME_INT_VAL(av) > (-0x3FFFFFFF))) \
00266                          ? scheme_make_integer(SCHEME_INT_VAL(av)-1) \
00267                          : (arg[0] = av, _scheme_direct_apply_primitive_multi(p, 1, arg)))
00268 
00269 #define MZC_ARITH_OP(cp, av, bv, op, revop) \
00270                       ((SCHEME_INTP(av) && SCHEME_INTP(bv) \
00271                         && (((SCHEME_INT_VAL(scheme_make_integer(SCHEME_INT_VAL(av) op SCHEME_INT_VAL(bv))) \
00272                               revop SCHEME_INT_VAL(bv)) \
00273                              == SCHEME_INT_VAL(av)))) \
00274                         ? scheme_make_integer(SCHEME_INT_VAL(av) op SCHEME_INT_VAL(bv)) \
00275                         : ((SCHEME_DBLP(av) && SCHEME_DBLP(bv)) \
00276                            ? scheme_make_double(SCHEME_DBL_VAL(av) op SCHEME_DBL_VAL(bv)) \
00277                            : (arg[0] = av, arg[1] = bv, _scheme_direct_apply_primitive_multi(cp, 2, arg))))
00278 /* End numerically correct */
00279 #endif
00280 
00281 #define MZC_PLUS2(cp, av, bv) MZC_ARITH_OP(cp, av, bv, +, -)
00282 #define MZC_MINUS2(cp, av, bv) MZC_ARITH_OP(cp, av, bv, -, +)
00283 
00284 #define MZC_MAXMIN_OP(cp, av, bv, minlt) \
00285             ((SCHEME_INTP(av) && SCHEME_INTP(bv)) \
00286              ? ((SCHEME_INT_VAL(av) minlt SCHEME_INT_VAL(bv)) ? av : bv) \
00287              : (arg[0] = av, arg[1] = bv, _scheme_direct_apply_primitive_multi(cp, 2, arg)))
00288 
00289 #define MZC_MAX2(cp, av, bv) MZC_MAXMIN_OP(cp, av, bv, >)
00290 #define MZC_MIN2(cp, av, bv) MZC_MAXMIN_OP(cp, av, bv, <)
00291 
00292 #define MZC_QUOTIENT(cp, av, bv) \
00293             ((SCHEME_INTP(av) && SCHEME_INTP(bv) && SCHEME_INT_VAL(bv)) \
00294              ? scheme_make_integer(SCHEME_INT_VAL(av) / SCHEME_INT_VAL(bv)) \
00295              : (arg[0] = av, arg[1] = bv, _scheme_direct_apply_primitive_multi(cp, 2, arg)))
00296 
00297 static MSC_IZE(inline) Scheme_Object *mzc_force_value(Scheme_Object *v)
00298 {
00299   return _scheme_force_value(v);
00300 }
00301 
00302 #define _scheme_direct_apply_primitive_closure_multi_fv(prim, argc, argv) \
00303     mzc_force_value(_scheme_direct_apply_primitive_closure_multi(prim, argc, argv))
00304 #define _scheme_direct_apply_primitive_closure_fv(prim, argc, argv) \
00305     scheme_check_one_value(_scheme_direct_apply_primitive_closure_multi_fv(prim, argc, argv))
00306 
00307 static int mzc_strlen(const char *c) {
00308   int l;
00309   for (l = 0; c[l]; l++);
00310   return l;
00311 }
00312 
00313 #if 0
00314 static Scheme_Object *DEBUG_CHECK(Scheme_Object *v)
00315 {
00316   if ((SCHEME_TYPE(v) < _scheme_values_types_) || (SCHEME_TYPE(v) > _scheme_last_type_ + 5)) {
00317     /* Could be a boxed value ... */
00318     Scheme_Object *o = *(Scheme_Object **)v;
00319     if ((SCHEME_TYPE(v) < _scheme_values_types_) || (SCHEME_TYPE(v) > _scheme_last_type_ + 5)) {
00320       printf("wrong!\n");
00321     }
00322   }
00323   return v;
00324 }
00325 #endif
00326 
00327 #ifdef MZ_PRECISE_GC
00328 START_XFORM_SUSPEND;
00329 static MZC_INLINE Scheme_Object *
00330 _mzc_direct_apply_primitive_multi(Scheme_Object *prim, int argc, Scheme_Object **argv)
00331 {
00332   return _scheme_direct_apply_primitive_multi(prim, argc, argv);
00333 }
00334 static MZC_INLINE Scheme_Object *
00335 _mzc_direct_apply_primitive(Scheme_Object *prim, int argc, Scheme_Object **argv)
00336 {
00337   return _scheme_direct_apply_primitive(prim, argc, argv);
00338 }
00339 static MZC_INLINE Scheme_Object *
00340 _mzc_direct_apply_primitive_closure_multi(Scheme_Object *prim, int argc, Scheme_Object **argv)
00341 {
00342   return _scheme_direct_apply_primitive_closure_multi(prim, argc, argv);
00343 }
00344 static MZC_INLINE Scheme_Object *
00345 _mzc_direct_apply_primitive_closure(Scheme_Object *prim, int argc, Scheme_Object **argv)
00346 {
00347   return _scheme_direct_apply_primitive_closure(prim, argc, argv);
00348 }
00349 END_XFORM_SUSPEND;
00350 #else
00351 # define _mzc_direct_apply_primitive_multi(prim, argc, argv) \
00352          _scheme_direct_apply_primitive_multi(prim, argc, argv)
00353 # define _mzc_direct_apply_primitive(prim, argc, argv) \
00354          _scheme_direct_apply_primitive(prim, argc, argv)
00355 # define _mzc_direct_apply_primitive_closure_multi(prim, argc, argv) \
00356          _scheme_direct_apply_primitive_closure_multi(prim, argc, argv)
00357 # define _mzc_direct_apply_primitive_closure(prim, argc, argv) \
00358          _scheme_direct_apply_primitive_closure(prim, argc, argv)
00359 #endif
00360 
00361 #define _mzc_apply(r,n,rs) _scheme_apply(r,n,rs)
00362 #define _mzc_apply_multi(r,n,rs) _scheme_apply_multi(r,n,rs)
00363 #define _mzc_apply_known_prim_closure(r,n,rs) _scheme_apply_known_prim_closure(r,n,rs)
00364 #define _mzc_apply_known_prim_closure_multi(r,n,rs) _scheme_apply_known_prim_closure_multi(r,n,rs)
00365 
00366 #define MZC_PRIM_CLS_DATA(prim) (prim)