Back to index

plt-scheme  4.2.1
schpriv.h
Go to the documentation of this file.
00001 /*
00002   MzScheme
00003   Copyright (c) 2004-2009 PLT Scheme Inc.
00004   Copyright (c) 1995-2001 Matthew Flatt
00005   All rights reserved.
00006 
00007   Please see the full copyright in the documentation.
00008 
00009   libscheme
00010   Copyright (c) 1994 Brent Benson
00011   All rights reserved.
00012 */
00013 
00014 /*
00015    MzScheme prototypes and declarations for internal consumption.
00016 */
00017 
00018 #ifndef __mzscheme_private__
00019 #define __mzscheme_private__
00020 
00021 #include "scheme.h"
00022 
00023 /*========================================================================*/
00024 /*                         allocation and GC                              */
00025 /*========================================================================*/
00026 
00027 #define MAKE_CLOSED_PRIM(f,v,n,mi,ma) \
00028   scheme_make_closed_prim_w_arity((Scheme_Closed_Prim *)f, (void *)v, n, mi, ma)
00029 
00030 #define _MALLOC_N(x, n, malloc) ((x*)malloc(sizeof(x)*(n)))
00031 #define MALLOC_ONE(x) _MALLOC_N(x, 1, scheme_malloc)
00032 #define MALLOC_ONE_TAGGED(x) _MALLOC_N(x, 1, scheme_malloc_small_tagged)
00033 #define MALLOC_N_TAGGED(x, n) _MALLOC_N(x, n, scheme_malloc_array_tagged)
00034 #ifdef MZTAG_REQUIRED
00035 # define scheme_malloc_rt(x) scheme_malloc_tagged(x)
00036 # define MALLOC_ONE_RT(x) MALLOC_ONE_TAGGED(x)
00037 # define MALLOC_N_RT(x,c) MALLOC_N_TAGGED(x,c)
00038 # define MALLOC_ONE_WEAK(x) _MALLOC_N(x, 1, scheme_malloc)
00039 # define MALLOC_N_WEAK(x,c) _MALLOC_N(x, c, scheme_malloc)
00040 # define MALLOC_ONE_TAGGED_WEAK(x) _MALLOC_N(x, 1, scheme_malloc_tagged)
00041 # define MALLOC_ONE_WEAK_RT(x) MALLOC_ONE_TAGGED_WEAK(x)
00042 #else
00043 # define scheme_malloc_rt(x) scheme_malloc(x)
00044 # define MALLOC_ONE_RT(x) MALLOC_ONE(x)
00045 # define MALLOC_N_RT(x,c) MALLOC_N(x,c)
00046 # define MALLOC_ONE_WEAK(x) MALLOC_ONE_ATOMIC(x)
00047 # define MALLOC_N_WEAK(x,c) MALLOC_N_ATOMIC(x,c)
00048 # define MALLOC_ONE_WEAK_RT(x) MALLOC_ONE_WEAK(x)
00049 # define MALLOC_ONE_TAGGED_WEAK(x) MALLOC_ONE_WEAK(x)
00050 #endif
00051 #define MALLOC_N(x, n) _MALLOC_N(x, n, scheme_malloc)
00052 #define MALLOC_ONE_ATOMIC(x) _MALLOC_N(x, 1, scheme_malloc_atomic)
00053 #define MALLOC_N_ATOMIC(x, n) _MALLOC_N(x, n, scheme_malloc_atomic)
00054 #define MALLOC_SO_BOX() _MALLOC_ONE(Scheme_Object*, scheme_malloc)
00055 #define MALLOC_N_STUBBORN(x, n) _MALLOC_N(x, n, scheme_malloc_stubborn)
00056 
00057 #ifdef MZ_PRECISE_GC
00058 # define WEAKIFY(x) scheme_make_weak_box(x)
00059 # define WEAKIFIED(x) SCHEME_WEAK_BOX_VAL(x)
00060 # define HT_EXTRACT_WEAK(x) SCHEME_WEAK_BOX_VAL(x)
00061 #else
00062 # define WEAKIFY(x) x
00063 # define WEAKIFIED(x) x
00064 # define HT_EXTRACT_WEAK(x) (*(char **)(x))
00065 #endif
00066 
00067 #ifndef MZ_XFORM
00068 # define START_XFORM_SKIP 
00069 # define END_XFORM_SKIP 
00070 # define GC_CAN_IGNORE 
00071 # define GC_MAYBE_IGNORE_INTERIOR 
00072 # define XFORM_OK_PLUS +
00073 # define XFORM_OK_MINUS -
00074 #else
00075 # ifdef GC_INTERIORABLES_NEVER_MOVE
00076 #  define GC_MAYBE_IGNORE_INTERIOR GC_CAN_IGNORE
00077 # else
00078 #  define GC_MAYBE_IGNORE_INTERIOR 
00079 # endif
00080 #endif
00081 
00082 #ifdef MZ_PRECISE_GC
00083 long scheme_hash_key(Scheme_Object *o);
00084 #else
00085 # define scheme_hash_key(o) ((long)(o))
00086 #endif
00087 typedef int (*Compare_Proc)(void *v1, void *v2);
00088 
00089 Scheme_Object *scheme_dump_gc_stats(int c, Scheme_Object *p[]);
00090 
00091 #define REGISTER_SO(x) MZ_REGISTER_STATIC(x)
00092 
00093 extern long scheme_total_gc_time;
00094 extern int scheme_cont_capture_count;
00095 extern int scheme_continuation_application_count;
00096 
00097 int scheme_num_types(void);
00098 
00099 #ifdef MZTAG_REQUIRED
00100 # define MZTAG_IF_REQUIRED  Scheme_Type type;
00101 # define SET_REQUIRED_TAG(e) e
00102 #else
00103 # define MZTAG_IF_REQUIRED /* empty */
00104 # define SET_REQUIRED_TAG(e) /* empty */
00105 #endif
00106 
00107 #if MZ_USE_NOINLINE
00108 # define MZ_DO_NOT_INLINE(decl) decl __attribute__ ((noinline));
00109 #else
00110 # define MZ_DO_NOT_INLINE(decl)
00111 #endif
00112 
00113 
00114 void scheme_reset_finalizations(void);
00115 
00116 extern unsigned long scheme_get_current_os_thread_stack_base(void);
00117 void scheme_set_current_os_thread_stack_base(void *base);
00118 
00119 int scheme_propagate_ephemeron_marks(void);
00120 void scheme_clear_ephemerons(void);
00121 
00122 #ifndef MZ_XFORM
00123 # define HIDE_FROM_XFORM(x) x
00124 #endif
00125 
00126 #define mzALIAS (void *)
00127 
00128 #define BITS_PER_MZSHORT (8 * sizeof(mzshort))
00129 
00130 #ifndef NO_INLINE_KEYWORD
00131 # define MZ_INLINE MSC_IZE(inline)
00132 #else
00133 # define MZ_INLINE /* empty */
00134 #endif
00135 
00136 #if _MSC_VER
00137 # define MZ_NO_INLINE _declspec(noinline)
00138 #elif defined(__GNUC__)
00139 # define MZ_NO_INLINE __attribute ((__noinline__))
00140 #else
00141 # define MZ_NO_INLINE /* empty */
00142 #endif
00143 
00144 #ifdef MZ_PRECISE_GC
00145 # define CLEAR_KEY_FIELD(o) ((o)->keyex = 0)
00146 #else
00147 # define CLEAR_KEY_FIELD(o) /* empty */
00148 #endif
00149 
00150 #define SCHEME_PAIR_FLAGS(pr) MZ_OPT_HASH_KEY(&((Scheme_Simple_Object *)pr)->iso)
00151 #define PAIR_IS_LIST 0x1
00152 #define PAIR_IS_NON_LIST 0x2
00153 #define PAIR_FLAG_MASK 0x3
00154 
00155 /*========================================================================*/
00156 /*                             initialization                             */
00157 /*========================================================================*/
00158 
00159 extern int scheme_starting_up;
00160 
00161 void scheme_init_portable_case(void);
00162 void scheme_init_stack_check(void);
00163 void scheme_init_overflow(void);
00164 #ifdef MZ_PRECISE_GC
00165 void scheme_register_traversers(void);
00166 void scheme_init_hash_key_procs(void);
00167 #endif
00168 Scheme_Thread *scheme_make_thread(void*);
00169 void scheme_init_true_false(void);
00170 void scheme_init_symbol_table(void);
00171 void scheme_init_symbol_type(Scheme_Env *env);
00172 void scheme_init_type();
00173 void scheme_init_list(Scheme_Env *env);
00174 void scheme_init_stx(Scheme_Env *env);
00175 void scheme_init_module(Scheme_Env *env);
00176 void scheme_init_module_path_table(void);
00177 void scheme_init_port(Scheme_Env *env);
00178 void scheme_init_port_fun(Scheme_Env *env);
00179 void scheme_init_network(Scheme_Env *env);
00180 void scheme_init_file(Scheme_Env *env);
00181 void scheme_init_proc(Scheme_Env *env);
00182 void scheme_init_vector(Scheme_Env *env);
00183 void scheme_init_string(Scheme_Env *env);
00184 void scheme_init_number(Scheme_Env *env);
00185 void scheme_init_numarith(Scheme_Env *env);
00186 void scheme_init_numcomp(Scheme_Env *env);
00187 void scheme_init_numstr(Scheme_Env *env);
00188 void scheme_init_eval(Scheme_Env *env);
00189 void scheme_init_promise(Scheme_Env *env);
00190 void scheme_init_struct(Scheme_Env *env);
00191 void scheme_init_reduced_proc_struct(Scheme_Env *env);
00192 void scheme_init_fun(Scheme_Env *env);
00193 void scheme_init_symbol(Scheme_Env *env);
00194 void scheme_init_char(Scheme_Env *env);
00195 void scheme_init_bool(Scheme_Env *env);
00196 void scheme_init_syntax(Scheme_Env *env);
00197 void scheme_init_error(Scheme_Env *env);
00198 #ifndef NO_SCHEME_EXNS
00199 void scheme_init_exn(Scheme_Env *env);
00200 #endif
00201 void scheme_init_debug(Scheme_Env *env);
00202 void scheme_init_thread(Scheme_Env *env);
00203 void scheme_init_read(Scheme_Env *env);
00204 void scheme_init_print(Scheme_Env *env);
00205 #ifndef NO_SCHEME_THREADS
00206 void scheme_init_sema(Scheme_Env *env);
00207 #endif
00208 void scheme_init_dynamic_extension(Scheme_Env *env);
00209 #ifndef NO_REGEXP_UTILS
00210 extern void scheme_regexp_initialize(Scheme_Env *env);
00211 #endif
00212 void scheme_init_memtrace(Scheme_Env *env);
00213 void scheme_init_parameterization_readonly_globals();
00214 void scheme_init_parameterization(Scheme_Env *env);
00215 void scheme_init_getenv(void);
00216 
00217 #ifndef DONT_USE_FOREIGN
00218 void scheme_init_foreign_globals();
00219 void scheme_init_foreign(Scheme_Env *env);
00220 #endif
00221 void scheme_init_place(Scheme_Env *env);
00222 
00223 void scheme_init_print_buffers_places(void);
00224 void scheme_init_eval_places(void);
00225 void scheme_init_port_places(void);
00226 void scheme_init_regexp_places(void);
00227 void scheme_init_stx_places(void);
00228 
00229 
00230 void scheme_free_dynamic_extensions(void);
00231 
00232 /* Type readers & writers for compiled code data */
00233 typedef Scheme_Object *(*Scheme_Type_Reader)(Scheme_Object *list);
00234 typedef Scheme_Object *(*Scheme_Type_Writer)(Scheme_Object *obj);
00235 
00236 extern Scheme_Type_Reader *scheme_type_readers;
00237 extern Scheme_Type_Writer *scheme_type_writers;
00238 
00239 extern Scheme_Equal_Proc *scheme_type_equals;
00240 extern Scheme_Primary_Hash_Proc *scheme_type_hash1s;
00241 extern Scheme_Secondary_Hash_Proc *scheme_type_hash2s;
00242 
00243 void scheme_init_port_config(void);
00244 void scheme_init_port_fun_config(void);
00245 Scheme_Config *scheme_init_error_escape_proc(Scheme_Config *c);
00246 void scheme_init_error_config(void);
00247 #ifndef NO_SCHEME_EXNS
00248 void scheme_init_exn_config(void);
00249 #endif
00250 #ifdef WINDOWS_PROCESSES
00251 void scheme_init_thread_memory(void);
00252 #endif
00253 void scheme_init_module_resolver(void);
00254 
00255 void scheme_finish_kernel(Scheme_Env *env);
00256 
00257 Scheme_Object *scheme_make_initial_inspectors(void);
00258 
00259 extern int scheme_builtin_ref_counter;
00260 
00261 Scheme_Object **scheme_make_builtin_references_table(void);
00262 Scheme_Object *scheme_make_local(Scheme_Type type, int pos, int flags);
00263 
00264 void scheme_add_embedded_builtins(Scheme_Env *env);
00265 void scheme_do_add_global_symbol(Scheme_Env *env, Scheme_Object *sym,
00266                              Scheme_Object *obj, int constant,
00267                              int primitive);
00268 
00269 /*========================================================================*/
00270 /*                                constants                               */
00271 /*========================================================================*/
00272 
00273 extern Scheme_Object *scheme_values_func;
00274 extern Scheme_Object *scheme_procedure_p_proc;
00275 extern Scheme_Object *scheme_procedure_arity_includes_proc;
00276 extern Scheme_Object *scheme_void_proc;
00277 extern Scheme_Object *scheme_cons_proc;
00278 extern Scheme_Object *scheme_mcons_proc;
00279 extern Scheme_Object *scheme_list_proc;
00280 extern Scheme_Object *scheme_list_star_proc;
00281 extern Scheme_Object *scheme_vector_proc;
00282 extern Scheme_Object *scheme_vector_immutable_proc;
00283 extern Scheme_Object *scheme_box_proc;
00284 extern Scheme_Object *scheme_call_with_values_proc;
00285 extern Scheme_Object *scheme_make_struct_type_proc;
00286 extern Scheme_Object *scheme_current_inspector_proc;
00287 
00288 extern Scheme_Object *scheme_define_values_syntax, *scheme_define_syntaxes_syntax;
00289 extern Scheme_Object *scheme_lambda_syntax;
00290 extern Scheme_Object *scheme_begin_syntax;
00291 
00292 extern Scheme_Object *scheme_not_prim;
00293 extern Scheme_Object *scheme_eq_prim;
00294 extern Scheme_Object *scheme_eqv_prim;
00295 extern Scheme_Object *scheme_equal_prim;
00296 
00297 extern Scheme_Object *scheme_def_exit_proc;
00298 
00299 extern THREAD_LOCAL Scheme_Object *scheme_orig_stdout_port;
00300 extern THREAD_LOCAL Scheme_Object *scheme_orig_stdin_port;
00301 extern THREAD_LOCAL Scheme_Object *scheme_orig_stderr_port;
00302 
00303 extern Scheme_Object *scheme_arity_at_least, *scheme_make_arity_at_least;
00304 
00305 extern Scheme_Object *scheme_write_proc, *scheme_display_proc, *scheme_print_proc;
00306 
00307 extern Scheme_Object *scheme_raise_arity_error_proc;
00308 
00309 #ifdef TIME_SYNTAX
00310 extern Scheme_Object *scheme_date;
00311 #endif
00312 
00313 extern Scheme_Object *scheme_module_stx;
00314 extern Scheme_Object *scheme_begin_stx;
00315 extern Scheme_Object *scheme_define_values_stx;
00316 extern Scheme_Object *scheme_define_syntaxes_stx;
00317 extern Scheme_Object *scheme_top_stx;
00318 
00319 extern Scheme_Object *scheme_recur_symbol, *scheme_display_symbol, *scheme_write_special_symbol;
00320 
00321 extern Scheme_Object *scheme_none_symbol, *scheme_line_symbol, *scheme_block_symbol;
00322 
00323 extern Scheme_Object *scheme_stack_dump_key;
00324 
00325 extern Scheme_Object *scheme_default_prompt_tag;
00326 
00327 extern Scheme_Object *scheme_system_idle_channel;
00328 
00329 extern Scheme_Object *scheme_input_port_property, *scheme_output_port_property;
00330 
00331 extern Scheme_Object *scheme_equal_property;
00332 
00333 extern Scheme_Object *scheme_reduced_procedure_struct;
00334 
00335 /*========================================================================*/
00336 /*                    thread state and maintenance                        */
00337 /*========================================================================*/
00338 
00339 #define RUNSTACK_IS_GLOBAL
00340 
00341 #ifdef RUNSTACK_IS_GLOBAL
00342 extern THREAD_LOCAL Scheme_Object **scheme_current_runstack;
00343 extern THREAD_LOCAL Scheme_Object **scheme_current_runstack_start;
00344 extern THREAD_LOCAL MZ_MARK_STACK_TYPE scheme_current_cont_mark_stack;
00345 extern THREAD_LOCAL MZ_MARK_POS_TYPE scheme_current_cont_mark_pos;
00346 # define MZ_RUNSTACK scheme_current_runstack
00347 # define MZ_RUNSTACK_START scheme_current_runstack_start
00348 # define MZ_CONT_MARK_STACK scheme_current_cont_mark_stack
00349 # define MZ_CONT_MARK_POS scheme_current_cont_mark_pos
00350 #else
00351 # define MZ_RUNSTACK (scheme_current_thread->runstack)
00352 # define MZ_RUNSTACK_START (scheme_current_thread->runstack_start)
00353 # define MZ_CONT_MARK_STACK (scheme_current_thread->cont_mark_stack)
00354 # define MZ_CONT_MARK_POS (scheme_current_thread->cont_mark_pos)
00355 #endif
00356 
00357 extern volatile int scheme_fuel_counter;
00358 
00359 extern THREAD_LOCAL Scheme_Thread *scheme_main_thread;
00360 
00361 #ifdef MZ_USE_PLACES
00362 extern THREAD_LOCAL Scheme_Thread *scheme_current_thread;
00363 extern THREAD_LOCAL Scheme_Thread *scheme_first_thread;
00364 #define scheme_eval_wait_expr (scheme_current_thread->ku.eval.wait_expr)
00365 #define scheme_tail_rator (scheme_current_thread->ku.apply.tail_rator)
00366 #define scheme_tail_num_rands (scheme_current_thread->ku.apply.tail_num_rands)
00367 #define scheme_tail_rands (scheme_current_thread->ku.apply.tail_rands)
00368 #define scheme_overflow_reply (scheme_current_thread->overflow_reply)
00369 #define scheme_error_buf *(scheme_current_thread->error_buf)
00370 #define scheme_jumping_to_continuation (scheme_current_thread->cjs.jumping_to_continuation)
00371 #define scheme_multiple_count (scheme_current_thread->ku.multiple.count)
00372 #define scheme_multiple_array (scheme_current_thread->ku.multiple.array)
00373 #include "mzrt.h"
00374 extern mz_proc_thread *scheme_master_proc_thread;
00375 extern THREAD_LOCAL mz_proc_thread *proc_thread_self;
00376 #endif
00377 
00378 extern THREAD_LOCAL int scheme_no_stack_overflow;
00379 
00380 typedef struct Scheme_Thread_Set {
00381   Scheme_Object so;
00382   struct Scheme_Thread_Set *parent;
00383   Scheme_Object *first;
00384   Scheme_Object *next;
00385   Scheme_Object *prev;
00386   Scheme_Object *search_start;
00387   Scheme_Object *current;
00388 } Scheme_Thread_Set;
00389 
00390 extern THREAD_LOCAL Scheme_Thread_Set *scheme_thread_set_top;
00391 
00392 #define SCHEME_TAIL_COPY_THRESHOLD 5
00393 
00394 /* Flags for Scheme_Thread's `running' field: */
00395 #define MZTHREAD_RUNNING 0x1
00396 #define MZTHREAD_SUSPENDED 0x2
00397 #define MZTHREAD_KILLED 0x4
00398 #define MZTHREAD_NEED_KILL_CLEANUP 0x8
00399 #define MZTHREAD_USER_SUSPENDED 0x10
00400 #define MZTHREAD_NEED_SUSPEND_CLEANUP 0x20
00401 #define MZTHREAD_STILL_RUNNING(running) ((running) && !((running) & MZTHREAD_KILLED))
00402 
00403 #ifdef WINDOWS_PROCESSES
00404 MZ_EXTERN struct Scheme_Thread_Memory *scheme_remember_thread(void *, int);
00405 void scheme_remember_subthread(struct Scheme_Thread_Memory *, void *);
00406 MZ_EXTERN void scheme_forget_thread(struct Scheme_Thread_Memory *);
00407 void scheme_forget_subthread(struct Scheme_Thread_Memory *);
00408 void scheme_suspend_remembered_threads(void);
00409 void scheme_resume_remembered_threads(void);
00410 #endif
00411 #if defined(USE_WIN32_THREAD_TIMER) || defined(USE_PTHREAD_THREAD_TIMER)
00412 void scheme_start_itimer_thread(long usec);
00413 #endif
00414 
00415 #ifdef UNIX_PROCESSES
00416 void scheme_block_child_signals(int block);
00417 #endif
00418 
00419 Scheme_Object **scheme_alloc_runstack(long len);
00420 void scheme_set_runstack_limits(Scheme_Object **rs, long len, long start, long end);
00421 
00422 void scheme_alloc_list_stack(Scheme_Thread *p);
00423 void scheme_clean_list_stack(Scheme_Thread *p);
00424 
00425 #ifdef WIN32_THREADS
00426 void *scheme_win32_get_break_semaphore(void *th);
00427 #endif
00428 
00429 Scheme_Object *scheme_get_thread_dead(Scheme_Thread *p);
00430 Scheme_Object *scheme_get_thread_suspend(Scheme_Thread *p);
00431 
00432 void scheme_zero_unneeded_rands(Scheme_Thread *p);
00433 
00434 int scheme_can_break(Scheme_Thread *p);
00435 
00436 extern int scheme_overflow_count;
00437 
00438 #define MZTHREADELEM(p, x) scheme_ ## x
00439 
00440 struct Scheme_Custodian {
00441   Scheme_Object so;
00442   char shut_down, has_limit, recorded;
00443   int count, alloc, elems;
00444   Scheme_Object ***boxes;
00445   Scheme_Custodian_Reference **mrefs;
00446   Scheme_Close_Custodian_Client **closers;
00447   void **data;
00448 
00449   /* weak indirections: */
00450   Scheme_Custodian_Reference *parent;
00451   Scheme_Custodian_Reference *sibling;
00452   Scheme_Custodian_Reference *children;
00453 
00454   Scheme_Custodian_Reference *global_next;
00455   Scheme_Custodian_Reference *global_prev;
00456 
00457 #ifdef MZ_PRECISE_GC
00458   int gc_owner_set;
00459   Scheme_Object *cust_boxes;
00460   int num_cust_boxes, checked_cust_boxes;
00461 #endif
00462 };
00463 
00464 typedef struct Scheme_Custodian_Box {
00465   Scheme_Object so;
00466   Scheme_Custodian *cust;
00467   Scheme_Object *v;
00468 } Scheme_Custodian_Box;
00469 
00470 Scheme_Thread *scheme_do_close_managed(Scheme_Custodian *m, Scheme_Exit_Closer_Func f);
00471 
00472 typedef struct Scheme_Security_Guard {
00473   Scheme_Object so;
00474   struct Scheme_Security_Guard *parent;
00475   Scheme_Object *file_proc;    /* who-symbol path mode-symbol -> void */
00476   Scheme_Object *network_proc; /* who-symbol host-string-or-'listen port-k -> void */
00477   Scheme_Object *link_proc;    /* who-symbol path path -> void */
00478 } Scheme_Security_Guard;
00479 
00480 /* Always allocated on the stack: */
00481 typedef struct {
00482   Scheme_Thread *false_positive_ok;  /* non-zero => return 1 to swap in thread rather than running Scheme code */
00483   int potentially_false_positive; /* => returning 1 to swap thread in, but truth may be 0 */
00484   Scheme_Object *current_syncing;
00485   double sleep_end;
00486   int w_i;
00487   short spin;
00488   short is_poll;
00489 } Scheme_Schedule_Info;
00490 
00491 typedef Scheme_Object *(*Scheme_Accept_Sync)(Scheme_Object *wrap);
00492 
00493 void scheme_set_sync_target(Scheme_Schedule_Info *sinfo, Scheme_Object *target,
00494                          Scheme_Object *wrap, Scheme_Object *nack,
00495                          int repost, int retry, Scheme_Accept_Sync accept);
00496 struct Syncing;
00497 void scheme_accept_sync(struct Syncing *syncing, int i);
00498 
00499 typedef int (*Scheme_Ready_Fun_FPC)(Scheme_Object *o, Scheme_Schedule_Info *sinfo);
00500 
00501 void scheme_check_break_now(void);
00502 
00503 extern int scheme_main_was_once_suspended;
00504 
00505 /* A "flattened" config. Maps parameters to thread cells. */
00506 typedef struct {
00507   MZTAG_IF_REQUIRED
00508   Scheme_Bucket_Table *extensions;
00509   Scheme_Object *prims[1];
00510 } Scheme_Parameterization;
00511 
00512 struct Scheme_Config {
00513   Scheme_Object so;
00514   Scheme_Object *key;
00515   Scheme_Object *cell;
00516   int depth;
00517   struct Scheme_Config *next;
00518 };
00519 
00520 extern Scheme_Object *scheme_parameterization_key;
00521 extern Scheme_Object *scheme_exn_handler_key;
00522 extern Scheme_Object *scheme_break_enabled_key;
00523 
00524 extern void scheme_flatten_config(Scheme_Config *c);
00525 
00526 extern Scheme_Object *scheme_apply_thread_thunk(Scheme_Object *rator);
00527 
00528 /*========================================================================*/
00529 /*                       hash tables and globals                          */
00530 /*========================================================================*/
00531 
00532 /* a primitive constant: */
00533 #define GLOB_IS_CONST 1
00534 /* always defined as the same kind of value (e.g., proc with a particular arity): */
00535 #define GLOB_IS_CONSISTENT 2
00536 /* a kernel constant: */
00537 #define GLOB_HAS_REF_ID 16
00538 /* can cast to Scheme_Bucket_With_Home: */
00539 #define GLOB_HAS_HOME_PTR 32
00540 /* Scheme-level constant (cannot be changed further): */
00541 #define GLOB_IS_IMMUTATED 64
00542 
00543 typedef struct {
00544   Scheme_Bucket bucket;
00545   short flags, id;
00546 } Scheme_Bucket_With_Flags;
00547 
00548 typedef Scheme_Bucket_With_Flags Scheme_Bucket_With_Ref_Id;
00549 
00550 typedef struct {
00551   Scheme_Bucket_With_Ref_Id bucket;
00552   Scheme_Env *home;
00553 } Scheme_Bucket_With_Home;
00554 
00555 Scheme_Object *
00556 scheme_get_primitive_global(Scheme_Object *var, Scheme_Env *env,
00557                          int bucket_ok, int can_opt, int signal);
00558 
00559 void scheme_add_bucket_to_table(Scheme_Bucket_Table *table, Scheme_Bucket *b);
00560 Scheme_Bucket *scheme_bucket_or_null_from_table(Scheme_Bucket_Table *table, const char *key, int add);
00561 
00562 struct Scheme_Hash_Tree
00563 {
00564   Scheme_Inclhash_Object iso; /* 0x1 flag => equal?-based hashing; 0x2 flag => eqv?-based hashing */
00565   int count;
00566   struct RBNode *root;
00567   Scheme_Object *elems_box; /* vector in a weak box */
00568 };
00569 
00570 #define SCHEME_HASHTR_FLAGS(tr) MZ_OPT_HASH_KEY(&(tr)->iso)
00571 
00572 /*========================================================================*/
00573 /*                              structs                                   */
00574 /*========================================================================*/
00575 
00576 typedef struct Scheme_Inspector {
00577   Scheme_Object so;
00578   int depth;
00579   struct Scheme_Inspector *superior;
00580 } Scheme_Inspector;
00581 
00582 typedef struct Scheme_Struct_Property {
00583   Scheme_Object so;
00584   Scheme_Object *name; /* a symbol */
00585   Scheme_Object *guard; /* NULL or a procedure */
00586   Scheme_Object *supers; /* implied properties: listof (cons <prop> <proc>) */
00587 } Scheme_Struct_Property;
00588 
00589 int scheme_inspector_sees_part(Scheme_Object *s, Scheme_Object *insp, int pos);
00590 
00591 typedef struct Scheme_Struct_Type {
00592   Scheme_Inclhash_Object iso; /* scheme_structure_type or scheme_proc_struct_type */
00593   mzshort num_slots;   /* initialized + auto + parent-initialized + parent-auto */
00594   mzshort num_islots; /* initialized + parent-initialized */
00595   mzshort name_pos;
00596 
00597   Scheme_Object *name;
00598 
00599   Scheme_Object *inspector;
00600   Scheme_Object *accessor, *mutator;
00601   Scheme_Object *prefab_key;
00602 
00603   Scheme_Object *uninit_val;
00604 
00605   Scheme_Object **props; /* normally an array of pair of (property, value) pairs */
00606   int num_props; /* < 0 => props is really a hash table */
00607 
00608   Scheme_Object *proc_attr; /* int (position) or proc, only for proc_struct */
00609   char *immutables; /* for immediate slots, only (not parent) */
00610 
00611   Scheme_Object *guard;
00612 
00613   struct Scheme_Struct_Type *parent_types[1];
00614 } Scheme_Struct_Type;
00615 
00616 #define STRUCT_TYPE_ALL_IMMUTABLE 0x1
00617 #define STRUCT_TYPE_CHECKED_PROC  0x2
00618 
00619 typedef struct Scheme_Structure
00620 {
00621   Scheme_Object so;
00622   Scheme_Struct_Type *stype;
00623   Scheme_Object *slots[1];
00624 } Scheme_Structure;
00625 
00626 typedef struct Struct_Proc_Info {
00627   MZTAG_IF_REQUIRED
00628   Scheme_Struct_Type *struct_type;
00629   char *func_name;
00630   mzshort field;
00631 } Struct_Proc_Info;
00632 
00633 #define SCHEME_STRUCT_TYPE(o) (((Scheme_Structure *)o)->stype)
00634 
00635 #define SCHEME_STRUCT_NUM_SLOTS(o) (SCHEME_STRUCT_TYPE(o)->num_slots)
00636 #define SCHEME_STRUCT_NAME_SYM(o) (SCHEME_STRUCT_TYPE(o)->name)
00637 
00638 Scheme_Object **scheme_make_struct_names_from_array(const char *base,
00639                                               int fcount,
00640                                               const char **field_names,
00641                                               int flags, int *count_out);
00642 Scheme_Object *scheme_make_struct_type_from_string(const char *base,
00643                                              Scheme_Object *parent,
00644                                              int num_fields,
00645                                              Scheme_Object *props,
00646                                              Scheme_Object *guard,
00647                                              int immutable);
00648 Scheme_Object *scheme_make_proc_struct_type(Scheme_Object *base,
00649                                             Scheme_Object *parent,
00650                                             Scheme_Object *inspector,
00651                                             int num_fields, int num_uninit,
00652                                             Scheme_Object *uninit_val,
00653                                             Scheme_Object *proc_attr,
00654                                             Scheme_Object *guard);
00655 
00656 Scheme_Object *scheme_struct_to_vector(Scheme_Object *_s, Scheme_Object *unknown_val, Scheme_Object *insp);
00657 
00658 Scheme_Object *scheme_extract_struct_procedure(Scheme_Object *obj, int num_rands, Scheme_Object **rands, int *is_method);
00659 
00660 Scheme_Object *scheme_proc_struct_name_source(Scheme_Object *a);
00661 
00662 Scheme_Object *scheme_is_writable_struct(Scheme_Object *s);
00663 
00664 #define SCHEME_STRUCT_INSPECTOR(obj) (((Scheme_Structure *)obj)->stype->inspector)
00665 
00666 extern Scheme_Object *scheme_source_property;
00667 
00668 Scheme_Struct_Type *scheme_lookup_prefab_type(Scheme_Object *key, int field_count);
00669 Scheme_Object *scheme_make_prefab_struct_instance(Scheme_Struct_Type *stype,
00670                                                          Scheme_Object *vec);
00671 Scheme_Object *scheme_clone_prefab_struct_instance(Scheme_Structure *s);
00672 
00673 Scheme_Object *scheme_extract_checked_procedure(int argc, Scheme_Object **argv);
00674 
00675 /*========================================================================*/
00676 /*                         syntax objects                                 */
00677 /*========================================================================*/
00678 
00679 #define MZ_LABEL_PHASE 30000
00680 
00681 typedef struct Scheme_Stx_Srcloc {
00682   MZTAG_IF_REQUIRED
00683   long line, col, pos, span;
00684   Scheme_Object *src;
00685 } Scheme_Stx_Srcloc;
00686 
00687 #define STX_GRAPH_FLAG 0x1
00688 #define STX_SUBSTX_FLAG 0x2
00689 
00690 typedef struct Scheme_Stx {
00691   Scheme_Inclhash_Object iso; /* 0x1 and 0x2 of keyex used */
00692   Scheme_Object *val;
00693   Scheme_Stx_Srcloc *srcloc;
00694   Scheme_Object *wraps;
00695   union {
00696     long lazy_prefix; /* # of insitial items in wraps to propagate */
00697     Scheme_Object *modinfo_cache;
00698   } u;
00699   Scheme_Object *certs; /* cert chain or pair of cert chains */
00700   Scheme_Object *props;
00701 } Scheme_Stx;
00702 
00703 typedef struct Scheme_Stx_Offset {
00704   Scheme_Object so;
00705   long line, col, pos;
00706   Scheme_Object *src;
00707 } Scheme_Stx_Offset;
00708 
00709 struct Scheme_Marshal_Tables;
00710 struct Scheme_Unmarshal_Tables;
00711 
00712 Scheme_Object *scheme_make_stx(Scheme_Object *val,
00713                             Scheme_Stx_Srcloc *srcloc,
00714                             Scheme_Object *props);
00715 Scheme_Object *scheme_make_stx_w_offset(Scheme_Object *val,
00716                                    long line, long col, long pos, long span,
00717                                    Scheme_Object *src,
00718                                    Scheme_Object *props);
00719 Scheme_Object *scheme_make_renamed_stx(Scheme_Object *sym,
00720                                    Scheme_Object *rn);
00721 
00722 Scheme_Object *scheme_new_stx_simplify_cache(void);
00723 void scheme_simplify_stx(Scheme_Object *stx, Scheme_Object *simplify_cache);
00724 
00725 Scheme_Object *scheme_datum_to_syntax(Scheme_Object *o, Scheme_Object *stx_src,
00726                                   Scheme_Object *stx_wraps,
00727                                   int cangraph, int copyprops);
00728 Scheme_Object *scheme_syntax_to_datum(Scheme_Object *stx, int with_marks,
00729                                   struct Scheme_Marshal_Tables *mt);
00730 Scheme_Object *scheme_unmarshal_datum_to_syntax(Scheme_Object *o,
00731                                                 struct Scheme_Unmarshal_Tables *ut,
00732                                                 int can_graph);
00733 
00734 Scheme_Object *scheme_stx_track(Scheme_Object *naya,
00735                             Scheme_Object *old,
00736                             Scheme_Object *origin);
00737 
00738 int scheme_stx_has_empty_wraps(Scheme_Object *);
00739 
00740 Scheme_Object *scheme_new_mark(void);
00741 Scheme_Object *scheme_add_remove_mark(Scheme_Object *o, Scheme_Object *m);
00742 
00743 Scheme_Object *scheme_make_rename(Scheme_Object *newname, int c);
00744 void scheme_set_rename(Scheme_Object *rnm, int pos, Scheme_Object *oldname);
00745 
00746 #define SCHEME_RIBP(v) SAME_TYPE(scheme_lexical_rib_type, SCHEME_TYPE(v))
00747 Scheme_Object *scheme_make_rename_rib(void);
00748 void scheme_add_rib_rename(Scheme_Object *ro, Scheme_Object *rename);
00749 void scheme_drop_first_rib_rename(Scheme_Object *ro);
00750 Scheme_Object *scheme_stx_id_remove_rib(Scheme_Object *stx, Scheme_Object *ro);
00751 void scheme_stx_seal_rib(Scheme_Object *rib);
00752 int *scheme_stx_get_rib_sealed(Scheme_Object *rib);
00753 
00754 Scheme_Object *scheme_add_rename(Scheme_Object *o, Scheme_Object *rename);
00755 Scheme_Object *scheme_add_rename_rib(Scheme_Object *o, Scheme_Object *rib);
00756 Scheme_Object *scheme_add_rib_delimiter(Scheme_Object *o, Scheme_Object *ribs);
00757 
00758 Scheme_Object *scheme_stx_remove_extra_marks(Scheme_Object *o, Scheme_Object *relative_to,
00759                                              Scheme_Object *uid);
00760 
00761 Scheme_Object *scheme_syntax_make_transfer_intro(int argc, Scheme_Object **argv);
00762 
00763 void scheme_install_free_id_rename(Scheme_Object *id, 
00764                                    Scheme_Object *orig_id,
00765                                    Scheme_Object *rename_rib,
00766                                    Scheme_Object *phase);
00767 
00768 #define mzMOD_RENAME_TOPLEVEL 0
00769 #define mzMOD_RENAME_NORMAL   1
00770 #define mzMOD_RENAME_MARKED   2
00771 
00772 struct Scheme_Module_Phase_Exports; /* forward declaration */
00773 
00774 Scheme_Object *scheme_make_module_rename_set(int kind, Scheme_Object *share_marked_names);
00775 void scheme_add_module_rename_to_set(Scheme_Object *set, Scheme_Object *rn);
00776 Scheme_Object *scheme_get_module_rename_from_set(Scheme_Object *set, Scheme_Object *phase, int create);
00777 
00778 Scheme_Hash_Table *scheme_get_module_rename_marked_names(Scheme_Object *set, Scheme_Object *phase, int create);
00779 
00780 void scheme_append_rename_set_to_env(Scheme_Object *rns, Scheme_Env *env);
00781 
00782 void scheme_seal_module_rename(Scheme_Object *rn, int level);
00783 void scheme_seal_module_rename_set(Scheme_Object *rns, int level);
00784 #define STX_SEAL_BOUND 1
00785 #define STX_SEAL_ALL   2
00786 
00787 Scheme_Object *scheme_make_module_rename(Scheme_Object *phase, int kind, Scheme_Hash_Table *mns);
00788 Scheme_Object* scheme_extend_module_rename(Scheme_Object *rn, Scheme_Object *modname,
00789                                            Scheme_Object *locname, Scheme_Object *exname,
00790                                            Scheme_Object *nominal_src, Scheme_Object *nominal_ex,
00791                                            int mod_phase, Scheme_Object *src_phase_index, 
00792                                            Scheme_Object *nom_export_phase, Scheme_Object *insp,
00793                                            int mode);
00794 void scheme_extend_module_rename_with_shared(Scheme_Object *rn, Scheme_Object *modidx, 
00795                                              struct Scheme_Module_Phase_Exports *pt, 
00796                                              Scheme_Object *unmarshal_phase_index,
00797                                              Scheme_Object *src_phase_index, 
00798                                              Scheme_Object *marks,
00799                                              int save_unmarshal);
00800 void scheme_save_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info);
00801 void scheme_do_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info,
00802                                    Scheme_Object *modidx_shift_from, Scheme_Object *modidx_shift_to,
00803                                    Scheme_Hash_Table *export_registry);
00804 Scheme_Object *scheme_get_kernel_modidx(void);
00805 void scheme_remove_module_rename(Scheme_Object *mrn,
00806                              Scheme_Object *localname);
00807 void scheme_append_module_rename(Scheme_Object *src, Scheme_Object *dest, int with_unmarshal);
00808 void scheme_list_module_rename(Scheme_Object *src, Scheme_Hash_Table *ht);
00809 
00810 Scheme_Object *scheme_rename_to_stx(Scheme_Object *rn);
00811 Scheme_Object *scheme_stx_to_rename(Scheme_Object *stx);
00812 Scheme_Object *scheme_stx_shift_rename(Scheme_Object *mrn, Scheme_Object *old_midx, Scheme_Object *new_midx);
00813 Scheme_Object *scheme_stx_shift_rename_set(Scheme_Object *mrns, Scheme_Object *old_midx, Scheme_Object *new_midx);
00814 Scheme_Hash_Table *scheme_module_rename_marked_names(Scheme_Object *rn);
00815 
00816 Scheme_Object *scheme_stx_content(Scheme_Object *o);
00817 Scheme_Object *scheme_flatten_syntax_list(Scheme_Object *lst, int *islist);
00818 
00819 int scheme_stx_module_eq(Scheme_Object *a, Scheme_Object *b, long phase);
00820 int scheme_stx_module_eq2(Scheme_Object *a, Scheme_Object *b, Scheme_Object *phase, Scheme_Object *asym);
00821 Scheme_Object *scheme_stx_get_module_eq_sym(Scheme_Object *a, Scheme_Object *phase);
00822 Scheme_Object *scheme_stx_module_name(Scheme_Hash_Table *recur,
00823                                       Scheme_Object **name, Scheme_Object *phase,
00824                                   Scheme_Object **nominal_modidx,
00825                                   Scheme_Object **nominal_name,
00826                                   Scheme_Object **mod_phase, 
00827                                       Scheme_Object **src_phase_index, 
00828                                       Scheme_Object **nominal_src_phase,
00829                                       Scheme_Object **lex_env,
00830                                       int *_sealed,
00831                                       Scheme_Object **rename_insp);
00832 Scheme_Object *scheme_stx_moduleless_env(Scheme_Object *a);
00833 int scheme_stx_parallel_is_used(Scheme_Object *sym, Scheme_Object *stx);
00834 
00835 int scheme_stx_ribs_matter(Scheme_Object *a, Scheme_Object *skip_ribs);
00836 
00837 int scheme_stx_bound_eq(Scheme_Object *a, Scheme_Object *b, Scheme_Object *phase);
00838 int scheme_stx_env_bound_eq(Scheme_Object *a, Scheme_Object *b, Scheme_Object *uid, Scheme_Object *phase);
00839 
00840 Scheme_Object *scheme_stx_source_module(Scheme_Object *stx, int resolve);
00841 
00842 Scheme_Object *scheme_stx_property(Scheme_Object *_stx,
00843                                Scheme_Object *key,
00844                                Scheme_Object *val);
00845 
00846 Scheme_Object *scheme_stx_phase_shift(Scheme_Object *stx, long shift,
00847                                   Scheme_Object *old_midx, Scheme_Object *new_midx,
00848                                   Scheme_Hash_Table *export_registry);
00849 Scheme_Object *scheme_stx_phase_shift_as_rename(long shift,
00850                                           Scheme_Object *old_midx, Scheme_Object *new_midx,
00851                                           Scheme_Hash_Table *export_registry);
00852 
00853 int scheme_stx_list_length(Scheme_Object *list);
00854 int scheme_stx_proper_list_length(Scheme_Object *list);
00855 
00856 Scheme_Object *scheme_stx_extract_marks(Scheme_Object *stx);
00857 
00858 Scheme_Object *scheme_resolve_placeholders(Scheme_Object *obj);
00859 
00860 Scheme_Object *scheme_stx_strip_module_context(Scheme_Object *stx);
00861 
00862 #define SCHEME_STX_VAL(s) ((Scheme_Stx *)s)->val
00863 
00864 #define SCHEME_STX_PAIRP(o) (SCHEME_PAIRP(o) || (SCHEME_STXP(o) && SCHEME_PAIRP(SCHEME_STX_VAL(o))))
00865 #define SCHEME_STX_SYMBOLP(o) (SCHEME_SYMBOLP(o) || (SCHEME_STXP(o) && SCHEME_SYMBOLP(SCHEME_STX_VAL(o))))
00866 #define SCHEME_STX_NULLP(o) (SCHEME_NULLP(o) || (SCHEME_STXP(o) && SCHEME_NULLP(SCHEME_STX_VAL(o))))
00867 
00868 #define SCHEME_STX_CAR(o) (SCHEME_PAIRP(o) ? SCHEME_CAR(o) : SCHEME_CAR(scheme_stx_content(o)))
00869 #define SCHEME_STX_CDR(o) (SCHEME_PAIRP(o) ? SCHEME_CDR(o) : SCHEME_CDR(scheme_stx_content(o)))
00870 #define SCHEME_STX_SYM(o) (SCHEME_STXP(o) ? SCHEME_STX_VAL(o) : o)
00871 
00872 Scheme_Object *scheme_source_to_name(Scheme_Object *code);
00873 
00874 #define STX_SRCTAG scheme_false
00875 
00876 Scheme_Object *scheme_stx_cert(Scheme_Object *o, Scheme_Object *mark, Scheme_Env *menv, Scheme_Object *plus_stx, 
00877                             Scheme_Object *mkey, int active);
00878 int scheme_stx_certified(Scheme_Object *stx, Scheme_Object *extra_certs,
00879                          Scheme_Object *modidx, Scheme_Object *home_insp);
00880 int scheme_module_protected_wrt(Scheme_Object *home_insp, Scheme_Object *insp);
00881 Scheme_Object *scheme_stx_activate_certs(Scheme_Object *stx);
00882 
00883 Scheme_Object *scheme_stx_extract_certs(Scheme_Object *o, Scheme_Object *base_certs);
00884 Scheme_Object *scheme_stx_add_inactive_certs(Scheme_Object *o, Scheme_Object *certs);
00885 Scheme_Object *scheme_stx_propagate_inactive_certs(Scheme_Object *o, Scheme_Object *orig);
00886 
00887 int scheme_stx_has_more_certs(Scheme_Object *id, Scheme_Object *certs, 
00888                            Scheme_Object *than_id, Scheme_Object *than_certs);
00889 
00890 Scheme_Object *scheme_delayed_rename(Scheme_Object **o, long i);
00891 
00892 struct Resolve_Prefix;
00893 void scheme_load_delayed_syntax(struct Resolve_Prefix *rp, long i);
00894 
00895 XFORM_NONGCING Scheme_Object *scheme_phase_index_symbol(int src_phase_index);
00896 
00897 Scheme_Object *scheme_explode_syntax(Scheme_Object *stx, Scheme_Hash_Table *ht);
00898 
00899 /*========================================================================*/
00900 /*                   syntax run-time structures                           */
00901 /*========================================================================*/
00902 
00903 typedef struct {
00904   Scheme_Object so;
00905   mzshort num_args; /* doesn't include rator, so arguments are at args[1]...args[num_args] */
00906   Scheme_Object *args[1];
00907   /* After array of f & args, array of chars for eval type */
00908 } Scheme_App_Rec;
00909 
00910 typedef struct {
00911   Scheme_Inclhash_Object iso; /* keyex used for flags */
00912   Scheme_Object *rator;
00913   Scheme_Object *rand;
00914 } Scheme_App2_Rec;
00915 
00916 #define SCHEME_APPN_FLAGS(app) MZ_OPT_HASH_KEY(&app->iso)
00917 
00918 typedef struct {
00919   Scheme_Inclhash_Object iso; /* keyex used for flags */
00920   Scheme_Object *rator;
00921   Scheme_Object *rand1;
00922   Scheme_Object *rand2;
00923 } Scheme_App3_Rec;
00924 
00925 typedef struct {
00926   Scheme_Object so;
00927   Scheme_Object *test;
00928   Scheme_Object *tbranch;
00929   Scheme_Object *fbranch;
00930 } Scheme_Branch_Rec;
00931 
00932 typedef struct {
00933   Scheme_Object so;
00934   mzshort max_let_depth;
00935   Scheme_Object *code;
00936   struct Resolve_Prefix *prefix;
00937 } Scheme_Compilation_Top;
00938 
00939 typedef struct Scheme_Compiled_Let_Value {
00940   Scheme_Object so;
00941   mzshort count;
00942   mzshort position;
00943   int *flags;
00944   Scheme_Object *value;
00945   Scheme_Object *body;
00946 } Scheme_Compiled_Let_Value;
00947 
00948 typedef struct Scheme_Let_Header {
00949   Scheme_Inclhash_Object iso; /* keyex used for recursive */
00950   mzshort count;
00951   mzshort num_clauses;
00952   Scheme_Object *body;
00953 } Scheme_Let_Header;
00954 
00955 #define SCHEME_LET_FLAGS(lh) MZ_OPT_HASH_KEY(&lh->iso)
00956 #define SCHEME_LET_RECURSIVE 0x1
00957 #define SCHEME_LET_STAR 0x2
00958 
00959 typedef struct {
00960   Scheme_Object so;
00961   Scheme_Object *key;
00962   Scheme_Object *val;
00963   Scheme_Object *body;
00964 } Scheme_With_Continuation_Mark;
00965 
00966 typedef struct Scheme_Local {
00967   Scheme_Inclhash_Object iso; /* keyex used for clear-on-read flag */
00968   mzshort position;
00969 #ifdef MZ_PRECISE_GC
00970 # ifdef MZSHORT_IS_SHORT
00971   /* Everything has to be at least 2 words in size. */
00972   int x;
00973 # endif
00974 #endif
00975 } Scheme_Local;
00976 
00977 #define SCHEME_LOCAL_POS(obj)    (((Scheme_Local *)(obj))->position)
00978 #define SCHEME_LOCAL_FLAGS(obj)  MZ_OPT_HASH_KEY(&((Scheme_Local *)(obj))->iso)
00979 
00980 #define SCHEME_LOCAL_CLEAR_ON_READ 0x1
00981 #define SCHEME_LOCAL_OTHER_CLEARS  0x2
00982 #define SCHEME_LOCAL_CLEARING_MASK 0x3
00983 
00984 typedef struct Scheme_Toplevel {
00985   Scheme_Inclhash_Object iso; /* keyex used for flags (and can't be hashed) */
00986   mzshort depth;
00987   int position;
00988 } Scheme_Toplevel;
00989 
00990 #define SCHEME_TOPLEVEL_DEPTH(obj)    (((Scheme_Toplevel *)(obj))->depth)
00991 #define SCHEME_TOPLEVEL_POS(obj)    (((Scheme_Toplevel *)(obj))->position)
00992 #define SCHEME_TOPLEVEL_FLAGS(obj)  MZ_OPT_HASH_KEY(&((Scheme_Toplevel *)(obj))->iso)
00993 
00994 #define SCHEME_TOPLEVEL_CONST   0x1
00995 #define SCHEME_TOPLEVEL_READY   0x2
00996 #define SCHEME_TOPLEVEL_MUTATED 0x4
00997 
00998 typedef struct Scheme_Quote_Syntax {
00999   Scheme_Object so; /* scheme_quote_syntax_type */
01000   mzshort depth;
01001   mzshort position;
01002   mzshort midpoint;
01003 } Scheme_Quote_Syntax;
01004 
01005 typedef struct Scheme_Let_Value {
01006   Scheme_Inclhash_Object iso; /* keyex used for autobox */
01007   mzshort count;
01008   mzshort position;
01009   Scheme_Object *value;
01010   Scheme_Object *body;
01011 } Scheme_Let_Value;
01012 
01013 #define SCHEME_LET_AUTOBOX(lh) MZ_OPT_HASH_KEY(&lh->iso)
01014 
01015 typedef struct Scheme_Let_One {
01016   Scheme_Inclhash_Object iso; /* keyex used for eval_type */
01017   Scheme_Object *value;
01018   Scheme_Object *body;
01019 } Scheme_Let_One;
01020 
01021 #define SCHEME_LET_EVAL_TYPE(lh) MZ_OPT_HASH_KEY(&lh->iso)
01022 
01023 typedef struct Scheme_Let_Void {
01024   Scheme_Inclhash_Object iso; /* keyex used for autobox */
01025   mzshort count;
01026   Scheme_Object *body;
01027 } Scheme_Let_Void;
01028 
01029 typedef struct Scheme_Letrec {
01030   Scheme_Object so;
01031   mzshort count;
01032   Scheme_Object **procs;
01033   Scheme_Object *body;
01034 } Scheme_Letrec;
01035 
01036 typedef struct {
01037   Scheme_Object so;
01038   mzshort count;
01039   Scheme_Object *array[1];
01040 } Scheme_Sequence;
01041 
01042 typedef struct {
01043   Scheme_Object so;
01044   mzshort count;
01045   Scheme_Object *name; /* see note below */
01046 #ifdef MZ_USE_JIT
01047   struct Scheme_Native_Closure_Data *native_code; /* generated by lightning */
01048 #endif
01049   Scheme_Object *array[1];
01050 } Scheme_Case_Lambda;
01051 /* If count is not 0, then check array[0] for CLOS_IS_METHOD.
01052    Otherwise, name is a boxed symbol (or #f) to indicate a method. */
01053 
01054 #define scheme_make_prim_w_arity2(f, n, mina, maxa, minr, maxr) \
01055   scheme_make_prim_w_everything(f, 1, n, mina, maxa, 0, minr, maxr)
01056 
01057 Scheme_Object *scheme_unclose_case_lambda(Scheme_Object *expr, int jit);
01058 
01059 Scheme_Object *scheme_native_stack_trace(void);
01060 void scheme_clean_native_symtab(void);
01061 void scheme_clean_cust_box_list(void);
01062 #ifndef MZ_PRECISE_GC
01063 void scheme_notify_code_gc(void);
01064 #endif
01065 
01066 /*========================================================================*/
01067 /*                              control flow                              */
01068 /*========================================================================*/
01069 
01070 Scheme_Object *scheme_handle_stack_overflow(Scheme_Object *(*k)(void));
01071 
01072 extern THREAD_LOCAL struct Scheme_Overflow_Jmp *scheme_overflow_jmp;
01073 extern THREAD_LOCAL void *scheme_overflow_stack_start;
01074 
01075 #ifdef MZ_PRECISE_GC
01076 # define PROMPT_STACK(id) &__gc_var_stack__
01077 #else
01078 # define PROMPT_STACK(id) ((void *)(&id))
01079 #endif
01080 
01081 struct Scheme_Overflow_Jmp *scheme_prune_jmpup(struct Scheme_Overflow_Jmp *jmp, void *stack_boundary);
01082 
01083 void scheme_jmpup_free(Scheme_Jumpup_Buf *);
01084 void *scheme_enlarge_runstack(long size, void *(*k)());
01085 int scheme_check_runstack(long size);
01086 
01087 #ifndef MZ_PRECISE_GC
01088 void scheme_init_setjumpup(void);
01089 void scheme_init_ephemerons(void);
01090 #endif
01091 
01092 #ifdef MZ_PRECISE_GC
01093 void scheme_flush_stack_copy_cache(void);
01094 #endif
01095 
01096 typedef struct Scheme_Dynamic_State {
01097     struct Scheme_Comp_Env * volatile current_local_env;
01098     Scheme_Object * volatile mark;
01099     Scheme_Object * volatile name;
01100     Scheme_Object * volatile certs;
01101     Scheme_Object * volatile modidx;
01102     Scheme_Env    * volatile menv;
01103 } Scheme_Dynamic_State;
01104 
01105 void scheme_set_dynamic_state(Scheme_Dynamic_State *state, struct Scheme_Comp_Env *env, Scheme_Object *mark, 
01106                               Scheme_Object *name, 
01107                               Scheme_Object *certs, 
01108                               Scheme_Env *menv,
01109                               Scheme_Object *modidx);
01110 void *scheme_top_level_do(void *(*k)(void), int eb);
01111 void *scheme_top_level_do_worker(void *(*k)(void), int eb, int newthread, Scheme_Dynamic_State *dyn_state);
01112 
01113 Scheme_Object *scheme_call_ec(int argc, Scheme_Object *argv[]);
01114 
01115 unsigned long scheme_get_deeper_address(void);
01116 
01117 #ifdef DO_STACK_CHECK
01118 void scheme_init_stack_limit (void);
01119 #endif
01120 
01121 
01122 typedef struct Scheme_Saved_Stack {
01123   MZTAG_IF_REQUIRED
01124   Scheme_Object **runstack_start;
01125   long runstack_offset;
01126   long runstack_size;
01127   struct Scheme_Saved_Stack *prev;
01128 } Scheme_Saved_Stack;
01129 
01130 typedef struct Scheme_Cont_Mark {
01131   /* Precise GC: We leave out the tag and make sure everything
01132      is a pointer, then allocate with GC_malloc_allow_interior */
01133   Scheme_Object *key;
01134   Scheme_Object *val;
01135   Scheme_Object *cache; /* chain and/or shortcut */
01136   MZ_MARK_POS_TYPE pos; /* Odd numbers - so they look like non-pointers */
01137 } Scheme_Cont_Mark;
01138 
01139 typedef struct Scheme_Cont_Mark_Chain {
01140   Scheme_Object so;
01141   Scheme_Object *key;
01142   Scheme_Object *val;
01143   MZ_MARK_POS_TYPE pos;
01144   struct Scheme_Cont_Mark_Chain *next;
01145 } Scheme_Cont_Mark_Chain;
01146 
01147 typedef struct Scheme_Cont_Mark_Set {
01148   Scheme_Object so;
01149   struct Scheme_Cont_Mark_Chain *chain;
01150   long cmpos;
01151   Scheme_Object *native_stack_trace;
01152 } Scheme_Cont_Mark_Set;
01153 
01154 #define SCHEME_LOG_MARK_SEGMENT_SIZE 6
01155 #define SCHEME_MARK_SEGMENT_SIZE (1 << SCHEME_LOG_MARK_SEGMENT_SIZE)
01156 #define SCHEME_MARK_SEGMENT_MASK (SCHEME_MARK_SEGMENT_SIZE - 1)
01157 
01158 typedef struct Scheme_Stack_State {
01159   long runstack_offset;
01160   MZ_MARK_POS_TYPE cont_mark_pos;
01161   MZ_MARK_STACK_TYPE cont_mark_stack;
01162 } Scheme_Stack_State;
01163 
01164 typedef struct Scheme_Dynamic_Wind {
01165   MZTAG_IF_REQUIRED
01166   int depth;
01167   void *id; /* generated as needed */
01168   void *data;
01169   Scheme_Object *prompt_tag; /* If not NULL, indicates a fake D-W record for prompt boundary */
01170   void (*pre)(void *);
01171   void (*post)(void *);
01172   mz_jmp_buf *saveerr;
01173   int next_meta; /* amount to move forward in the meta-continuation chain, starting with next */
01174   struct Scheme_Stack_State envss;
01175   struct Scheme_Dynamic_Wind *prev;
01176 } Scheme_Dynamic_Wind;
01177 
01178 typedef struct Scheme_Cont {
01179   Scheme_Object so;
01180   char composable, has_prompt_dw, need_meta_prompt;
01181   struct Scheme_Meta_Continuation *meta_continuation;
01182   Scheme_Jumpup_Buf buf;
01183   Scheme_Dynamic_Wind *dw;
01184   int next_meta;
01185   Scheme_Continuation_Jump_State cjs;
01186   Scheme_Stack_State ss;
01187   struct Scheme_Prompt *barrier_prompt; /* NULL if no barrier between cont and prompt */
01188   Scheme_Object **runstack_start;
01189   long runstack_size;
01190   Scheme_Saved_Stack *runstack_saved;
01191   Scheme_Object *prompt_tag;
01192   mz_jmp_buf *prompt_buf; /* needed for meta-prompt */
01193   MZ_MARK_POS_TYPE meta_tail_pos; /* to recognize opportunity for meta-tail calls */
01194   MZ_MARK_POS_TYPE cont_mark_pos_bottom; /* to splice cont mark values with meta-cont */
01195   void *prompt_stack_start;
01196   Scheme_Saved_Stack *runstack_copied;
01197   Scheme_Thread **runstack_owner;
01198   Scheme_Cont_Mark *cont_mark_stack_copied;
01199   Scheme_Thread **cont_mark_stack_owner;
01200   long cont_mark_total; /* size of the copied array plus cont_mark_offset */
01201   long cont_mark_offset; /* after the array, the original mark stack had this much */
01202   long cont_mark_nonshare; /* amount to skip for sub-cont sharing */
01203   void *stack_start;
01204   Scheme_Object *prompt_id; /* allows direct-jump optimization */
01205   Scheme_Config *init_config;
01206   Scheme_Object *init_break_cell;
01207 #ifdef MZ_USE_JIT
01208   Scheme_Object *native_trace;
01209 #endif
01210   struct Scheme_Overflow *save_overflow;
01211   mz_jmp_buf *savebuf; /* save old error buffer here */
01212 
01213   /* Arguments passed to a continuation invocation to the continuation restorer: */
01214   Scheme_Object *value; /* argument(s) to continuation */
01215   struct Scheme_Overflow *resume_to; /* meta-continuation return */
01216   char empty_to_next_mc;
01217   struct Scheme_Cont *use_next_cont; /* more meta-continuation return */
01218   int common_dw_depth; /* id for common dw record */
01219   Scheme_Dynamic_Wind *common_dw; /* shared part with source cont */
01220   int common_next_meta; /* for common_dw */
01221   Scheme_Object *extra_marks; /* vector of extra keys and marks to add to meta-cont */
01222   struct Scheme_Prompt *shortcut_prompt; /* prompt common to save and restore enabling shortcut */
01223 } Scheme_Cont;
01224 
01225 typedef struct Scheme_Escaping_Cont {
01226   Scheme_Object so;
01227   struct Scheme_Stack_State envss;
01228   struct Scheme_Prompt *barrier_prompt;
01229 #ifdef MZ_USE_JIT
01230   Scheme_Object *native_trace;
01231 #endif
01232   mz_jmp_buf *saveerr;
01233 } Scheme_Escaping_Cont;
01234 
01235 #define SCHEME_CONT_F(obj) (((Scheme_Escaping_Cont *)(obj))->f)
01236 
01237 int scheme_escape_continuation_ok(Scheme_Object *);
01238 
01239 #define scheme_save_env_stack_w_thread(ss, p) \
01240     (ss.runstack_offset = MZ_RUNSTACK - MZ_RUNSTACK_START, \
01241      ss.cont_mark_stack = MZ_CONT_MARK_STACK, ss.cont_mark_pos = MZ_CONT_MARK_POS)
01242 #define scheme_restore_env_stack_w_thread(ss, p) \
01243     (MZ_RUNSTACK = MZ_RUNSTACK_START + ss.runstack_offset, \
01244      MZ_CONT_MARK_STACK = ss.cont_mark_stack, MZ_CONT_MARK_POS = ss.cont_mark_pos)
01245 #define scheme_save_env_stack(ss) \
01246     scheme_save_env_stack_w_thread(ss, scheme_current_thread)
01247 #define scheme_restore_env_stack(ss) \
01248     scheme_restore_env_stack_w_thread(ss, scheme_current_thread)
01249 
01250 void scheme_takeover_stacks(Scheme_Thread *p);
01251 
01252 typedef struct Scheme_Overflow_Jmp {
01253   MZTAG_IF_REQUIRED
01254   char captured; /* set to 1 if possibly captured in a continuation */
01255   Scheme_Jumpup_Buf cont; /* continuation after value obtained in overflowed */
01256   mz_jmp_buf *savebuf; /* save old error buffer pointer here */
01257 } Scheme_Overflow_Jmp;
01258 
01259 typedef struct Scheme_Overflow {
01260   MZTAG_IF_REQUIRED
01261   char eot;      /* set to 1 => pseudo-overflow: continuation is to exit the thread */
01262   Scheme_Overflow_Jmp *jmp; /* overflow data, so it can be shared when an overflow chain is cloned; */
01263   void *id;                 /* identity of overflow record; generated as needed, and often == jmp */
01264   void *stack_start;
01265   struct Scheme_Overflow *prev; /* old overflow info */
01266 } Scheme_Overflow;
01267 
01268 #if defined(UNIX_FIND_STACK_BOUNDS) || defined(WINDOWS_FIND_STACK_BOUNDS) \
01269     || defined(MACOS_FIND_STACK_BOUNDS) || defined(ASSUME_FIXED_STACK_SIZE) \
01270     || defined(BEOS_FIND_STACK_BOUNDS) || defined(OSKIT_FIXED_STACK_BOUNDS) \
01271     || defined(PALM_FIND_STACK_BOUNDS)
01272 # define USE_STACK_BOUNDARY_VAR
01273 extern THREAD_LOCAL unsigned long scheme_stack_boundary;
01274 /* Same as scheme_stack_boundary, but set to an extreme value when feul auto-expires,
01275    so that JIT-generated code can check just one variable: */
01276 extern THREAD_LOCAL unsigned long volatile scheme_jit_stack_boundary;
01277 #endif
01278 
01279 typedef struct Scheme_Meta_Continuation {
01280   MZTAG_IF_REQUIRED
01281   char pseudo; /* if set, don't treat it as a prompt */
01282   char empty_to_next; /* when pseudo, if the continuation is empty to the next one */
01283   char cm_caches; /* cached info in copied cm */
01284   char cm_shared; /* cm is shared, so copy before setting cache entries */
01285   int copy_after_captured; /* for mutating a meta-continuation in set_cont_stack_mark */
01286   int depth;
01287   Scheme_Object *prompt_tag;
01288   /* The C stack: */
01289   Scheme_Overflow *overflow;
01290   MZ_MARK_POS_TYPE meta_tail_pos; /* to recognize opportunity for meta-tail calls */  
01291   MZ_MARK_POS_TYPE cont_mark_pos_bottom; /* to splice cont mark values with meta-cont */
01292   /* Cont mark info: */
01293   MZ_MARK_STACK_TYPE cont_mark_stack;
01294   MZ_MARK_POS_TYPE cont_mark_pos;
01295   long cont_mark_total, cont_mark_offset;
01296   Scheme_Cont_Mark *cont_mark_stack_copied;
01297   /* Continuation (whose cont-mark info is the same as above) */
01298   struct Scheme_Cont *cont;
01299   /* Next: */
01300   struct Scheme_Meta_Continuation *next;
01301 } Scheme_Meta_Continuation;
01302 
01303 typedef struct Scheme_Prompt {
01304   Scheme_Object so;
01305   char is_barrier;
01306   Scheme_Object *tag;
01307   Scheme_Object *id;                  /* created as needed; allows direct-jump optimization for cont app */
01308   void *stack_boundary;               /* where to stop copying the C stack */
01309   void *boundary_overflow_id;         /* indicates the C stack segment */
01310   MZ_MARK_STACK_TYPE mark_boundary;   /* where to stop copying cont marks */
01311   MZ_MARK_POS_TYPE boundary_mark_pos; /* mark position of prompt */
01312   Scheme_Object **runstack_boundary_start; /* which stack has runstack_boundary */
01313   long runstack_boundary_offset;      /* where to stop copying the Scheme stack */
01314   mz_jmp_buf *prompt_buf;             /* to jump directly to the prompt */
01315   long runstack_size;                 /* needed for restore */
01316 } Scheme_Prompt;
01317 
01318 /* Compiler helper: */
01319 #define ESCAPED_BEFORE_HERE  return NULL
01320 
01321 Scheme_Object *scheme_extract_one_cc_mark_with_meta(Scheme_Object *mark_set, 
01322                                                     Scheme_Object *key,
01323                                                     Scheme_Object *prompt_tag,
01324                                                     Scheme_Meta_Continuation **_meta_cont,
01325                                                     MZ_MARK_POS_TYPE *_pos);
01326 Scheme_Object *scheme_compose_continuation(Scheme_Cont *c, int num_rands, Scheme_Object *value);
01327 Scheme_Overflow *scheme_get_thread_end_overflow(void);
01328 void scheme_end_current_thread(void);
01329 void scheme_ensure_dw_id(Scheme_Dynamic_Wind *dw);
01330 void scheme_apply_dw_in_meta(Scheme_Dynamic_Wind *dw, int post, int mc_depth, struct Scheme_Cont *recheck);
01331 
01332 void scheme_drop_prompt_meta_continuations(Scheme_Object *prompt_tag);
01333 
01334 struct Scheme_Prompt *scheme_get_barrier_prompt(struct Scheme_Meta_Continuation **_meta_cont,
01335                                                 MZ_MARK_POS_TYPE *_pos);
01336 int scheme_is_cm_deeper(struct Scheme_Meta_Continuation *m1, MZ_MARK_POS_TYPE p1,
01337                         struct Scheme_Meta_Continuation *m2, MZ_MARK_POS_TYPE p2);
01338 void scheme_recheck_prompt_and_barrier(struct Scheme_Cont *c);
01339 
01340 Scheme_Object *scheme_all_current_continuation_marks(void);
01341 
01342 void scheme_about_to_move_C_stack(void);
01343 
01344 Scheme_Object *scheme_apply_multi_with_dynamic_state(Scheme_Object *rator, int num_rands, Scheme_Object **rands, Scheme_Dynamic_State *dyn_state);
01345 
01346 /*========================================================================*/
01347 /*                         semaphores and locks                           */
01348 /*========================================================================*/
01349 
01350 typedef struct Scheme_Channel_Syncer {
01351   Scheme_Object so;
01352   Scheme_Thread *p;
01353   char in_line, picked;
01354   struct Scheme_Channel_Syncer *prev, *next;
01355   struct Syncing *syncing;
01356   Scheme_Object *obj;
01357   int syncing_i;
01358 } Scheme_Channel_Syncer;
01359 
01360 typedef struct Scheme_Sema {
01361   Scheme_Object so;
01362   Scheme_Channel_Syncer *first, *last;
01363   long value;
01364 } Scheme_Sema;
01365 
01366 typedef struct Scheme_Channel {
01367   Scheme_Object so;
01368   Scheme_Channel_Syncer *put_first, *put_last;
01369   Scheme_Channel_Syncer *get_first, *get_last;
01370 } Scheme_Channel;
01371 
01372 typedef struct Scheme_Channel_Put {
01373   Scheme_Object so;
01374   Scheme_Channel *ch;
01375   Scheme_Object *val;
01376 } Scheme_Channel_Put;
01377 
01378 #define GENERIC_BLOCKED -1
01379 #define NOT_BLOCKED 0
01380 #define SLEEP_BLOCKED 1
01381 
01382 typedef struct Evt_Set {
01383   Scheme_Object so;
01384 
01385   int argc;
01386   Scheme_Object **argv; /* no evt sets; nested sets get flattened */
01387   struct Evt **ws;
01388 } Evt_Set;
01389 
01390 #define SCHEME_EVTSETP(o) SAME_TYPE(SCHEME_TYPE(o), scheme_evt_set_type)
01391 
01392 typedef struct Syncing {
01393   MZTAG_IF_REQUIRED
01394   Evt_Set *set;
01395   int result, start_pos;
01396   double sleep_end;
01397   float timeout;
01398 
01399   Scheme_Object **wrapss;
01400   Scheme_Object **nackss;
01401   char *reposts;
01402   Scheme_Accept_Sync *accepts;
01403 
01404   Scheme_Thread *disable_break; /* when result is set */
01405 } Syncing;
01406 
01407 int scheme_wait_semas_chs(int n, Scheme_Object **o, int just_try, Syncing *syncing);
01408 Scheme_Object *scheme_make_sema_repost(Scheme_Object *sema);
01409 
01410 Scheme_Object *scheme_wrap_evt(int argc, Scheme_Object *argv[]);
01411 Scheme_Object *scheme_poll_evt(int argc, Scheme_Object *argv[]);
01412 
01413 extern Scheme_Object *scheme_always_ready_evt;
01414 
01415 void scheme_get_outof_line(Scheme_Channel_Syncer *ch_w);
01416 void scheme_post_syncing_nacks(Syncing *syncing);
01417 
01418 int scheme_try_channel_get(Scheme_Object *ch);
01419 int scheme_try_channel_put(Scheme_Object *ch, Scheme_Object *v);
01420 
01421 /*========================================================================*/
01422 /*                                 numbers                                */
01423 /*========================================================================*/
01424 
01425 #ifdef MPW_C
01426 /* Optimizer bug! */
01427 # define scheme_exact_zero ((Scheme_Object *)0x1)
01428 # define scheme_exact_one ((Scheme_Object *)0x3)
01429 #else
01430 # define scheme_exact_zero scheme_make_integer(0)
01431 # define scheme_exact_one scheme_make_integer(1)
01432 #endif
01433 
01434 /****** Bignums *******/
01435 
01436 #ifdef USE_LONG_LONG_FOR_BIGDIG
01437 typedef unsigned long long bigdig;
01438 #else
01439 typedef unsigned long bigdig;
01440 #endif
01441 
01442 typedef struct {
01443   Scheme_Inclhash_Object iso;
01444   int len;
01445   bigdig *digits;
01446 } Scheme_Bignum;
01447 
01448 #if MZ_PRECISE_GC
01449 # define SCHEME_BIGPOS(b) (MZ_OPT_HASH_KEY(&((Scheme_Bignum *)b)->iso) & 0x1)
01450 # define SCHEME_SET_BIGPOS(b, v) MZ_OPT_HASH_KEY(&((Scheme_Bignum *)b)->iso) = ((v) | SCHEME_BIGINLINE(b))
01451 # define SCHEME_BIGINLINE(b) (MZ_OPT_HASH_KEY(&((Scheme_Bignum *)b)->iso) & 0x2)
01452 # define SCHEME_SET_BIGINLINE(b) MZ_OPT_HASH_KEY(&((Scheme_Bignum *)b)->iso) |= (0x2 | SCHEME_BIGPOS(b))
01453 #else
01454 # define SCHEME_BIGPOS(b) MZ_OPT_HASH_KEY(&((Scheme_Bignum *)b)->iso)
01455 # define SCHEME_SET_BIGPOS(b, v) SCHEME_BIGPOS(b) = v
01456 #endif
01457 
01458 #define SCHEME_BIGLEN(b) (((Scheme_Bignum *)b)->len)
01459 #define SCHEME_BIGDIG(b) (((Scheme_Bignum *)b)->digits)
01460 
01461 typedef struct {
01462   Scheme_Bignum o;
01463   bigdig v[1];
01464 } Small_Bignum;
01465 
01466 XFORM_NONGCING Scheme_Object *scheme_make_small_bignum(long v, Small_Bignum *s);
01467 char *scheme_number_to_string(int radix, Scheme_Object *obj);
01468 
01469 XFORM_NONGCING int scheme_bignum_get_int_val(const Scheme_Object *o, long *v);
01470 XFORM_NONGCING int scheme_bignum_get_unsigned_int_val(const Scheme_Object *o, unsigned long *v);
01471 XFORM_NONGCING int scheme_bignum_get_long_long_val(const Scheme_Object *o, mzlonglong *v);
01472 XFORM_NONGCING int scheme_bignum_get_unsigned_long_long_val(const Scheme_Object *o, umzlonglong *v);
01473 
01474 XFORM_NONGCING int scheme_bignum_eq(const Scheme_Object *a, const Scheme_Object *b);
01475 XFORM_NONGCING int scheme_bignum_lt(const Scheme_Object *a, const Scheme_Object *b);
01476 XFORM_NONGCING int scheme_bignum_gt(const Scheme_Object *a, const Scheme_Object *b);
01477 XFORM_NONGCING int scheme_bignum_le(const Scheme_Object *a, const Scheme_Object *b);
01478 XFORM_NONGCING int scheme_bignum_ge(const Scheme_Object *a, const Scheme_Object *b);
01479 Scheme_Object *scheme_bignum_negate(const Scheme_Object *n);
01480 Scheme_Object *scheme_bignum_add(const Scheme_Object *a, const Scheme_Object *b);
01481 Scheme_Object *scheme_bignum_subtract(const Scheme_Object *a, const Scheme_Object *b);
01482 Scheme_Object *scheme_bignum_add1(const Scheme_Object *n);
01483 Scheme_Object *scheme_bignum_sub1(const Scheme_Object *n);
01484 Scheme_Object *scheme_bignum_multiply(const Scheme_Object *a, const Scheme_Object *b);
01485 Scheme_Object *scheme_bignum_max(const Scheme_Object *a, const Scheme_Object *b);
01486 Scheme_Object *scheme_bignum_min(const Scheme_Object *a, const Scheme_Object *b);
01487 void scheme_bignum_divide(const Scheme_Object *n, const Scheme_Object *d,
01488                        Scheme_Object **qp, Scheme_Object **rp, int norm);
01489 Scheme_Object *scheme_generic_integer_power(const Scheme_Object *a, const Scheme_Object *b);
01490 Scheme_Object *scheme_bignum_gcd(const Scheme_Object *a, const Scheme_Object *b);
01491 Scheme_Object *scheme_integer_sqrt(const Scheme_Object *n);
01492 Scheme_Object *scheme_integer_sqrt_rem(const Scheme_Object *n, Scheme_Object **r);
01493 Scheme_Object *scheme_bignum_and(const Scheme_Object *a, const Scheme_Object *b);
01494 Scheme_Object *scheme_bignum_or(const Scheme_Object *a, const Scheme_Object *b);
01495 Scheme_Object *scheme_bignum_xor(const Scheme_Object *a, const Scheme_Object *b);
01496 Scheme_Object *scheme_bignum_not(const Scheme_Object *a);
01497 Scheme_Object *scheme_bignum_shift(const Scheme_Object *a, long shift);
01498 
01499 XFORM_NONGCING double scheme_bignum_to_double_inf_info(const Scheme_Object *n, int just_use, int *only_need);
01500 #ifdef MZ_USE_SINGLE_FLOATS
01501 XFORM_NONGCING float scheme_bignum_to_float_inf_info(const Scheme_Object *n, int just_use, int *only_need);
01502 #else
01503 # define scheme_bignum_to_float_inf_info scheme_bignum_to_double_inf_info
01504 #endif
01505 
01506 void scheme_clear_bignum_cache(void);
01507 
01508 long scheme_integer_length(Scheme_Object *n);
01509 
01510 /****** Rational numbers *******/
01511 
01512 typedef struct {
01513   Scheme_Object so;
01514   Scheme_Object *num;
01515   Scheme_Object *denom;
01516 } Scheme_Rational;
01517 
01518 typedef Scheme_Rational Small_Rational;
01519 
01520 XFORM_NONGCING Scheme_Object *scheme_make_small_rational(long n, Small_Rational *space);
01521 XFORM_NONGCING Scheme_Object *scheme_make_small_bn_rational(Scheme_Object *n, Small_Rational *space);
01522 Scheme_Object *scheme_integer_to_rational(const Scheme_Object *n);
01523 Scheme_Object *scheme_make_fixnum_rational(long n, long d);
01524 XFORM_NONGCING int scheme_rational_eq(const Scheme_Object *a, const Scheme_Object *b);
01525 int scheme_rational_lt(const Scheme_Object *a, const Scheme_Object *b);
01526 int scheme_rational_gt(const Scheme_Object *a, const Scheme_Object *b);
01527 int scheme_rational_le(const Scheme_Object *a, const Scheme_Object *b);
01528 int scheme_rational_ge(const Scheme_Object *a, const Scheme_Object *b);
01529 Scheme_Object *scheme_rational_negate(const Scheme_Object *n);
01530 Scheme_Object *scheme_rational_add(const Scheme_Object *a, const Scheme_Object *b);
01531 Scheme_Object *scheme_rational_subtract(const Scheme_Object *a, const Scheme_Object *b);
01532 Scheme_Object *scheme_rational_add1(const Scheme_Object *n);
01533 Scheme_Object *scheme_rational_sub1(const Scheme_Object *n);
01534 Scheme_Object *scheme_rational_multiply(const Scheme_Object *a, const Scheme_Object *b);
01535 Scheme_Object *scheme_rational_max(const Scheme_Object *a, const Scheme_Object *b);
01536 Scheme_Object *scheme_rational_min(const Scheme_Object *a, const Scheme_Object *b);
01537 Scheme_Object *scheme_rational_divide(const Scheme_Object *n, const Scheme_Object *d);
01538 Scheme_Object *scheme_rational_power(const Scheme_Object *a, const Scheme_Object *b);
01539 XFORM_NONGCING int scheme_is_rational_positive(const Scheme_Object *o);
01540 Scheme_Object *scheme_rational_floor(const Scheme_Object *a);
01541 Scheme_Object *scheme_rational_truncate(const Scheme_Object *a);
01542 Scheme_Object *scheme_rational_ceiling(const Scheme_Object *a);
01543 Scheme_Object *scheme_rational_round(const Scheme_Object *a);
01544 Scheme_Object *scheme_rational_sqrt(const Scheme_Object *n);
01545 
01546 /****** Complex numbers *******/
01547 
01548 typedef struct {
01549   Scheme_Object so;
01550   Scheme_Object *r;
01551   Scheme_Object *i;
01552 } Scheme_Complex;
01553 
01554 typedef Scheme_Complex Small_Complex;
01555 
01556 #define _scheme_complex_real_part(n) (((Scheme_Complex *)(n))->r)
01557 #define _scheme_complex_imaginary_part(n) (((Scheme_Complex *)(n))->i)
01558 
01559 Scheme_Object *scheme_make_small_complex(const Scheme_Object *n, Small_Complex *space);
01560 Scheme_Object *scheme_real_to_complex(const Scheme_Object *n);
01561 int scheme_complex_eq(const Scheme_Object *a, const Scheme_Object *b);
01562 Scheme_Object *scheme_complex_negate(const Scheme_Object *n);
01563 Scheme_Object *scheme_complex_add(const Scheme_Object *a, const Scheme_Object *b);
01564 Scheme_Object *scheme_complex_subtract(const Scheme_Object *a, const Scheme_Object *b);
01565 Scheme_Object *scheme_complex_add1(const Scheme_Object *n);
01566 Scheme_Object *scheme_complex_sub1(const Scheme_Object *n);
01567 Scheme_Object *scheme_complex_multiply(const Scheme_Object *a, const Scheme_Object *b);
01568 Scheme_Object *scheme_complex_divide(const Scheme_Object *n, const Scheme_Object *d);
01569 Scheme_Object *scheme_complex_power(const Scheme_Object *a, const Scheme_Object *b);
01570 Scheme_Object *scheme_complex_sqrt(const Scheme_Object *a);
01571 XFORM_NONGCING int scheme_is_complex_exact(const Scheme_Object *o);
01572 
01573 /****** Inexacts ******/
01574 
01575 #define REAL_NUMBER_STR "real number"
01576 
01577 int scheme_check_double(const char *where, double v, const char *dest);
01578 #ifdef MZ_USE_SINGLE_FLOATS
01579 int scheme_check_float(const char *where, float v, const char *dest);
01580 #else
01581 # define scheme_check_float scheme_check_double
01582 #endif
01583 
01584 double scheme_get_val_as_double(const Scheme_Object *n);
01585 XFORM_NONGCING int scheme_minus_zero_p(double d);
01586 
01587 #ifdef MZ_USE_SINGLE_FLOATS
01588 float scheme_get_val_as_float(const Scheme_Object *n);
01589 #endif
01590 
01591 #if !defined(USE_IEEE_FP_PREDS) && !defined(USE_SCO_IEEE_PREDS) \
01592     && !defined(USE_OSF_FP_PREDS) && !defined(USE_PALM_INF_TESTS) \
01593     && !defined(USE_MSVC_FP_PREDS)
01594 # define MZ_IS_POS_INFINITY(d) ((d) == scheme_infinity_val)
01595 # define MZ_IS_NEG_INFINITY(d) ((d) == scheme_minus_infinity_val)
01596 # ifdef NAN_EQUALS_ANYTHING
01597 #  define MZ_IS_NAN(d) (((d) == 1.0) && ((d) == 2.0))
01598 # else
01599 #  ifdef DEFEAT_FP_COMP_OPTIMIZATION
01600 extern int scheme_both_nan(double a, double b);
01601 #   define MZ_IS_NAN(d) (scheme_both_nan(d, d))
01602 #  else
01603 #   define MZ_IS_NAN(d) (!((d) == (d)))
01604 #  endif
01605 # endif
01606 #else
01607 # ifdef USE_SCO_IEEE_PREDS
01608 #  include <ieeefp.h>
01609 #  define MZ_IS_POS_INFINITY(d) (fpclass(d) == FP_PINF)
01610 #  define MZ_IS_NEG_INFINITY(d) (fpclass(d) == FP_NINF)
01611 #  define MZ_IS_NAN(d) isnan(d)
01612 # else
01613 #  ifdef USE_PALM_INF_TESTS
01614 #   define MZ_IS_POS_INFINITY(d) scheme_is_pos_inf(d)
01615 #   define MZ_IS_NEG_INFINITY(d) scheme_is_neg_inf(d)
01616 #   define MZ_IS_NAN(d) scheme_is_nan(d)
01617 extern int scheme_is_pos_inf(double);
01618 extern int scheme_is_neg_inf(double);
01619 extern int scheme_is_nan(double);
01620 #  else
01621 #   ifdef USE_OSF_FP_PREDS
01622 #    include <math.h>
01623 #    include <fp_class.h>
01624 #    define MZ_IS_POS_INFINITY(d) (fp_class(d) == FP_POS_INF)
01625 #    define MZ_IS_NEG_INFINITY(d) (fp_class(d) == FP_NEG_INF)
01626 #    define MZ_IS_NAN(d) isnan(d)
01627 #   else
01628 #    ifdef USE_CARBON_FP_PREDS
01629 #     define MZ_IS_INFINITY(d) (!__isfinited(d))
01630 #     define MZ_IS_POS_INFINITY(d) (!__isfinited(d) && (d > 0))
01631 #     define MZ_IS_NEG_INFINITY(d) (!__isfinited(d) && (d < 0))
01632 #     define MZ_IS_NAN(d) __isnand(d)
01633 #    else
01634 #     ifdef USE_MSVC_FP_PREDS
01635 #      include <float.h>
01636 #      define MZ_IS_POS_INFINITY(d) (_fpclass(d) == _FPCLASS_PINF)
01637 #      define MZ_IS_NEG_INFINITY(d) (_fpclass(d) == _FPCLASS_NINF)
01638 #      define MZ_IS_NAN(d) _isnan(d)
01639 #     else
01640        /* USE_IEEE_FP_PREDS */
01641 #      define MZ_IS_INFINITY(d) (isinf(d))
01642 #      define MZ_IS_POS_INFINITY(d) (isinf(d) && (d > 0))
01643 #      define MZ_IS_NEG_INFINITY(d) (isinf(d) && (d < 0))
01644 #      define MZ_IS_NAN(d) isnan(d)
01645 #     endif
01646 #    endif
01647 #   endif
01648 #  endif
01649 # endif
01650 #endif
01651 
01652 #ifndef MZ_IS_INFINITY
01653 # define MZ_IS_INFINITY(d) (MZ_IS_POS_INFINITY(d) || MZ_IS_NEG_INFINITY(d))
01654 #endif
01655 
01656 #define IZI_REAL_PART(n) (((Scheme_Complex *)(n))->r)
01657 
01658 extern double scheme_infinity_val, scheme_minus_infinity_val;
01659 extern double scheme_floating_point_zero;
01660 extern double scheme_floating_point_nzero;
01661 extern Scheme_Object *scheme_zerod, *scheme_nzerod, *scheme_pi, *scheme_half_pi, *scheme_plus_i, *scheme_minus_i;
01662 extern Scheme_Object *scheme_inf_object, *scheme_minus_inf_object, *scheme_nan_object;
01663 #ifdef MZ_USE_SINGLE_FLOATS
01664 extern Scheme_Object *scheme_zerof, *scheme_nzerof, *scheme_single_scheme_pi;
01665 extern Scheme_Object *scheme_single_inf_object, *scheme_single_minus_inf_object, *scheme_single_nan_object;
01666 #endif
01667 
01668 /****** General numeric ******/
01669 
01670 Scheme_Object *scheme_read_number(const mzchar *str, long len,
01671                               int is_float,
01672                               int is_not_float,
01673                               int decimal_means_float,
01674                               int radix, int radix_set,
01675                               Scheme_Object *port,
01676                               int *div_by_zero,
01677                               int test_only,
01678                               Scheme_Object *stxsrc, long line, long col, long pos, long span,
01679                               Scheme_Object *indentation);
01680 
01681 Scheme_Object *scheme_bin_gcd(const Scheme_Object *n1, const Scheme_Object *n2);
01682 Scheme_Object *scheme_bin_quotient(const Scheme_Object *n1, const Scheme_Object *n2);
01683 Scheme_Object *scheme_bin_mult(const Scheme_Object *n1, const Scheme_Object *n2);
01684 Scheme_Object *scheme_bin_div(const Scheme_Object *n1, const Scheme_Object *n2);
01685 Scheme_Object *scheme_bin_plus(const Scheme_Object *n1, const Scheme_Object *n2);
01686 Scheme_Object *scheme_bin_minus(const Scheme_Object *n1, const Scheme_Object *n2);
01687 int scheme_bin_eq(const Scheme_Object *n1, const Scheme_Object *n2);
01688 int scheme_bin_lt(const Scheme_Object *n1, const Scheme_Object *n2);
01689 int scheme_bin_gt(const Scheme_Object *n1, const Scheme_Object *n2);
01690 int scheme_bin_gt_eq(const Scheme_Object *n1, const Scheme_Object *n2);
01691 int scheme_bin_lt_eq(const Scheme_Object *n1, const Scheme_Object *n2);
01692 
01693 Scheme_Object *scheme_sub1(int argc, Scheme_Object *argv[]);
01694 Scheme_Object *scheme_add1(int argc, Scheme_Object *argv[]);
01695 Scheme_Object *scheme_odd_p(int argc, Scheme_Object *argv[]);
01696 Scheme_Object *scheme_expt(int argc, Scheme_Object *argv[]);
01697 Scheme_Object *scheme_modulo(int argc, Scheme_Object *argv[]);
01698 Scheme_Object *scheme_sqrt(int argc, Scheme_Object *argv[]);
01699 Scheme_Object *scheme_abs(int argc, Scheme_Object *argv[]);
01700 
01701 Scheme_Object *scheme_inexact_to_exact(int argc, Scheme_Object *argv[]);
01702 Scheme_Object *scheme_exact_to_inexact(int argc, Scheme_Object *argv[]);
01703 Scheme_Object *scheme_inexact_p(int argc, Scheme_Object *argv[]);
01704 Scheme_Object *scheme_TO_DOUBLE(const Scheme_Object *n);
01705 Scheme_Object *scheme_to_bignum(const Scheme_Object *o);
01706 XFORM_NONGCING int scheme_is_integer(const Scheme_Object *o);
01707 XFORM_NONGCING int scheme_is_zero(const Scheme_Object *o);
01708 XFORM_NONGCING int scheme_is_negative(const Scheme_Object *o);
01709 XFORM_NONGCING int scheme_is_positive(const Scheme_Object *o);
01710 Scheme_Object *scheme_make_polar(int argc, Scheme_Object *argv[]);
01711 
01712 Scheme_Object *scheme_bitwise_shift(int argc, Scheme_Object *argv[]);
01713 Scheme_Object *scheme_bitwise_and(int argc, Scheme_Object *argv[]);
01714 
01715 int scheme_nonneg_exact_p(Scheme_Object *n);
01716 
01717 #ifdef TIME_TYPE_IS_UNSIGNED
01718 # define scheme_make_integer_value_from_time(t) scheme_make_integer_value_from_unsigned((unsigned long)t)
01719 # define scheme_get_time_val(o, v) scheme_get_unsigned_int_val(o, v)
01720 # define UNBUNDLE_TIME_TYPE unsigned long
01721 #else
01722 # define scheme_make_integer_value_from_time(t) scheme_make_integer_value((long)t)
01723 # define scheme_get_time_val(o, v) scheme_get_int_val(o, v)
01724 # define UNBUNDLE_TIME_TYPE long
01725 #endif
01726 
01727 /***** Random number generator *****/
01728 
01729 #ifdef MZ_BSD_RANDOM_GENERATOR
01730 # define MZ_RANDOM_STATE_DEG 31
01731 typedef struct {
01732   Scheme_Object so;
01733   short fpos, rpos;
01734   long state[MZ_RANDOM_STATE_DEG];
01735 } Scheme_Random_State;
01736 #else
01737 typedef struct {
01738   Scheme_Object so;
01739   double x10, x11, x12, x20, x21, x22; 
01740 } Scheme_Random_State;
01741 #endif
01742 
01743 Scheme_Object *scheme_make_random_state(long seed);
01744 long scheme_rand(Scheme_Random_State *rs);
01745 
01746 /*========================================================================*/
01747 /*                     read, eval, print                                  */
01748 /*========================================================================*/
01749 
01750 #define LOAD_ON_DEMAND
01751 void scheme_clear_delayed_load_cache();
01752 
01753 #define _scheme_do_eval(obj, env, v) \
01754   ((SCHEME_INTP(obj) || !SCHEME_STRTAG_VAL(_SCHEME_TYPE(obj))) \
01755    ? obj : scheme_do_eval(obj, -1, env, v))
01756 #define q_scheme_eval_linked(obj) _scheme_do_eval(obj, 1)
01757 #define q_scheme_tail_eval(obj) scheme_tail_eval(obj)
01758 
01759 Scheme_Object *scheme_eval_linked_expr(Scheme_Object *expr);
01760 Scheme_Object *scheme_eval_linked_expr_multi(Scheme_Object *expr);
01761 Scheme_Object *scheme_eval_linked_expr_multi_with_dynamic_state(Scheme_Object *obj, Scheme_Dynamic_State *dyn_state);
01762 
01763 Scheme_Object *_scheme_apply_to_list (Scheme_Object *rator, Scheme_Object *rands);
01764 Scheme_Object *_scheme_tail_apply_to_list (Scheme_Object *rator, Scheme_Object *rands);
01765 
01766 Scheme_Object *scheme_internal_read(Scheme_Object *port, Scheme_Object *stxsrc, int crc, int cantfail, 
01767                                 int honu_mode, int recur, int expose_comment, int pre_char, Scheme_Object *readtable,
01768                                 Scheme_Object *magic_sym, Scheme_Object *magic_val,
01769                                     Scheme_Object *delay_load_info);
01770 void scheme_internal_display(Scheme_Object *obj, Scheme_Object *port);
01771 void scheme_internal_write(Scheme_Object *obj, Scheme_Object *port);
01772 void scheme_internal_print(Scheme_Object *obj, Scheme_Object *port);
01773 
01774 Scheme_Object *scheme_read_language(Scheme_Object *port, int nonlang_ok);
01775 
01776 #define _scheme_eval_linked_expr(obj) scheme_do_eval(obj,-1,NULL,1)
01777 #define _scheme_eval_linked_expr_multi(obj) scheme_do_eval(obj,-1,NULL,-1)
01778 #define _scheme_eval_linked_expr_wp(obj, p) scheme_do_eval_w_thread(obj,-1,NULL,1,p)
01779 #define _scheme_eval_linked_expr_multi_wp(obj, p) scheme_do_eval_w_thread(obj,-1,NULL,-1,p)
01780 
01781 Scheme_Object *scheme_named_map_1(char *,
01782                               Scheme_Object *(*fun)(Scheme_Object*, Scheme_Object *form),
01783                               Scheme_Object *lst, Scheme_Object *form);
01784 
01785 XFORM_NONGCING int scheme_strncmp(const char *a, const char *b, int len);
01786 
01787 #define _scheme_make_char(ch) scheme_make_character(ch)
01788 
01789 Scheme_Object *scheme_default_eval_handler(int, Scheme_Object *[]);
01790 Scheme_Object *scheme_default_compile_handler(int, Scheme_Object *[]);
01791 Scheme_Object *scheme_default_print_handler(int, Scheme_Object *[]);
01792 Scheme_Object *scheme_default_prompt_read_handler(int, Scheme_Object *[]);
01793 
01794 extern Scheme_Object *scheme_default_global_print_handler;
01795 
01796 /* Type readers & writers for compiled code data */
01797 void scheme_install_type_reader(Scheme_Type type, Scheme_Type_Reader f);
01798 void scheme_install_type_writer(Scheme_Type type, Scheme_Type_Writer f);
01799 
01800 Scheme_Object *scheme_make_default_readtable(void);
01801 
01802 Scheme_Object *_scheme_apply_from_native(Scheme_Object *rator,
01803                                     int argc,
01804                                     Scheme_Object **argv);
01805 Scheme_Object *_scheme_apply_multi_from_native(Scheme_Object *rator,
01806                                           int argc,
01807                                           Scheme_Object **argv);
01808 Scheme_Object *_scheme_tail_apply_from_native(Scheme_Object *rator,
01809                                          int argc,
01810                                          Scheme_Object **argv);
01811 
01812 Scheme_Object *scheme_force_value_same_mark(Scheme_Object *);
01813 Scheme_Object *scheme_force_one_value_same_mark(Scheme_Object *);
01814 
01815 void scheme_flush_stack_cache(void);
01816 
01817 struct Scheme_Load_Delay;
01818 Scheme_Object *scheme_load_delayed_code(int pos, struct Scheme_Load_Delay *ld);
01819 
01820 /*========================================================================*/
01821 /*                          compile and link                              */
01822 /*========================================================================*/
01823 
01824 typedef struct Comp_Prefix
01825 {
01826   MZTAG_IF_REQUIRED
01827   int num_toplevels, num_stxes;
01828   Scheme_Hash_Table *toplevels; /* buckets for toplevel/module variables */
01829   Scheme_Hash_Table *stxes;     /* syntax objects */
01830 } Comp_Prefix;
01831 
01832 typedef struct Scheme_Comp_Env
01833 {
01834   MZTAG_IF_REQUIRED
01835   short flags;          /* used for expanding/compiling */
01836   mzshort num_bindings; /* number of `values' slots */
01837   Scheme_Env *genv;     /* top-level environment */
01838   Scheme_Object *insp;  /* code inspector for checking protected */
01839   Comp_Prefix *prefix;  /* stack base info: globals and stxes */
01840 
01841   struct Scheme_Object **values; /* names bound in this frame */
01842   Scheme_Object *certs; /* extra certs from binding context */
01843 
01844   Scheme_Object *uid;            /* renaming symbol for syntax, if all the same */
01845   struct Scheme_Object **uids;   /* renaming symbol for syntax when multiple are needed */
01846 
01847   struct Scheme_Object *renames; /* an stx lexical rename or a list of them */
01848 
01849   mzshort rename_var_count;      /* number of non-NULL `values' when `renames' was computed */
01850   mzshort rename_rstart;         /* leftover rstart from previous round; see env.c */
01851   Scheme_Hash_Table *dup_check;  /* table for finding colliding symbols in `values' */
01852 
01853   Scheme_Object *intdef_name;    /* syntax-local-context name for INTDEF frames */
01854 
01855   Scheme_Object *in_modidx;      /* an implicit certificate for syntax-local lookup/expand in macro */
01856 
01857   Scheme_Hash_Table *skip_table; /* for jumping ahead in the chain */
01858   int skip_depth;                /* depth in simple frames, used to trigger skip_table creation */
01859 
01860   struct Scheme_Comp_Env *next;
01861 } Scheme_Comp_Env;
01862 
01863 #define CLOS_HAS_REST 1
01864 #define CLOS_HAS_REF_ARGS 2
01865 #define CLOS_PRESERVES_MARKS 4
01866 #define CLOS_SFS 8
01867 #define CLOS_IS_METHOD 16
01868 #define CLOS_SINGLE_RESULT 32
01869 #define CLOS_RESULT_TENTATIVE 64
01870 #define CLOS_VALIDATED 128
01871 /* BITS 8-15 used by write_compiled_closure() */
01872 
01873 typedef struct Scheme_Compile_Expand_Info
01874 {
01875   MZTAG_IF_REQUIRED
01876   short comp;
01877   short comp_flags;
01878   Scheme_Object *value_name;
01879   Scheme_Object *certs;
01880   Scheme_Object *observer;
01881   char dont_mark_local_use;
01882   char resolve_module_ids;
01883   char pre_unwrapped;
01884   char no_module_cert;
01885   int depth;
01886   int env_already;
01887 } Scheme_Compile_Expand_Info;
01888 
01889 #define COMP_ALLOW_SET_UNDEFINED 0x1
01890 #define COMP_CAN_INLINE 0x2
01891 
01892 typedef Scheme_Compile_Expand_Info Scheme_Compile_Info;
01893 typedef Scheme_Compile_Expand_Info Scheme_Expand_Info;
01894 
01895 typedef struct Resolve_Prefix
01896 {
01897   Scheme_Object so;
01898   int num_toplevels, num_stxes, num_lifts;
01899   Scheme_Object **toplevels;
01900   Scheme_Object **stxes; /* simplified */
01901   Scheme_Object *delay_info_rpair; /* (rcons refcount Scheme_Load_Delay*) */
01902 } Resolve_Prefix;
01903 
01904 typedef struct Resolve_Info
01905 {
01906   MZTAG_IF_REQUIRED
01907   char use_jit, in_module, in_proc, enforce_const;
01908   int size, oldsize, count, pos;
01909   int max_let_depth; /* filled in by sub-expressions */
01910   Resolve_Prefix *prefix;
01911   Scheme_Hash_Table *stx_map; /* compile offset => resolve offset; prunes prefix-recored stxes */
01912   mzshort toplevel_pos; /* -1 mean consult next */
01913   mzshort *old_pos;
01914   mzshort *new_pos;
01915   int stx_count;
01916   mzshort *old_stx_pos; /* NULL => consult next; new pos is index in array */
01917   int *flags;
01918   Scheme_Object **lifted; /* maps bindings to lifts */
01919   Scheme_Object *lifts; /* accumulates lift info */
01920   struct Resolve_Info *next;
01921 } Resolve_Info;
01922 
01923 typedef struct Scheme_Object *
01924 (Scheme_Syntax)(struct Scheme_Object *form, struct Scheme_Comp_Env *env,
01925               Scheme_Compile_Info *rec, int drec);
01926 
01927 typedef struct Scheme_Object *
01928 (Scheme_Syntax_Expander)(struct Scheme_Object *form, struct Scheme_Comp_Env *env,
01929                       Scheme_Expand_Info *rec, int drec);
01930 
01931 typedef struct Scheme_Object *(*Scheme_Syntax_Resolver)(Scheme_Object *data, Resolve_Info *info);
01932 
01933 typedef struct Optimize_Info
01934 {
01935   MZTAG_IF_REQUIRED
01936   short flags;
01937   struct Optimize_Info *next;
01938   int original_frame, new_frame;
01939   Scheme_Object *consts;
01940 
01941   /* Propagated up and down the chain: */
01942   int size;
01943   short inline_fuel;
01944   char letrec_not_twice, enforce_const;
01945   Scheme_Hash_Table *top_level_consts;
01946 
01947   /* Set by expression optimization: */
01948   int single_result, preserves_marks; /* negative means "tentative", due to fixpoint in progress */
01949 
01950   char **stat_dists; /* (pos, depth) => used? */
01951   int *sd_depths;
01952   int used_toplevel;
01953   char *use;
01954 
01955   int transitive_use_pos; /* set to pos + 1 when optimizing a letrec-bound procedure */
01956   mzshort **transitive_use;
01957   int *transitive_use_len;
01958 
01959   Scheme_Object *context; /* for logging */
01960 } Optimize_Info;
01961 
01962 typedef struct Scheme_Object *(*Scheme_Syntax_Optimizer)(Scheme_Object *data, Optimize_Info *info);
01963 typedef struct Scheme_Object *(*Scheme_Syntax_Cloner)(int dup_ok, Scheme_Object *data, Optimize_Info *info, int delta, int closure_depth);
01964 typedef struct Scheme_Object *(*Scheme_Syntax_Shifter)(Scheme_Object *data, int delta, int after_depth);
01965 
01966 typedef struct CPort Mz_CPort;
01967 
01968 typedef mzshort **Validate_TLS;
01969 struct Validate_Clearing;
01970 
01971 typedef void (*Scheme_Syntax_Validater)(Scheme_Object *data, Mz_CPort *port, 
01972                                         char *stack, Validate_TLS tls,
01973                                    int depth, int letlimit, int delta,
01974                                    int num_toplevels, int num_stxes, int num_lifts,
01975                                         struct Validate_Clearing *vc, int tailpos);
01976 
01977 typedef struct Scheme_Object *(*Scheme_Syntax_Executer)(struct Scheme_Object *data);
01978 
01979 typedef struct Scheme_Object *(*Scheme_Syntax_Jitter)(struct Scheme_Object *data);
01980 
01981 typedef struct Scheme_Closure_Data
01982 {
01983   Scheme_Inclhash_Object iso; /* keyex used for flags */
01984   mzshort num_params; /* includes collecting arg if has_rest */
01985   mzshort max_let_depth;
01986   mzshort closure_size;
01987   mzshort *closure_map; /* actually a Closure_Info* until resolved; if CLOS_HAS_REF_ARGS, followed by bit array */
01988   Scheme_Object *code;
01989   Scheme_Object *name; /* name or (vector name src line col pos span generated?) */
01990 #ifdef MZ_USE_JIT
01991   union {
01992     struct Scheme_Closure_Data *jit_clone;
01993     struct Scheme_Native_Closure_Data *native_code; /* generated by lightning */
01994   } u;
01995   Scheme_Object *context; /* e.g., a letrec that binds the closure */
01996 #endif
01997 } Scheme_Closure_Data;
01998 
01999 #define SCHEME_CLOSURE_DATA_FLAGS(obj) MZ_OPT_HASH_KEY(&(obj)->iso)
02000 
02001 int scheme_has_method_property(Scheme_Object *code);
02002 
02003 typedef struct {
02004   Scheme_Object so;
02005   Scheme_Closure_Data *code;
02006   Scheme_Object *vals[1];
02007 } Scheme_Closure;
02008 
02009 #define SCHEME_COMPILED_CLOS_CODE(c) ((Scheme_Closure *)c)->code
02010 #define SCHEME_COMPILED_CLOS_ENV(c) ((Scheme_Closure *)c)->vals
02011 
02012 #define ZERO_SIZED_CLOSUREP(closure) !(closure->code->closure_size)
02013 
02014 typedef struct Scheme_Native_Closure_Data {
02015   Scheme_Inclhash_Object iso; /* type tag only set when needed, but flags always needed */
02016   Scheme_Closed_Prim *code;
02017   union {
02018     void *tail_code;                       /* For non-case-lambda */
02019     mzshort *arities;                      /* For case-lambda */
02020   } u;
02021   void *arity_code;
02022   mzshort max_let_depth; /* In bytes instead of words */
02023   mzshort closure_size;
02024   union {
02025     struct Scheme_Closure_Data *orig_code; /* For not-yet-JITted non-case-lambda */
02026     Scheme_Object *name;
02027   } u2;
02028 #ifdef MZ_PRECISE_GC
02029   void **retained; /* inside code */
02030 #endif
02031 } Scheme_Native_Closure_Data;
02032 
02033 #define SCHEME_NATIVE_CLOSURE_DATA_FLAGS(obj) MZ_OPT_HASH_KEY(&(obj)->iso)
02034 
02035 typedef struct {
02036   Scheme_Object so;
02037   Scheme_Native_Closure_Data *code;
02038   Scheme_Object *vals[1];
02039 } Scheme_Native_Closure;
02040 
02041 Scheme_Native_Closure_Data *scheme_generate_lambda(Scheme_Closure_Data *obj, int drop_code, 
02042                                              Scheme_Native_Closure_Data *case_lam);
02043 
02044 #define scheme_new_frame(n) scheme_new_special_frame(n, 0)
02045 #define scheme_extend_env(f, e) (f->basic.next = e, f)
02046 #define scheme_next_frame(e) ((e)->basic.next)
02047 #define scheme_settable_frame(f, s) ((f)->basic.has_set_bang = (s))
02048 #define scheme_get_frame_settable(f) ((f)->basic.has_set_bang)
02049 #define scheme_get_binding(f, n) ((f)->values[n])
02050 
02051 Scheme_Comp_Env *scheme_new_comp_env(Scheme_Env *genv, Scheme_Object *insp, int flags);
02052 Scheme_Comp_Env *scheme_new_expand_env(Scheme_Env *genv, Scheme_Object *insp, int flags);
02053 
02054 void scheme_check_identifier(const char *formname, Scheme_Object *id,
02055                           const char *where,
02056                           Scheme_Comp_Env *env,
02057                           Scheme_Object *form);
02058 int scheme_check_context(Scheme_Env *env, Scheme_Object *id, Scheme_Object *ok_modix);
02059 
02060 Scheme_Object *scheme_check_immediate_macro(Scheme_Object *first,
02061                                        Scheme_Comp_Env *env,
02062                                        Scheme_Compile_Expand_Info *erec, int drec,
02063                                        int int_def_pos,
02064                                        Scheme_Object **current_val,
02065                                        Scheme_Comp_Env **_xenv,
02066                                        Scheme_Object *ctx);
02067 
02068 Scheme_Object *scheme_apply_macro(Scheme_Object *name, Scheme_Env *menv,
02069                               Scheme_Object *f, Scheme_Object *code,
02070                               Scheme_Comp_Env *env, Scheme_Object *boundname,
02071                                   Scheme_Compile_Expand_Info *rec, int drec,
02072                                   int for_set);
02073 
02074 Scheme_Comp_Env *scheme_new_compilation_frame(int num_bindings, int flags, 
02075                                          Scheme_Comp_Env *env, Scheme_Object *certs);
02076 void scheme_add_compilation_binding(int index, Scheme_Object *val,
02077                                 Scheme_Comp_Env *frame);
02078 Scheme_Comp_Env *scheme_add_compilation_frame(Scheme_Object *vals,
02079                                          Scheme_Comp_Env *env, int flags,
02080                                          Scheme_Object *certs);
02081 Scheme_Comp_Env *scheme_require_renames(Scheme_Comp_Env *env);
02082 
02083 Scheme_Object *scheme_lookup_binding(Scheme_Object *symbol, Scheme_Comp_Env *env, int flags, 
02084                                  Scheme_Object *certs, Scheme_Object *in_modidx, 
02085                                  Scheme_Env **_menv, int *_protected,
02086                                      Scheme_Object **_lexical_binding_id);
02087 
02088 Scheme_Object *scheme_add_env_renames(Scheme_Object *stx, Scheme_Comp_Env *env,
02089                                   Scheme_Comp_Env *upto);
02090 
02091 Scheme_Object *scheme_env_frame_uid(Scheme_Comp_Env *env);
02092 
02093 typedef Scheme_Object *(*Scheme_Lift_Capture_Proc)(Scheme_Object *, Scheme_Object **, Scheme_Object *, Scheme_Comp_Env *);
02094 void scheme_frame_captures_lifts(Scheme_Comp_Env *env, Scheme_Lift_Capture_Proc cp, Scheme_Object *data, 
02095                                  Scheme_Object *end_stmts, Scheme_Object *context_key, 
02096                                  Scheme_Object *require_lifts, Scheme_Object *provide_lifts);
02097 void scheme_propagate_require_lift_capture(Scheme_Comp_Env *orig_env, Scheme_Comp_Env *env);
02098 Scheme_Object *scheme_frame_get_lifts(Scheme_Comp_Env *env);
02099 Scheme_Object *scheme_frame_get_end_statement_lifts(Scheme_Comp_Env *env);
02100 Scheme_Object *scheme_frame_get_require_lifts(Scheme_Comp_Env *env);
02101 Scheme_Object *scheme_frame_get_provide_lifts(Scheme_Comp_Env *env);
02102 Scheme_Object *scheme_generate_lifts_key(void);
02103 
02104 Scheme_Object *scheme_toplevel_require_for_expand(Scheme_Object *module_path, 
02105                                                   long phase,
02106                                                   Scheme_Comp_Env *cenv,
02107                                                   Scheme_Object *mark);
02108 Scheme_Object *scheme_parse_lifted_require(Scheme_Object *module_path,
02109                                            long phase,
02110                                            Scheme_Object *mark,
02111                                            void *data);
02112 
02113 void scheme_add_local_syntax(int cnt, Scheme_Comp_Env *env);
02114 void scheme_set_local_syntax(int pos, Scheme_Object *name, Scheme_Object *val,
02115                           Scheme_Comp_Env *env);
02116 
02117 Scheme_Object *scheme_make_closure(Scheme_Thread *p,
02118                                Scheme_Object *compiled_code,
02119                                int close);
02120 Scheme_Closure *scheme_malloc_empty_closure(void);
02121 
02122 Scheme_Object *scheme_make_native_closure(Scheme_Native_Closure_Data *code);
02123 Scheme_Object *scheme_make_native_case_closure(Scheme_Native_Closure_Data *code);
02124 
02125 void scheme_reset_app2_eval_type(Scheme_App2_Rec *app);
02126 
02127 Scheme_Native_Closure_Data *scheme_generate_case_lambda(Scheme_Case_Lambda *cl);
02128 
02129 void scheme_delay_load_closure(Scheme_Closure_Data *data);
02130 
02131 #define scheme_add_good_binding(i,v,f) (f->values[i] = v)
02132 
02133 Scheme_Object *scheme_compiled_void(void);
02134 
02135 Scheme_Object *scheme_register_toplevel_in_prefix(Scheme_Object *var, Scheme_Comp_Env *env,
02136                                             Scheme_Compile_Info *rec, int drec);
02137 Scheme_Object *scheme_register_stx_in_prefix(Scheme_Object *var, Scheme_Comp_Env *env,
02138                                         Scheme_Compile_Info *rec, int drec);
02139 
02140 void scheme_bind_syntaxes(const char *where, Scheme_Object *names, Scheme_Object *a, 
02141                           Scheme_Env *exp_env, Scheme_Object *insp, 
02142                           Scheme_Compile_Expand_Info *rec, int drec,
02143                           Scheme_Comp_Env *stx_env, Scheme_Comp_Env *rhs_env,
02144                           int *_pos, Scheme_Object *rename_rib);
02145 int scheme_is_sub_env(Scheme_Comp_Env *stx_env, Scheme_Comp_Env *env);
02146 
02147 typedef struct SFS_Info {
02148   MZTAG_IF_REQUIRED  
02149   int for_mod, pass;
02150   int tail_pos;
02151   int depth, stackpos, tlpos;
02152   int selfpos, selfstart, selflen;
02153   int ip, seqn, max_nontail;
02154   int min_touch, max_touch;
02155   int *max_used, *max_calls;
02156   Scheme_Object *saved;
02157 } SFS_Info;
02158 
02159 SFS_Info *scheme_new_sfs_info(int depth);
02160 Scheme_Object *scheme_sfs(Scheme_Object *expr, SFS_Info *info, int max_let_depth);
02161 Scheme_Object *scheme_sfs_expr(Scheme_Object *expr, SFS_Info *si, int self_pos);
02162 Scheme_Object *scheme_sfs_closure(Scheme_Object *expr, SFS_Info *si, int self_pos);
02163 
02164 void scheme_sfs_used(SFS_Info *info, int pos);
02165 void scheme_sfs_push(SFS_Info *info, int count, int track);
02166 void scheme_sfs_start_sequence(SFS_Info *si, int cnt, int last_is_tail);
02167 
02168 Scheme_Object *scheme_sfs_add_clears(Scheme_Object *expr, Scheme_Object *clears, int pre);
02169 
02170 typedef struct Scheme_Object *(*Scheme_Syntax_SFSer)(Scheme_Object *data, SFS_Info *info);
02171 
02172 /* Resolving & linking */
02173 #define DEFINE_VALUES_EXPD 0
02174 #define DEFINE_SYNTAX_EXPD 1
02175 #define SET_EXPD           2
02176 #define CASE_LAMBDA_EXPD   3
02177 #define BEGIN0_EXPD        4
02178 #define BOXENV_EXPD        5
02179 #define MODULE_EXPD        6
02180 #define REQUIRE_EXPD       7
02181 #define DEFINE_FOR_SYNTAX_EXPD 8
02182 #define REF_EXPD           9
02183 #define APPVALS_EXPD       10
02184 #define SPLICE_EXPD        11
02185 #define _COUNT_EXPD_       12
02186 
02187 #define scheme_register_syntax(i, fo, fr, fs, fv, fe, fj, cl, sh, pa)    \
02188      (scheme_syntax_optimizers[i] = fo, \
02189       scheme_syntax_resolvers[i] = fr, \
02190       scheme_syntax_executers[i] = fe, \
02191       scheme_syntax_sfsers[i] = fs, \
02192       scheme_syntax_validaters[i] = fv, \
02193       scheme_syntax_jitters[i] = fj, \
02194       scheme_syntax_cloners[i] = cl, \
02195       scheme_syntax_shifters[i] = sh, \
02196       scheme_syntax_protect_afters[i] = pa)
02197 extern Scheme_Syntax_Optimizer scheme_syntax_optimizers[_COUNT_EXPD_];
02198 extern Scheme_Syntax_Resolver scheme_syntax_resolvers[_COUNT_EXPD_];
02199 extern Scheme_Syntax_SFSer scheme_syntax_sfsers[_COUNT_EXPD_];
02200 extern Scheme_Syntax_Validater scheme_syntax_validaters[_COUNT_EXPD_];
02201 extern Scheme_Syntax_Executer scheme_syntax_executers[_COUNT_EXPD_];
02202 extern Scheme_Syntax_Jitter scheme_syntax_jitters[_COUNT_EXPD_];
02203 extern Scheme_Syntax_Cloner scheme_syntax_cloners[_COUNT_EXPD_];
02204 extern Scheme_Syntax_Shifter scheme_syntax_shifters[_COUNT_EXPD_];
02205 extern int scheme_syntax_protect_afters[_COUNT_EXPD_];
02206 
02207 Scheme_Object *scheme_protect_quote(Scheme_Object *expr);
02208 
02209 Scheme_Object *scheme_make_syntax_resolved(int idx, Scheme_Object *data);
02210 Scheme_Object *scheme_make_syntax_compiled(int idx, Scheme_Object *data);
02211 
02212 Scheme_Object *scheme_optimize_expr(Scheme_Object *, Optimize_Info *);
02213 Scheme_Object *scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline);
02214 Scheme_Object *scheme_optimize_lets_for_test(Scheme_Object *form, Optimize_Info *info);
02215 
02216 Scheme_Object *scheme_optimize_apply_values(Scheme_Object *f, Scheme_Object *e, 
02217                                             Optimize_Info *info,
02218                                             int e_single_result);
02219 
02220 int scheme_compiled_duplicate_ok(Scheme_Object *o);
02221 int scheme_compiled_propagate_ok(Scheme_Object *o, Optimize_Info *info);
02222 int scheme_is_statically_proc(Scheme_Object *value, Optimize_Info *info);
02223 Scheme_Object *scheme_make_noninline_proc(Scheme_Object *e);
02224 
02225 Scheme_Object *scheme_resolve_expr(Scheme_Object *, Resolve_Info *);
02226 Scheme_Object *scheme_resolve_list(Scheme_Object *, Resolve_Info *);
02227 
02228 int scheme_is_compiled_procedure(Scheme_Object *o, int can_be_closed, int can_be_liftable);
02229 
02230 Scheme_Object *scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info);
02231 
02232 Resolve_Prefix *scheme_resolve_prefix(int phase, Comp_Prefix *cp, int simplify);
02233 Resolve_Prefix *scheme_remap_prefix(Resolve_Prefix *rp, Resolve_Info *ri);
02234 
02235 Resolve_Info *scheme_resolve_info_create(Resolve_Prefix *rp);
02236 Resolve_Info *scheme_resolve_info_extend(Resolve_Info *info, int size, int oldsize, int mapcount);
02237 void scheme_resolve_info_add_mapping(Resolve_Info *info, int oldp, int newp, int flags, Scheme_Object *lifted);
02238 void scheme_resolve_info_adjust_mapping(Resolve_Info *info, int oldp, int newp, int flags, Scheme_Object *lifted);
02239 int scheme_resolve_info_flags(Resolve_Info *info, int pos, Scheme_Object **lifted);
02240 int scheme_resolve_info_lookup(Resolve_Info *resolve, int pos, int *flags, Scheme_Object **lifted, int convert_shift);
02241 int scheme_optimize_info_is_ready(Optimize_Info *info, int pos);
02242 void scheme_resolve_info_set_toplevel_pos(Resolve_Info *info, int pos);
02243 
02244 void scheme_enable_expression_resolve_lifts(Resolve_Info *ri);
02245 Scheme_Object *scheme_merge_expression_resolve_lifts(Scheme_Object *expr, Resolve_Prefix *rp, Resolve_Info *ri);
02246 
02247 Optimize_Info *scheme_optimize_info_create(void);
02248 
02249 void scheme_optimize_propagate(Optimize_Info *info, int pos, Scheme_Object *value, int single_use);
02250 Scheme_Object *scheme_optimize_info_lookup(Optimize_Info *info, int pos, int *closure_offset, int *single_use);
02251 void scheme_optimize_info_used_top(Optimize_Info *info);
02252 
02253 void scheme_optimize_mutated(Optimize_Info *info, int pos);
02254 Scheme_Object *scheme_optimize_reverse(Optimize_Info *info, int pos, int unless_mutated);
02255 int scheme_optimize_is_used(Optimize_Info *info, int pos);
02256 int scheme_optimize_any_uses(Optimize_Info *info, int start_pos, int end_pos);
02257 
02258 Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *obj, Optimize_Info *info, int delta, int closure_depth);
02259 Scheme_Object *scheme_optimize_shift(Scheme_Object *obj, int delta, int after_depth);
02260 Scheme_Object *scheme_clone_closure_compilation(int dup_ok, Scheme_Object *obj, Optimize_Info *info, int delta, int closure_depth);
02261 Scheme_Object *scheme_shift_closure_compilation(Scheme_Object *obj, int delta, int after_depth);
02262 
02263 int scheme_closure_body_size(Scheme_Closure_Data *closure_data, int check_assign);
02264 int scheme_closure_argument_flags(Scheme_Closure_Data *closure_data, int i);
02265 int scheme_closure_has_top_level(Scheme_Closure_Data *data);
02266 
02267 Optimize_Info *scheme_optimize_info_add_frame(Optimize_Info *info, int orig, int current, int flags);
02268 int scheme_optimize_info_get_shift(Optimize_Info *info, int pos);
02269 void scheme_optimize_info_done(Optimize_Info *info);
02270 
02271 Scheme_Object *scheme_toplevel_to_flagged_toplevel(Scheme_Object *tl, int flags);
02272 
02273 void scheme_env_make_closure_map(Optimize_Info *frame, mzshort *size, mzshort **map);
02274 int scheme_env_uses_toplevel(Optimize_Info *frame);
02275 
02276 int scheme_resolve_toplevel_pos(Resolve_Info *info);
02277 int scheme_resolve_is_toplevel_available(Resolve_Info *info);
02278 int scheme_resolve_quote_syntax_offset(int i, Resolve_Info *info);
02279 int scheme_resolve_quote_syntax_pos(Resolve_Info *info);
02280 Scheme_Object *scheme_resolve_toplevel(Resolve_Info *info, Scheme_Object *expr, int keep_ready);
02281 Scheme_Object *scheme_resolve_invent_toplevel(Resolve_Info *info);
02282 Scheme_Object *scheme_resolve_invented_toplevel_to_defn(Resolve_Info *info, Scheme_Object *tl);
02283 Scheme_Object *scheme_shift_toplevel(Scheme_Object *expr, int delta);
02284 Scheme_Object *scheme_resolve_generate_stub_lift(void);
02285 int scheme_resolve_quote_syntax(Resolve_Info *info, int oldpos);
02286 int scheme_resolving_in_procedure(Resolve_Info *info);
02287 
02288 void scheme_resolve_lift_definition(Resolve_Info *info, Scheme_Object *var, Scheme_Object *rhs);
02289 
02290 Scheme_Object *scheme_make_compiled_syntax(Scheme_Syntax *syntax,
02291                                       Scheme_Syntax_Expander *exp);
02292 
02293 Scheme_Object *scheme_compile_expr(Scheme_Object *form, Scheme_Comp_Env *env,
02294                                Scheme_Compile_Info *rec, int drec);
02295 Scheme_Object *scheme_compile_sequence(Scheme_Object *forms, Scheme_Comp_Env *env,
02296                            Scheme_Compile_Info *rec, int drec);
02297 Scheme_Object *scheme_compile_block(Scheme_Object *forms, Scheme_Comp_Env *env,
02298                            Scheme_Compile_Info *rec, int drec);
02299 Scheme_Object *scheme_compile_list(Scheme_Object *form, Scheme_Comp_Env *env,
02300                            Scheme_Compile_Info *rec, int drec);
02301 
02302 Scheme_Object *scheme_compile_expr_lift_to_let(Scheme_Object *form, Scheme_Comp_Env *env,
02303                                           Scheme_Compile_Info *rec, int drec);
02304 
02305 void scheme_default_compile_rec(Scheme_Compile_Info *src, int drec);
02306 void scheme_compile_rec_done_local(Scheme_Compile_Info *src, int drec);
02307 void scheme_init_compile_recs(Scheme_Compile_Info *src, int drec,
02308                            Scheme_Compile_Info *dest, int n);
02309 void scheme_merge_compile_recs(Scheme_Compile_Info *src, int drec,
02310                             Scheme_Compile_Info *dest, int n);
02311 void scheme_init_lambda_rec(Scheme_Compile_Info *src, int drec,
02312                          Scheme_Compile_Info *lam, int dlrec);
02313 void scheme_merge_lambda_rec(Scheme_Compile_Info *src, int drec,
02314                          Scheme_Compile_Info *lam, int dlrec);
02315 
02316 
02317 void scheme_init_expand_recs(Scheme_Expand_Info *src, int drec,
02318                           Scheme_Expand_Info *dest, int n);
02319 
02320 void scheme_rec_add_certs(Scheme_Compile_Expand_Info *src, int drec, Scheme_Object *stx);
02321 
02322 Scheme_Object *scheme_make_closure_compilation(Scheme_Comp_Env *env,
02323                                           Scheme_Object *uncompiled_code,
02324                                           Scheme_Compile_Info *rec, int drec);
02325 Scheme_Object *scheme_make_sequence_compilation(Scheme_Object *compiled_list,
02326                                           int strip_values);
02327 
02328 Scheme_Object *scheme_optimize_closure_compilation(Scheme_Object *_data, Optimize_Info *info);
02329 Scheme_Object *scheme_resolve_closure_compilation(Scheme_Object *_data, Resolve_Info *info, 
02330                                                   int can_lift, int convert, int just_compute_lift,
02331                                                   Scheme_Object *precomputed_lift);
02332 
02333 Scheme_App_Rec *scheme_malloc_application(int n);
02334 void scheme_finish_application(Scheme_App_Rec *app);
02335 
02336 Scheme_Object *scheme_jit_expr(Scheme_Object *);
02337 Scheme_Object *scheme_jit_closure(Scheme_Object *, Scheme_Object *context);
02338 
02339 Scheme_Object *scheme_build_closure_name(Scheme_Object *code, Scheme_Compile_Info *rec, int drec);
02340 
02341 #define SCHEME_SYNTAX(obj)     SCHEME_PTR1_VAL(obj)
02342 #define SCHEME_SYNTAX_EXP(obj) SCHEME_PTR2_VAL(obj)
02343 
02344 int *scheme_env_get_flags(Scheme_Comp_Env *frame, int start, int count);
02345 
02346 /* flags reported by scheme_env_get_flags */
02347 #define SCHEME_WAS_USED                0x1
02348 #define SCHEME_WAS_SET_BANGED          0x2
02349 #define SCHEME_WAS_ONLY_APPLIED        0x4
02350 #define SCHEME_WAS_APPLIED_EXCEPT_ONCE 0x8
02351 
02352 #define SCHEME_USE_COUNT_MASK   0x70
02353 #define SCHEME_USE_COUNT_SHIFT  4
02354 #define SCHEME_USE_COUNT_INF    (SCHEME_USE_COUNT_MASK >> SCHEME_USE_COUNT_SHIFT)
02355 
02356 /* flags reported by scheme_resolve_info_flags */
02357 #define SCHEME_INFO_BOXED 1
02358 
02359 /* flags used with scheme_new_frame */
02360 #define SCHEME_TOPLEVEL_FRAME 1
02361 #define SCHEME_MODULE_FRAME 2
02362 #define SCHEME_MODULE_BEGIN_FRAME 4
02363 #define SCHEME_LAMBDA_FRAME 8
02364 #define SCHEME_INTDEF_FRAME 16
02365 #define SCHEME_NO_RENAME 32
02366 #define SCHEME_CAPTURE_WITHOUT_RENAME 64
02367 #define SCHEME_FOR_STOPS 128
02368 #define SCHEME_FOR_INTDEF 256
02369 #define SCHEME_CAPTURE_LIFTED 512
02370 #define SCHEME_INTDEF_SHADOW 1024
02371 
02372 /* Flags used with scheme_static_distance */
02373 #define SCHEME_ELIM_CONST 1
02374 #define SCHEME_APP_POS 2
02375 #define SCHEME_SETTING 4
02376 #define SCHEME_ENV_CONSTANTS_OK 8
02377 #define SCHEME_GLOB_ALWAYS_REFERENCE 16
02378 #define SCHEME_MUST_INDRECT 32
02379 #define SCHEME_LINKING_REF 64
02380 #define SCHEME_DONT_MARK_USE 128
02381 #define SCHEME_OUT_OF_CONTEXT_OK 256
02382 #define SCHEME_NULL_FOR_UNBOUND 512
02383 #define SCHEME_RESOLVE_MODIDS 1024
02384 #define SCHEME_NO_CERT_CHECKS 2048
02385 #define SCHEME_REFERENCING 4096
02386 #define SCHEME_OUT_OF_CONTEXT_LOCAL 8192
02387 
02388 Scheme_Hash_Table *scheme_map_constants_to_globals(void);
02389 
02390 Scheme_Object *scheme_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
02391                               Scheme_Expand_Info *erec, int drec);
02392 Scheme_Object *scheme_expand_list(Scheme_Object *form, Scheme_Comp_Env *env,
02393                               Scheme_Expand_Info *erec, int drec);
02394 Scheme_Object *scheme_expand_block(Scheme_Object *form, Scheme_Comp_Env *env,
02395                                Scheme_Expand_Info *erec, int drec);
02396 Scheme_Object *scheme_expand_expr_lift_to_let(Scheme_Object *form, Scheme_Comp_Env *env,
02397                                          Scheme_Expand_Info *erec, int drec);
02398 
02399 Scheme_Object *scheme_flatten_begin(Scheme_Object *expr, Scheme_Object *append_onto);
02400 
02401 Scheme_Object *scheme_make_svector(mzshort v, mzshort *a);
02402 
02403 #define SCHEME_SVEC_LEN(obj) (((Scheme_Simple_Object *)(obj))->u.svector_val.len)
02404 #define SCHEME_SVEC_VEC(obj) (((Scheme_Simple_Object *)(obj))->u.svector_val.vec)
02405 
02406 Scheme_Object *scheme_hash_percent_name(const char *name, int len);
02407 
02408 Scheme_Object *scheme_make_branch(Scheme_Object *test,
02409                               Scheme_Object *tbranch,
02410                               Scheme_Object *fbranch);
02411 
02412 int scheme_is_toplevel(Scheme_Comp_Env *env);
02413 Scheme_Comp_Env *scheme_extend_as_toplevel(Scheme_Comp_Env *env);
02414 
02415 Scheme_Comp_Env *scheme_no_defines(Scheme_Comp_Env *env);
02416 
02417 Scheme_Env *scheme_make_empty_env(void);
02418 void scheme_prepare_exp_env(Scheme_Env *env);
02419 void scheme_prepare_template_env(Scheme_Env *env);
02420 void scheme_prepare_label_env(Scheme_Env *env);
02421 void scheme_prepare_env_renames(Scheme_Env *env, int kind);
02422 
02423 int scheme_used_app_only(Scheme_Comp_Env *env, int which);
02424 int scheme_used_ever(Scheme_Comp_Env *env, int which);
02425 
02426 int scheme_omittable_expr(Scheme_Object *o, int vals, int fuel, int resolved,
02427                           Optimize_Info *warn_info);
02428 
02429 int scheme_is_env_variable_boxed(Scheme_Comp_Env *env, int which);
02430 
02431 int scheme_get_eval_type(Scheme_Object *obj);
02432 
02433 Scheme_Object *scheme_get_stop_expander(void);
02434 
02435 void scheme_define_parse(Scheme_Object *form,
02436                       Scheme_Object **vars, Scheme_Object **val,
02437                       int defmacro,
02438                       Scheme_Comp_Env *env,
02439                          int no_toplevel_check);
02440 
02441 void scheme_shadow(Scheme_Env *env, Scheme_Object *n, int stxtoo);
02442 
02443 int scheme_prefix_depth(Resolve_Prefix *rp);
02444 Scheme_Object **scheme_push_prefix(Scheme_Env *genv, Resolve_Prefix *rp,
02445                                Scheme_Object *src_modix, Scheme_Object *now_modix,
02446                                int src_phase, int now_phase);
02447 void scheme_pop_prefix(Scheme_Object **rs);
02448 
02449 Scheme_Object *scheme_eval_clone(Scheme_Object *expr);
02450 Resolve_Prefix *scheme_prefix_eval_clone(Resolve_Prefix *rp);
02451 Scheme_Object *scheme_module_eval_clone(Scheme_Object *data);
02452 Scheme_Object *scheme_syntaxes_eval_clone(Scheme_Object *form);
02453 
02454 Scheme_Object *scheme_make_environment_dummy(Scheme_Comp_Env *env);
02455 Scheme_Env *scheme_environment_from_dummy(Scheme_Object *dummy);
02456 
02457 void scheme_validate_code(Mz_CPort *port, Scheme_Object *code,
02458                           int depth,
02459                        int num_toplevels, int num_stxes, int num_lifts,
02460                           int code_vec);
02461 void scheme_validate_expr(Mz_CPort *port, Scheme_Object *expr, 
02462                        char *stack, Validate_TLS tls,
02463                           int depth, int letlimit, int delta,
02464                        int num_toplevels, int num_stxes, int num_lifts,
02465                           Scheme_Object *app_rator, int proc_with_refs_ok, 
02466                           int result_ignored, struct Validate_Clearing *vc, int tailpos);
02467 void scheme_validate_toplevel(Scheme_Object *expr, Mz_CPort *port,
02468                            char *stack, Validate_TLS tls,
02469                               int depth, int delta,
02470                            int num_toplevels, int num_stxes, int num_lifts,
02471                               int skip_refs_check);
02472 void scheme_validate_boxenv(int pos, Mz_CPort *port,
02473                          char *stack, int depth, int delta);
02474 
02475 int scheme_validate_rator_wants_box(Scheme_Object *app_rator, int pos,
02476                                     int hope,
02477                                     Validate_TLS tls,
02478                                     int num_toplevels, int num_stxes, int num_lifts);
02479 
02480 void scheme_validate_closure(Mz_CPort *port, Scheme_Object *expr, 
02481                              char *new_stack, Validate_TLS tls,
02482                              int num_toplevels, int num_stxes, int num_lifts,
02483                              int self_pos_in_closure);
02484 
02485 #define TRACK_ILL_FORMED_CATCH_LINES 1
02486 #if TRACK_ILL_FORMED_CATCH_LINES
02487 void scheme_ill_formed(Mz_CPort *port, const char *file, int line);
02488 # define scheme_ill_formed_code(port) scheme_ill_formed(port, __FILE__, __LINE__)
02489 #else
02490 void scheme_ill_formed(Mz_CPort *port);
02491 # define scheme_ill_formed_code(port) scheme_ill_formed(port)
02492 #endif
02493 
02494 extern Scheme_Object *scheme_inferred_name_symbol;
02495 Scheme_Object *scheme_check_name_property(Scheme_Object *stx, Scheme_Object *current_name);
02496 
02497 Scheme_Object *scheme_make_lifted_defn(Scheme_Object *sys_wraps, Scheme_Object **_id, Scheme_Object *expr, Scheme_Comp_Env *env);
02498 
02499 typedef struct Scheme_Marshal_Tables {
02500   MZTAG_IF_REQUIRED  
02501   int pass, print_now;
02502   Scheme_Hash_Table *symtab;
02503   Scheme_Hash_Table *rns;
02504   Scheme_Hash_Table *rn_refs;
02505   Scheme_Hash_Table *st_refs;
02506   Scheme_Object *st_ref_stack;
02507   Scheme_Hash_Table *reverse_map; /* used on first pass */
02508   Scheme_Hash_Table *same_map;    /* set on first pass, used on later passes */
02509   Scheme_Hash_Table *cert_lists;  /* effectively set on first pass */
02510   Scheme_Hash_Table *shift_map;   /* effectively set on first pass */
02511   Scheme_Hash_Table *top_map;     /* used on every pass */
02512   Scheme_Hash_Table *key_map;     /* set after first pass, used on later passes */
02513   Scheme_Hash_Table *delay_map;   /* set during first pass, used on later passes */
02514   Scheme_Hash_Table *rn_saved;    /* maps each original object to generated marshaling */
02515   Scheme_Object **cdata_map;      /* for delay-load wrappers */
02516   int cdata_counter;              /* used with cdata_map */
02517   long *shared_offsets;           /* set in second pass */
02518   long sorted_keys_count;
02519   Scheme_Object **sorted_keys;
02520 } Scheme_Marshal_Tables;
02521 
02522 void scheme_marshal_using_key(Scheme_Marshal_Tables *mt, Scheme_Object *key);
02523 Scheme_Object *scheme_marshal_lookup(Scheme_Marshal_Tables *mt, Scheme_Object *a);
02524 Scheme_Object *scheme_marshal_wrap_set(Scheme_Marshal_Tables *mt, Scheme_Object *a, Scheme_Object *v);
02525 void scheme_marshal_push_refs(Scheme_Marshal_Tables *mt);
02526 void scheme_marshal_pop_refs(Scheme_Marshal_Tables *mt, int keep);
02527 
02528 typedef struct Scheme_Unmarshal_Tables {
02529   MZTAG_IF_REQUIRED  
02530   Scheme_Hash_Table *rns;
02531   struct CPort *rp;
02532   char *decoded;
02533 } Scheme_Unmarshal_Tables;
02534 
02535 Scheme_Object *scheme_unmarshal_wrap_get(Scheme_Unmarshal_Tables *ut, 
02536                                          Scheme_Object *wraps_key, 
02537                                          int *_decoded);
02538 void scheme_unmarshal_wrap_set(Scheme_Unmarshal_Tables *ut, 
02539                                Scheme_Object *wraps_key, 
02540                                Scheme_Object *v);
02541 
02542 int scheme_is_rename_transformer(Scheme_Object *o);
02543 int scheme_is_binding_rename_transformer(Scheme_Object *o);
02544 Scheme_Object *scheme_rename_transformer_id(Scheme_Object *o);
02545 int scheme_is_set_transformer(Scheme_Object *o);
02546 Scheme_Object *scheme_set_transformer_proc(Scheme_Object *o);
02547 
02548 /*========================================================================*/
02549 /*                         namespaces and modules                         */
02550 /*========================================================================*/
02551 
02552 struct Scheme_Env {
02553   Scheme_Object so; /* scheme_namespace_type */
02554 
02555   char disallow_unbound, rename_set_ready;
02556 
02557   struct Scheme_Module *module; /* NULL => top-level */
02558 
02559   Scheme_Hash_Table *module_registry; /* symbol -> module ; loaded modules,
02560                                     shared with modules in same space */
02561   Scheme_Hash_Table *export_registry; /* symbol -> module-exports */
02562   Scheme_Object *insp; /* instantiation-time inspector, for granting
02563                        protected access and certificates */
02564 
02565   Scheme_Object *rename_set;
02566   Scheme_Hash_Table *temp_marked_names; /* used to correlate imports with re-exports */
02567   Scheme_Object *post_ex_rename_set; /* during module expansion */
02568 
02569   Scheme_Bucket_Table *syntax;
02570   struct Scheme_Env *exp_env;
02571   struct Scheme_Env *template_env;
02572   struct Scheme_Env *label_env;
02573 
02574   Scheme_Hash_Table *shadowed_syntax; /* top level only */
02575 
02576   /* Per-instance: */
02577   long phase, mod_phase;
02578   Scheme_Object *link_midx;
02579   Scheme_Object *require_names, *et_require_names, *tt_require_names, *dt_require_names; /* resolved */
02580   Scheme_Hash_Table *other_require_names;
02581   char running, et_running, attached, ran;
02582   Scheme_Object *did_starts;
02583   Scheme_Object *available_next[2];
02584 
02585   Scheme_Bucket_Table *toplevel;
02586   Scheme_Object *modchain; /* Vector of:
02587                             1. symbol -> env ; running modules,
02588                                 shared with instances in same phase
02589                             2. modchain for next phase (or #f)
02590                                3. modchain for previous phase (or #f) */
02591 
02592   Scheme_Hash_Table *modvars; /* for scheme_module_variable_type hashing */
02593 
02594   int id_counter;
02595 };
02596 
02597 /* A module access path (or "idx") is a pair: sexp * symbol-or-#f
02598    The symbol is the resolved module name, or #f if it's not
02599    yet resolved. */
02600 
02601 /* A Scheme_Module corresponds to a module declaration. A module
02602    instantiation is reprsented by a Scheme_Env */
02603 
02604 typedef struct Scheme_Module
02605 {
02606   Scheme_Object so; /* scheme_module_type */
02607 
02608   Scheme_Object *modname;
02609 
02610   Scheme_Object *et_requires;  /* list of symbol-or-module-path-index */
02611   Scheme_Object *requires;     /* list of symbol-or-module-path-index */
02612   Scheme_Object *tt_requires;  /* list of symbol-or-module-path-index */
02613   Scheme_Object *dt_requires;  /* list of symbol-or-module-path-index */
02614   Scheme_Hash_Table *other_requires;  /* phase to list of symbol-or-module-path-index */
02615 
02616   Scheme_Invoke_Proc prim_body;
02617   Scheme_Invoke_Proc prim_et_body;
02618 
02619   Scheme_Object *body;        /* or data, if prim_body */
02620   Scheme_Object *et_body;     /* list of (vector list-of-names expr depth-int resolve-prefix) */
02621 
02622   char no_cert;
02623   
02624   struct Scheme_Module_Exports *me;
02625 
02626   char *provide_protects;            /* 1 => protected, 0 => not */
02627   Scheme_Object **indirect_provides; /* symbols (internal names) */
02628   int num_indirect_provides;
02629 
02630   /* Only if needed to reconstruct the renaming: */
02631   Scheme_Object **indirect_syntax_provides; /* symbols (internal names) */
02632   int num_indirect_syntax_provides;
02633 
02634   char *et_provide_protects;            /* 1 => protected, 0 => not */
02635   Scheme_Object **et_indirect_provides; /* symbols (internal names) */
02636   int num_indirect_et_provides;
02637 
02638   Scheme_Object *self_modidx;
02639 
02640   Scheme_Hash_Table *accessible; /* (symbol -> ...) */
02641   Scheme_Hash_Table *et_accessible; /* phase -> (symbol -> ...) */
02642   Scheme_Object *insp; /* declaration-time inspector, for creating certificates
02643                        and for module instantiation */
02644 
02645   Scheme_Object *lang_info; /* NULL or vector */
02646 
02647   Scheme_Object *hints; /* set by expansion; moved to properties */
02648   Scheme_Object *ii_src; /* set by compile, temporary */
02649   Comp_Prefix *comp_prefix; /* set by body compile, temporary */
02650 
02651   int max_let_depth;
02652   Resolve_Prefix *prefix;
02653 
02654   Scheme_Object *dummy; /* for accessing the environment */
02655 
02656   Scheme_Env *primitive;
02657 
02658   Scheme_Object *rn_stx;
02659 } Scheme_Module;
02660 
02661 typedef struct Scheme_Module_Phase_Exports
02662 {
02663   Scheme_Object so;
02664 
02665   Scheme_Object *phase_index;
02666 
02667   Scheme_Object *src_modidx;  /* same as in enclosing Scheme_Module_Exports */
02668 
02669   Scheme_Object **provides;          /* symbols (extenal names) */
02670   Scheme_Object **provide_srcs;      /* module access paths, #f for self */
02671   Scheme_Object **provide_src_names; /* symbols (original internal names) */
02672   Scheme_Object **provide_nominal_srcs; /* import source if re-exported; NULL or array of lists */
02673   char *provide_src_phases;          /* NULL, or src phase for for-syntax import */
02674   Scheme_Object **provide_insps;     /* inspectors for re-provided protected/unexported */
02675   int num_provides;
02676   int num_var_provides;              /* non-syntax listed first in provides */
02677 
02678   Scheme_Object *kernel_exclusion;   /* we allow up to two exns, but they must be shadowed */
02679   Scheme_Object *kernel_exclusion2;
02680 
02681   Scheme_Hash_Table *ht;             /* maps external names to array indicies; created lazily */
02682 } Scheme_Module_Phase_Exports;
02683 
02684 typedef struct Scheme_Module_Exports
02685 {
02686   /* Scheme_Module_Exports is separate from Scheme_Module
02687      so that we can create a global table mapping export
02688      keys to exports. This mapping is used to lazily 
02689      unmarshal syntax-object context. */
02690   MZTAG_IF_REQUIRED
02691 
02692   /* Most common phases: */
02693   Scheme_Module_Phase_Exports *rt, *et, *dt;
02694   /* All others: */
02695   Scheme_Hash_Table *other_phases;
02696 
02697   Scheme_Object *src_modidx;  /* the one used in marshalled syntax */
02698 } Scheme_Module_Exports;
02699 
02700 typedef struct Scheme_Modidx {
02701   Scheme_Object so; /* scheme_module_index_type */
02702 
02703   Scheme_Object *path;
02704   Scheme_Object *base;
02705   Scheme_Object *resolved;
02706   Scheme_Object *shift_cache; /* vector */
02707   struct Scheme_Modidx *cache_next;
02708 } Scheme_Modidx;
02709 
02710 typedef struct Module_Variable {
02711   Scheme_Object so; /* scheme_module_variable_type */
02712   Scheme_Object *modidx;
02713   Scheme_Object *sym;
02714   Scheme_Object *insp; /* for checking protected/unexported access */
02715   int pos, mod_phase;
02716 } Module_Variable;
02717 
02718 void scheme_add_global_keyword(const char *name, Scheme_Object *v, Scheme_Env *env);
02719 void scheme_add_global_keyword_symbol(Scheme_Object *name, Scheme_Object *v, Scheme_Env *env);
02720 void scheme_add_global_constant(const char *name, Scheme_Object *v, Scheme_Env *env);
02721 void scheme_add_global_constant_symbol(Scheme_Object *name, Scheme_Object *v, Scheme_Env *env);
02722 
02723 #define GLOBAL_FOLDING_PRIM(name, func, a1, a2, a3, env)      scheme_add_global_constant(name, scheme_make_folding_prim(func, name, a1, a2, a3), env)
02724 #define GLOBAL_IMMED_PRIM(name, func, a1, a2, env)            scheme_add_global_constant(name, scheme_make_immed_prim(func, name, a1, a2), env)
02725 #define GLOBAL_PARAMETER(name, func, constant, env)           scheme_add_global_constant(name, scheme_register_parameter(func, name, constant), env)
02726 #define GLOBAL_PRIM_W_ARITY(name, func, a1, a2, env)          scheme_add_global_constant(name, scheme_make_prim_w_arity(func, name, a1, a2), env)
02727 #define GLOBAL_PRIM_W_ARITY2(name, func, a1, a2, a3, a4, env) scheme_add_global_constant(name, scheme_make_prim_w_arity2(func, name, a1, a2, a3, a4), env)
02728 #define GLOBAL_NONCM_PRIM(name, func, a1, a2, env)            scheme_add_global_constant(name, scheme_make_noncm_prim(func, name, a1, a2), env)
02729 
02730 
02731 
02732 Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Object *bdg, int mode, 
02733                                 Scheme_Object *phase, int *_skipped);
02734 int scheme_tl_id_is_sym_used(Scheme_Hash_Table *marked_names, Scheme_Object *sym);
02735 
02736 Scheme_Object *scheme_sys_wraps(Scheme_Comp_Env *env);
02737 Scheme_Object *scheme_sys_wraps_phase(Scheme_Object *phase);
02738 
02739 Scheme_Env *scheme_new_module_env(Scheme_Env *env, Scheme_Module *m, int new_exp_module_tree);
02740 int scheme_is_module_env(Scheme_Comp_Env *env);
02741 
02742 Scheme_Object *scheme_module_resolve(Scheme_Object *modidx, int load_it);
02743 Scheme_Env *scheme_module_access(Scheme_Object *modname, Scheme_Env *env, int rev_mod_phase);
02744 void scheme_module_force_lazy(Scheme_Env *env, int previous);
02745 
02746 int scheme_module_export_position(Scheme_Object *modname, Scheme_Env *env, Scheme_Object *varname);
02747 
02748 Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object *prot_insp, Scheme_Object *in_modidx,
02749                                            Scheme_Object *symbol, Scheme_Object *stx, 
02750                                            Scheme_Object *certs, Scheme_Object *unexp_insp, 
02751                                                  Scheme_Object *rename_insp,
02752                                            int position, int want_pos,
02753                                            int *_protected, int *_unexported, 
02754                                                  Scheme_Env *from_env, int *_would_complain);
02755 Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, Scheme_Object *name);
02756 
02757 Scheme_Object *scheme_modidx_shift(Scheme_Object *modidx,
02758                                Scheme_Object *shift_from_modidx,
02759                                Scheme_Object *shift_to_modidx);
02760 
02761 Scheme_Object *scheme_intern_resolved_module_path(Scheme_Object *o);
02762 Scheme_Object *scheme_intern_resolved_module_path_worker(Scheme_Object *o);
02763 
02764 Scheme_Object *scheme_hash_module_variable(Scheme_Env *env, Scheme_Object *modidx, 
02765                                       Scheme_Object *stxsym, Scheme_Object *insp,
02766                                       int pos, int mod_phase);
02767 
02768 
02769 Scheme_Env *scheme_get_kernel_env();
02770 int scheme_is_kernel_env();
02771 
02772 
02773 void scheme_install_initial_module_set(Scheme_Env *env);
02774 Scheme_Bucket_Table *scheme_clone_toplevel(Scheme_Bucket_Table *ht, Scheme_Env *home);
02775 
02776 Scheme_Env *scheme_copy_module_env(Scheme_Env *menv, Scheme_Env *ns, Scheme_Object *modchain, int clone);
02777 
02778 void scheme_clean_dead_env(Scheme_Env *env);
02779 
02780 Scheme_Module *scheme_extract_compiled_module(Scheme_Object *o);
02781 
02782 int scheme_is_kernel_modname(Scheme_Object *modname);
02783 
02784 void scheme_clear_modidx_cache(void);
02785 void scheme_clear_shift_cache(void);
02786 void scheme_clear_prompt_cache(void);
02787 
02788 Scheme_Object *scheme_module_imported_list(Scheme_Env *genv, Scheme_Object *bindings, Scheme_Object *modpath,
02789                                            Scheme_Object *mode);
02790 Scheme_Object *scheme_module_exported_list(Scheme_Object *modpath, Scheme_Env *genv);
02791 
02792 void scheme_prepare_compile_env(Scheme_Env *env);
02793 
02794 Scheme_Object *scheme_module_to_namespace(Scheme_Object *name, Scheme_Env *env);
02795 void scheme_prep_namespace_rename(Scheme_Env *menv);
02796 
02797 /*========================================================================*/
02798 /*                         errors and exceptions                          */
02799 /*========================================================================*/
02800 
02801 void scheme_read_err(Scheme_Object *port,
02802                    Scheme_Object *stxsrc,
02803                    long line, long column, long pos, long span,
02804                    int is_eof, Scheme_Object *indentation,
02805                    const char *detail, ...);
02806 char *scheme_extract_indentation_suggestions(Scheme_Object *indentation);
02807 
02808 void scheme_wrong_syntax(const char *where,
02809                       Scheme_Object *local_form,
02810                       Scheme_Object *form,
02811                       const char *detail, ...);
02812 void scheme_wrong_syntax_with_more_sources(const char *where,
02813                                            Scheme_Object *detail_form,
02814                                            Scheme_Object *form,
02815                                            Scheme_Object *extra_sources,
02816                                            const char *detail, ...);
02817 extern const char *scheme_compile_stx_string;
02818 extern const char *scheme_expand_stx_string;
02819 extern const char *scheme_application_stx_string;
02820 extern const char *scheme_set_stx_string;
02821 extern const char *scheme_var_ref_string;
02822 extern const char *scheme_begin_stx_string;
02823 
02824 void scheme_wrong_rator(Scheme_Object *rator, int argc, Scheme_Object **argv);
02825 
02826 void scheme_raise_out_of_memory(const char *where, const char *msg, ...);
02827 
02828 extern unsigned long scheme_max_found_symbol_name;
02829 
02830 char *scheme_make_arity_expect_string(Scheme_Object *proc,
02831                                   int argc, Scheme_Object **argv,
02832                                   long *len);
02833 
02834 long scheme_extract_index(const char *name, int pos, int argc,
02835                        Scheme_Object **argv, long top, int false_ok);
02836 
02837 void scheme_get_substring_indices(const char *name, Scheme_Object *str,
02838                               int argc, Scheme_Object **argv,
02839                               int spos, int fpos, long *_start, long *_finish);
02840 void scheme_do_get_substring_indices(const char *name, Scheme_Object *str,
02841                                      int argc, Scheme_Object **argv,
02842                                      int spos, int fpos, long *_start, long *_finish, long len);
02843 
02844 void scheme_out_of_string_range(const char *name, const char *which,
02845                             Scheme_Object *i, Scheme_Object *s,
02846                             long start, long len);
02847 
02848 const char *scheme_number_suffix(int);
02849 
02850 const char *scheme_hostname_error(int err);
02851 
02852 char *scheme_make_args_string(char *s, int which, int argc, Scheme_Object **argv, long *olen);
02853 
02854 #define IMPROPER_LIST_FORM "illegal use of `.'"
02855 
02856 int scheme_byte_string_has_null(Scheme_Object *o);
02857 int scheme_any_string_has_null(Scheme_Object *o);
02858 #define CHAR_STRING_W_NO_NULLS "string (with no nul characters)"
02859 #define STRING_OR_BYTE_STRING_W_NO_NULLS "string or byte string (with no nul characters)"
02860 
02861 Scheme_Object *scheme_do_exit(int argc, Scheme_Object *argv[]);
02862 
02863 Scheme_Object *scheme_make_arity(mzshort minc, mzshort maxc);
02864 Scheme_Object *scheme_arity(Scheme_Object *p);
02865 
02866 typedef struct {
02867   MZTAG_IF_REQUIRED
02868   Scheme_Object *syms[5];
02869   int count;
02870   long phase;
02871   Scheme_Hash_Table *ht;
02872 } DupCheckRecord;
02873 
02874 void scheme_begin_dup_symbol_check(DupCheckRecord *r, Scheme_Comp_Env *e);
02875 void scheme_dup_symbol_check(DupCheckRecord *r, const char *where,
02876                           Scheme_Object *symbol, char *what,
02877                           Scheme_Object *form);
02878 
02879 extern int scheme_exiting_result;
02880 
02881 Scheme_Object *scheme_special_comment_value(Scheme_Object *o);
02882 
02883 Scheme_Object *scheme_get_stack_trace(Scheme_Object *mark_set);
02884 
02885 Scheme_Object *scheme_get_or_check_arity(Scheme_Object *p, long a);
02886 int scheme_native_arity_check(Scheme_Object *closure, int argc);
02887 Scheme_Object *scheme_get_native_arity(Scheme_Object *closure);
02888 
02889 struct Scheme_Logger {
02890   Scheme_Object so;
02891   Scheme_Object *name;
02892   Scheme_Logger *parent;
02893   int want_level;
02894   long *timestamp, local_timestamp; /* determines when want_level is up-to-date */
02895   int syslog_level, stderr_level;
02896   Scheme_Object *readers; /* list of (cons (make-weak-box <reader>) <sema>) */
02897 };
02898 
02899 typedef struct Scheme_Log_Reader {
02900   Scheme_Object so;
02901   int want_level;
02902   Scheme_Object *sema;
02903   Scheme_Object *head, *tail;
02904 } Scheme_Log_Reader;
02905 
02906 extern Scheme_Logger *scheme_main_logger;
02907 
02908 char *scheme_optimize_context_to_string(Scheme_Object *context);
02909 
02910 void scheme_write_proc_context(Scheme_Object *port, int print_width,
02911                                Scheme_Object *name, 
02912                                Scheme_Object *src, Scheme_Object *line, 
02913                                Scheme_Object *col, Scheme_Object *pos,
02914                                int generated);
02915 
02916 /*========================================================================*/
02917 /*                         filesystem utilities                           */
02918 /*========================================================================*/
02919 
02920 #ifdef USE_TRANSITIONAL_64_FILE_OPS
02921 # define BIG_OFF_T_IZE(n) n ## 64
02922 # define mz_off_t off64_t
02923 #else
02924 # define BIG_OFF_T_IZE(n) n
02925 # if defined(DOS_FILE_SYSTEM)
02926 #  define mz_off_t mzlonglong
02927 # else
02928 #  define mz_off_t off_t
02929 # endif
02930 #endif
02931 
02932 int scheme_is_relative_path(const char *s, long len, int kind);
02933 int scheme_is_complete_path(const char *s, long len, int kind);
02934 
02935 Scheme_Object *scheme_get_file_directory(const char *filename);
02936 
02937 char *scheme_normal_path_seps(char *s, int *_len, int delta);
02938 
02939 int scheme_is_regular_file(char *filename);
02940 
02941 #ifdef MAC_FILE_SYSTEM
02942 void scheme_file_create_hook(char *filename);
02943 #endif
02944 
02945 void scheme_do_format(const char *procname, Scheme_Object *port,
02946                     const mzchar *format, int flen,
02947                     int fpos, int offset, int argc, Scheme_Object **argv);
02948 
02949 Scheme_Object *scheme_load_with_clrd(int argc, Scheme_Object *argv[], char *who, int handler_param);
02950 
02951 #ifdef MAC_CLASSIC_PROCESS_CONTROL
02952 int scheme_mac_start_app(char *name, int find_path, Scheme_Object *s);
02953 #endif
02954 #ifdef MACINTOSH_EVENTS
02955 int scheme_mac_send_event(char *name, int argc, Scheme_Object **argv, Scheme_Object **result, int *err, char **stage);
02956 #endif
02957 
02958 Scheme_Object *scheme_default_load_extension(int argc, Scheme_Object **argv);
02959 
02960 Scheme_Object *scheme_remove_current_directory_prefix(Scheme_Object *fn);
02961 
02962 #ifdef DOS_FILE_SYSTEM
02963 int scheme_is_special_filename(const char *_f, int not_nul);
02964 # define NUM_SPECIAL_FILE_KINDS 30
02965 #endif
02966 
02967 char *scheme_get_exec_path(void);
02968 Scheme_Object *scheme_get_run_cmd(void);
02969 
02970 Scheme_Object *scheme_get_fd_identity(Scheme_Object *port, long fd);
02971 
02972 Scheme_Object *scheme_extract_relative_to(Scheme_Object *obj, Scheme_Object *dir);
02973 
02974 #ifdef DOS_FILE_SYSTEM
02975 # define WIDE_PATH(s) scheme_convert_to_wchar(s, 0)
02976 # define WIDE_PATH_COPY(s) scheme_convert_to_wchar(s, 1)
02977 # define NARROW_PATH(s) scheme_convert_from_wchar(s)
02978 extern wchar_t *scheme_convert_to_wchar(const char *s, int do_copy);
02979 extern char *scheme_convert_from_wchar(const wchar_t *ws);
02980 #else
02981 # define WIDE_PATH(s) s
02982 # define WIDE_PATH_COPY(s) s
02983 # define NARROW_PATH(s) s
02984 #endif
02985 
02986 #if defined(DOS_FILE_SYSTEM) && !defined(__CYGWIN32__)
02987 # define MSC_W_IZE(n) _w ## n
02988 # define MSC_WIDE_PATH(s) WIDE_PATH(s)
02989 # define MSC_WIDE_PATH_COPY(s) WIDE_PATH_COPY(s)
02990 #else
02991 # define MSC_W_IZE(n) MSC_IZE(n)
02992 # define MSC_WIDE_PATH(s) s
02993 # define MSC_WIDE_PATH_COPY(s) s
02994 #endif
02995 
02996 /*========================================================================*/
02997 /*                               ports                                    */
02998 /*========================================================================*/
02999 
03000 #ifdef NO_TCP_SUPPORT
03001 # undef USE_UNIX_SOCKETS_TCP
03002 # undef USE_WINSOCK_TCP
03003 # undef USE_MAC_TCP
03004 #endif
03005 #if defined(USE_UNIX_SOCKETS_TCP) || defined(USE_WINSOCK_TCP) || defined(USE_MAC_TCP)
03006 # define USE_TCP
03007 #endif
03008 
03009 #if defined(USE_UNIX_SOCKETS_TCP) || defined(USE_WINSOCK_TCP)
03010 # define USE_SOCKETS_TCP
03011 #endif
03012 
03013 extern int scheme_active_but_sleeping;
03014 extern int scheme_file_open_count;
03015 
03016 typedef struct Scheme_Indexed_String {
03017   MZTAG_IF_REQUIRED
03018   char *string;
03019   int size;
03020   int index;
03021   union {
03022     int hot; /* output port */
03023     int pos; /* input port */
03024   } u;
03025 } Scheme_Indexed_String;
03026 
03027 typedef struct Scheme_Pipe {
03028   MZTAG_IF_REQUIRED
03029   unsigned char *buf;
03030   long buflen, bufmax;
03031   long bufmaxextra; /* due to peeks, bufmax can effectively grow */
03032   long bufstart, bufend;
03033   int eof;
03034   Scheme_Object *wakeup_on_read;
03035   Scheme_Object *wakeup_on_write;
03036 } Scheme_Pipe;
03037 
03038 extern Scheme_Object *scheme_string_input_port_type;
03039 extern Scheme_Object *scheme_string_output_port_type;
03040 extern Scheme_Object *scheme_user_input_port_type;
03041 extern Scheme_Object *scheme_user_output_port_type;
03042 extern Scheme_Object *scheme_pipe_read_port_type;
03043 extern Scheme_Object *scheme_pipe_write_port_type;
03044 extern Scheme_Object *scheme_null_output_port_type;
03045 #ifdef USE_TCP
03046 extern Scheme_Object *scheme_tcp_input_port_type;
03047 extern Scheme_Object *scheme_tcp_output_port_type;
03048 #endif
03049 
03050 extern int scheme_force_port_closed;
03051 
03052 void scheme_flush_orig_outputs(void);
03053 Scheme_Object *scheme_file_stream_port_p(int, Scheme_Object *[]);
03054 Scheme_Object *scheme_terminal_port_p(int, Scheme_Object *[]);
03055 Scheme_Object *scheme_do_open_input_file(char *name, int offset, int argc, Scheme_Object *argv[], int internal);
03056 Scheme_Object *scheme_do_open_output_file(char *name, int offset, int argc, Scheme_Object *argv[], int and_read);
03057 Scheme_Object *scheme_file_position(int argc, Scheme_Object *argv[]);
03058 Scheme_Object *scheme_file_buffer(int argc, Scheme_Object *argv[]);
03059 Scheme_Object *scheme_file_identity(int argc, Scheme_Object *argv[]);
03060 
03061 void scheme_reserve_file_descriptor(void);
03062 void scheme_release_file_descriptor(void);
03063 
03064 long scheme_get_byte_string_or_ch_put(const char *who,
03065                                   Scheme_Object *port,
03066                                   char *buffer, long offset, long size,
03067                                   int only_avail,
03068                                   int peek, Scheme_Object *peek_skip,
03069                                   Scheme_Object *unless_evt,
03070                                   Scheme_Object *target_ch);
03071 
03072 Scheme_Object *scheme_get_special(Scheme_Object *inport, Scheme_Object *stxsrc, long line, long col, long pos, int peek, 
03073                               Scheme_Hash_Table **for_read);
03074 Scheme_Object *scheme_get_ready_read_special(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table **ht);
03075 void scheme_set_in_read_mark(Scheme_Object *stxsrc, Scheme_Hash_Table **ht);
03076 Scheme_Object *scheme_get_special_proc(Scheme_Object *inport);
03077 void scheme_bad_time_for_special(const char *name, Scheme_Object *port);
03078 extern int scheme_special_ok;
03079 
03080 int scheme_user_port_byte_probably_ready(Scheme_Input_Port *ip, Scheme_Schedule_Info *sinfo);
03081 int scheme_user_port_write_probably_ready(Scheme_Output_Port *op, Scheme_Schedule_Info *sinfo);
03082 int scheme_is_user_port(Scheme_Object *port);
03083 
03084 int scheme_byte_ready_or_user_port_ready(Scheme_Object *p, Scheme_Schedule_Info *sinfo);
03085 
03086 int scheme_pipe_char_count(Scheme_Object *p);
03087 
03088 #define CURRENT_INPUT_PORT(config) scheme_get_param(config, MZCONFIG_INPUT_PORT)
03089 #define CURRENT_OUTPUT_PORT(config) scheme_get_param(config, MZCONFIG_OUTPUT_PORT)
03090 #define CHECK_PORT_CLOSED(who, kind, port, closed) if (closed) scheme_raise_exn(MZEXN_FAIL, "%s: " kind " port is closed", who);
03091 
03092 #ifdef USE_FCNTL_O_NONBLOCK
03093 # define MZ_NONBLOCKING O_NONBLOCK
03094 #else
03095 # define MZ_NONBLOCKING FNDELAY
03096 #endif
03097 
03098 #define MAX_UTF8_CHAR_BYTES 6
03099 
03100 /*========================================================================*/
03101 /*                         memory debugging                               */
03102 /*========================================================================*/
03103 
03104 #ifdef MEMORY_COUNTING_ON
03105 extern Scheme_Hash_Table *scheme_symbol_table;
03106 extern long scheme_type_table_count;
03107 extern long scheme_misc_count;
03108 
03109 Scheme_Object *scheme_dump_memory_count(int c, Scheme_Object *a[]);
03110 
03111 long scheme_count_closure(Scheme_Object **o, mzshort len, Scheme_Hash_Table *ht);
03112 
03113 long scheme_count_envbox(Scheme_Object *root, Scheme_Hash_Table *ht);
03114 long scheme_count_memory(Scheme_Object *root, Scheme_Hash_Table *ht);
03115 void scheme_count_input_port(Scheme_Object *port, long *s, long *e, Scheme_Hash_Table *ht);
03116 void scheme_count_output_port(Scheme_Object *port, long *s, long *e, Scheme_Hash_Table *ht);
03117 
03118 void scheme_count_struct_info(Scheme_Object *o, long *s, long *e, Scheme_Hash_Table *ht);
03119 
03120 #ifndef NO_OBJECT_SYSTEM
03121 void scheme_count_object(Scheme_Object *o, long *s, long *e, Scheme_Hash_Table *ht);
03122 void scheme_count_class(Scheme_Object *o, long *s, long *e, Scheme_Hash_Table *ht);
03123 void scheme_count_class_data(Scheme_Object *o, long *s, long *e, Scheme_Hash_Table *ht);
03124 void scheme_count_generic(Scheme_Object *o, long *s, long *e, Scheme_Hash_Table *ht);
03125 #endif
03126 #endif
03127 
03128 /*========================================================================*/
03129 /*                           miscellaneous                                */
03130 /*========================================================================*/
03131 
03132 Scheme_Object *scheme_checked_car(int argc, Scheme_Object **argv);
03133 Scheme_Object *scheme_checked_cdr(int argc, Scheme_Object **argv);
03134 Scheme_Object *scheme_checked_caar(int argc, Scheme_Object **argv);
03135 Scheme_Object *scheme_checked_cadr(int argc, Scheme_Object **argv);
03136 Scheme_Object *scheme_checked_cdar(int argc, Scheme_Object **argv);
03137 Scheme_Object *scheme_checked_cddr(int argc, Scheme_Object **argv);
03138 Scheme_Object *scheme_checked_mcar(int argc, Scheme_Object **argv);
03139 Scheme_Object *scheme_checked_mcdr(int argc, Scheme_Object **argv);
03140 Scheme_Object *scheme_checked_set_mcar (int argc, Scheme_Object *argv[]);
03141 Scheme_Object *scheme_checked_set_mcdr (int argc, Scheme_Object *argv[]);
03142 Scheme_Object *scheme_checked_vector_ref(int argc, Scheme_Object **argv);
03143 Scheme_Object *scheme_checked_vector_set(int argc, Scheme_Object **argv);
03144 Scheme_Object *scheme_checked_string_ref(int argc, Scheme_Object *argv[]);
03145 Scheme_Object *scheme_checked_string_set(int argc, Scheme_Object *argv[]);
03146 Scheme_Object *scheme_checked_byte_string_ref(int argc, Scheme_Object *argv[]);
03147 Scheme_Object *scheme_checked_byte_string_set(int argc, Scheme_Object *argv[]);
03148 Scheme_Object *scheme_checked_syntax_e(int argc, Scheme_Object **argv);
03149 Scheme_Object *scheme_vector_length(Scheme_Object *v);
03150 
03151 Scheme_Bucket_Table *scheme_make_weak_equal_table(void);
03152 
03153 int scheme_hash_table_equal_rec(Scheme_Hash_Table *t1, Scheme_Hash_Table *t2, void *eql);
03154 int scheme_bucket_table_equal_rec(Scheme_Bucket_Table *t1, Scheme_Bucket_Table *t2, void *eql);
03155 int scheme_hash_tree_equal_rec(Scheme_Hash_Tree *t1, Scheme_Hash_Tree *t2, void *eql);
03156 
03157 void scheme_set_root_param(int p, Scheme_Object *v);
03158 
03159 Scheme_Object *scheme_intern_exact_symbol_in_table_worker(Scheme_Hash_Table *symbol_table, int kind, const char *name, unsigned int len);
03160 Scheme_Object *scheme_intern_exact_parallel_symbol(const char *name, unsigned int len);
03161 Scheme_Object *scheme_symbol_append(Scheme_Object *s1, Scheme_Object *s2);
03162 Scheme_Object *scheme_copy_list(Scheme_Object *l);
03163 
03164 void scheme_reset_hash_table(Scheme_Hash_Table *ht, int *history);
03165 
03166 Scheme_Object *scheme_regexp_source(Scheme_Object *re);
03167 int scheme_regexp_is_byte(Scheme_Object *re);
03168 Scheme_Object *scheme_make_regexp(Scheme_Object *str, int byte, int pcre, int * volatile result_is_err_string);
03169 int scheme_is_pregexp(Scheme_Object *o);
03170 void scheme_clear_rx_buffers(void);
03171 unsigned short * scheme_ucs4_to_utf16(const mzchar *text, int start, int end,
03172                                   unsigned short *buf, int bufsize,
03173                                   long *ulen, int term_size);
03174 
03175 #ifdef SCHEME_BIG_ENDIAN
03176 # define MZ_UCS4_NAME "UCS-4BE"
03177 #else
03178 # define MZ_UCS4_NAME "UCS-4LE"
03179 #endif
03180 
03181 #define SCHEME_SYM_UNINTERNEDP(o) (MZ_OPT_HASH_KEY(&((Scheme_Symbol *)(o))->iso) & 0x1)
03182 #define SCHEME_SYM_PARALLELP(o) (MZ_OPT_HASH_KEY(&((Scheme_Symbol *)(o))->iso) & 0x2)
03183 #define SCHEME_SYM_WEIRDP(o) (MZ_OPT_HASH_KEY(&((Scheme_Symbol *)(o))->iso) & 0x3)
03184 
03185 Scheme_Object *scheme_current_library_collection_paths(int argc, Scheme_Object *argv[]);
03186 
03187 /*========================================================================*/
03188 /*                           places                                       */
03189 /*========================================================================*/
03190 
03191 #if defined(MZ_USE_PLACES)
03192 # if defined(MZ_PRECISE_GC)
03193 typedef struct Scheme_Symbol_Parts {
03194   Scheme_Hash_Table *table;
03195   int kind;
03196   unsigned int len;
03197   const char *name;
03198 } Scheme_Symbol_Parts;
03199 
03200 void spawn_master_scheme_place();
03201 void *scheme_master_fast_path(int msg_type, void *msg_payload);
03202 # endif
03203 Scheme_Object *scheme_places_deep_copy(Scheme_Object *so);
03204 #endif
03205 
03206 typedef struct Scheme_Place {
03207   Scheme_Object so;
03208   void *proc_thread;
03209 } Scheme_Place;
03210 
03211 Scheme_Env *scheme_place_instance_init();
03212 
03213 /*========================================================================*/
03214 /*                           engine                                       */
03215 /*========================================================================*/
03216 
03217 typedef struct Scheme_Engine {
03218   Scheme_Object so;
03219 } Scheme_Engine;
03220 
03221 Scheme_Env *scheme_engine_instance_init();
03222 
03223 #endif /* __mzscheme_private__ */