comparison src/if_mzsch.c @ 344:7033303ea0c0 v7.0089

updated for version 7.0089
author vimboss
date Tue, 21 Jun 2005 22:37:39 +0000
parents 8fa8d7964cf1
children 52e76e2b5b65
comparison
equal deleted inserted replaced
343:607cff4bc0cb 344:7033303ea0c0
223 int _num_rands, Scheme_Object **rands, int val); 223 int _num_rands, Scheme_Object **rands, int val);
224 static void (*dll_scheme_dont_gc_ptr)(void *p); 224 static void (*dll_scheme_dont_gc_ptr)(void *p);
225 static Scheme_Object *(*dll_scheme_eval)(Scheme_Object *obj, Scheme_Env *env); 225 static Scheme_Object *(*dll_scheme_eval)(Scheme_Object *obj, Scheme_Env *env);
226 static Scheme_Object *(*dll_scheme_eval_string)(const char *str, 226 static Scheme_Object *(*dll_scheme_eval_string)(const char *str,
227 Scheme_Env *env); 227 Scheme_Env *env);
228 static Scheme_Object *(*dll_scheme_eval_string_all)(const char *str, 228 static Scheme_Object *(*dll_scheme_eval_string_all)(const char *str,
229 Scheme_Env *env, int all); 229 Scheme_Env *env, int all);
230 static void (*dll_scheme_finish_primitive_module)(Scheme_Env *env); 230 static void (*dll_scheme_finish_primitive_module)(Scheme_Env *env);
231 # if MZSCHEME_VERSION_MAJOR < 299 231 # if MZSCHEME_VERSION_MAJOR < 299
232 static char *(*dll_scheme_format)(char *format, int flen, int argc, 232 static char *(*dll_scheme_format)(char *format, int flen, int argc,
233 Scheme_Object **argv, long *rlen); 233 Scheme_Object **argv, long *rlen);
251 (Scheme_Closed_Prim *prim, void *data, const char *name, mzshort mina, 251 (Scheme_Closed_Prim *prim, void *data, const char *name, mzshort mina,
252 mzshort maxa); 252 mzshort maxa);
253 static Scheme_Object *(*dll_scheme_make_integer_value)(long i); 253 static Scheme_Object *(*dll_scheme_make_integer_value)(long i);
254 static Scheme_Object *(*dll_scheme_make_namespace)(int argc, 254 static Scheme_Object *(*dll_scheme_make_namespace)(int argc,
255 Scheme_Object *argv[]); 255 Scheme_Object *argv[]);
256 static Scheme_Object *(*dll_scheme_make_pair)(Scheme_Object *car, 256 static Scheme_Object *(*dll_scheme_make_pair)(Scheme_Object *car,
257 Scheme_Object *cdr); 257 Scheme_Object *cdr);
258 static Scheme_Object *(*dll_scheme_make_prim_w_arity)(Scheme_Prim *prim, 258 static Scheme_Object *(*dll_scheme_make_prim_w_arity)(Scheme_Prim *prim,
259 const char *name, mzshort mina, mzshort maxa); 259 const char *name, mzshort mina, mzshort maxa);
260 # if MZSCHEME_VERSION_MAJOR < 299 260 # if MZSCHEME_VERSION_MAJOR < 299
261 static Scheme_Object *(*dll_scheme_make_string)(const char *chars); 261 static Scheme_Object *(*dll_scheme_make_string)(const char *chars);
292 static Scheme_Object *(*dll_scheme_read)(Scheme_Object *port); 292 static Scheme_Object *(*dll_scheme_read)(Scheme_Object *port);
293 static void (*dll_scheme_signal_error)(const char *msg, ...); 293 static void (*dll_scheme_signal_error)(const char *msg, ...);
294 static void (*dll_scheme_wrong_type)(const char *name, const char *expected, 294 static void (*dll_scheme_wrong_type)(const char *name, const char *expected,
295 int which, int argc, Scheme_Object **argv); 295 int which, int argc, Scheme_Object **argv);
296 # if MZSCHEME_VERSION_MAJOR >= 299 296 # if MZSCHEME_VERSION_MAJOR >= 299
297 static void (*dll_scheme_set_param)(Scheme_Config *c, int pos, 297 static void (*dll_scheme_set_param)(Scheme_Config *c, int pos,
298 Scheme_Object *o); 298 Scheme_Object *o);
299 static Scheme_Config *(*dll_scheme_current_config)(void); 299 static Scheme_Config *(*dll_scheme_current_config)(void);
300 static Scheme_Object *(*dll_scheme_char_string_to_byte_string) 300 static Scheme_Object *(*dll_scheme_char_string_to_byte_string)
301 (Scheme_Object *s); 301 (Scheme_Object *s);
302 # endif 302 # endif
409 {"scheme_null", (void **)&dll_scheme_null}, 409 {"scheme_null", (void **)&dll_scheme_null},
410 {"scheme_true", (void **)&dll_scheme_true}, 410 {"scheme_true", (void **)&dll_scheme_true},
411 {"scheme_current_thread", (void **)&dll_scheme_current_thread_ptr}, 411 {"scheme_current_thread", (void **)&dll_scheme_current_thread_ptr},
412 {"scheme_console_printf", (void **)&dll_scheme_console_printf_ptr}, 412 {"scheme_console_printf", (void **)&dll_scheme_console_printf_ptr},
413 {"scheme_console_output", (void **)&dll_scheme_console_output_ptr}, 413 {"scheme_console_output", (void **)&dll_scheme_console_output_ptr},
414 {"scheme_notify_multithread", 414 {"scheme_notify_multithread",
415 (void **)&dll_scheme_notify_multithread_ptr}, 415 (void **)&dll_scheme_notify_multithread_ptr},
416 {"scheme_add_global", (void **)&dll_scheme_add_global}, 416 {"scheme_add_global", (void **)&dll_scheme_add_global},
417 {"scheme_add_global_symbol", (void **)&dll_scheme_add_global_symbol}, 417 {"scheme_add_global_symbol", (void **)&dll_scheme_add_global_symbol},
418 {"scheme_apply", (void **)&dll_scheme_apply}, 418 {"scheme_apply", (void **)&dll_scheme_apply},
419 {"scheme_basic_env", (void **)&dll_scheme_basic_env}, 419 {"scheme_basic_env", (void **)&dll_scheme_basic_env},
422 # endif 422 # endif
423 {"scheme_builtin_value", (void **)&dll_scheme_builtin_value}, 423 {"scheme_builtin_value", (void **)&dll_scheme_builtin_value},
424 {"scheme_check_threads", (void **)&dll_scheme_check_threads}, 424 {"scheme_check_threads", (void **)&dll_scheme_check_threads},
425 {"scheme_close_input_port", (void **)&dll_scheme_close_input_port}, 425 {"scheme_close_input_port", (void **)&dll_scheme_close_input_port},
426 {"scheme_count_lines", (void **)&dll_scheme_count_lines}, 426 {"scheme_count_lines", (void **)&dll_scheme_count_lines},
427 {"scheme_current_continuation_marks", 427 {"scheme_current_continuation_marks",
428 (void **)&dll_scheme_current_continuation_marks}, 428 (void **)&dll_scheme_current_continuation_marks},
429 {"scheme_display", (void **)&dll_scheme_display}, 429 {"scheme_display", (void **)&dll_scheme_display},
430 {"scheme_display_to_string", (void **)&dll_scheme_display_to_string}, 430 {"scheme_display_to_string", (void **)&dll_scheme_display_to_string},
431 {"scheme_do_eval", (void **)&dll_scheme_do_eval}, 431 {"scheme_do_eval", (void **)&dll_scheme_do_eval},
432 {"scheme_dont_gc_ptr", (void **)&dll_scheme_dont_gc_ptr}, 432 {"scheme_dont_gc_ptr", (void **)&dll_scheme_dont_gc_ptr},
433 {"scheme_eq", (void **)&dll_scheme_eq}, 433 {"scheme_eq", (void **)&dll_scheme_eq},
434 {"scheme_eval", (void **)&dll_scheme_eval}, 434 {"scheme_eval", (void **)&dll_scheme_eval},
435 {"scheme_eval_string", (void **)&dll_scheme_eval_string}, 435 {"scheme_eval_string", (void **)&dll_scheme_eval_string},
436 {"scheme_eval_string_all", (void **)&dll_scheme_eval_string_all}, 436 {"scheme_eval_string_all", (void **)&dll_scheme_eval_string_all},
437 {"scheme_finish_primitive_module", 437 {"scheme_finish_primitive_module",
438 (void **)&dll_scheme_finish_primitive_module}, 438 (void **)&dll_scheme_finish_primitive_module},
439 # if MZSCHEME_VERSION_MAJOR < 299 439 # if MZSCHEME_VERSION_MAJOR < 299
440 {"scheme_format", (void **)&dll_scheme_format}, 440 {"scheme_format", (void **)&dll_scheme_format},
441 # else 441 # else
442 {"scheme_format_utf8", (void **)&dll_scheme_format_utf8}, 442 {"scheme_format_utf8", (void **)&dll_scheme_format_utf8},
443 {"scheme_get_param", (void **)&dll_scheme_get_param}, 443 {"scheme_get_param", (void **)&dll_scheme_get_param},
444 #endif 444 #endif
445 {"scheme_gc_ptr_ok", (void **)&dll_scheme_gc_ptr_ok}, 445 {"scheme_gc_ptr_ok", (void **)&dll_scheme_gc_ptr_ok},
446 # if MZSCHEME_VERSION_MAJOR < 299 446 # if MZSCHEME_VERSION_MAJOR < 299
447 {"scheme_get_sized_string_output", 447 {"scheme_get_sized_string_output",
448 (void **)&dll_scheme_get_sized_string_output}, 448 (void **)&dll_scheme_get_sized_string_output},
449 # else 449 # else
450 {"scheme_get_sized_byte_string_output", 450 {"scheme_get_sized_byte_string_output",
451 (void **)&dll_scheme_get_sized_byte_string_output}, 451 (void **)&dll_scheme_get_sized_byte_string_output},
452 #endif 452 #endif
453 {"scheme_intern_symbol", (void **)&dll_scheme_intern_symbol}, 453 {"scheme_intern_symbol", (void **)&dll_scheme_intern_symbol},
454 {"scheme_lookup_global", (void **)&dll_scheme_lookup_global}, 454 {"scheme_lookup_global", (void **)&dll_scheme_lookup_global},
455 {"scheme_make_closed_prim_w_arity", 455 {"scheme_make_closed_prim_w_arity",
456 (void **)&dll_scheme_make_closed_prim_w_arity}, 456 (void **)&dll_scheme_make_closed_prim_w_arity},
457 {"scheme_make_integer_value", (void **)&dll_scheme_make_integer_value}, 457 {"scheme_make_integer_value", (void **)&dll_scheme_make_integer_value},
458 {"scheme_make_namespace", (void **)&dll_scheme_make_namespace}, 458 {"scheme_make_namespace", (void **)&dll_scheme_make_namespace},
459 {"scheme_make_pair", (void **)&dll_scheme_make_pair}, 459 {"scheme_make_pair", (void **)&dll_scheme_make_pair},
460 {"scheme_make_prim_w_arity", (void **)&dll_scheme_make_prim_w_arity}, 460 {"scheme_make_prim_w_arity", (void **)&dll_scheme_make_prim_w_arity},
461 # if MZSCHEME_VERSION_MAJOR < 299 461 # if MZSCHEME_VERSION_MAJOR < 299
462 {"scheme_make_string", (void **)&dll_scheme_make_string}, 462 {"scheme_make_string", (void **)&dll_scheme_make_string},
463 {"scheme_make_string_output_port", 463 {"scheme_make_string_output_port",
464 (void **)&dll_scheme_make_string_output_port}, 464 (void **)&dll_scheme_make_string_output_port},
465 # else 465 # else
466 {"scheme_make_byte_string", (void **)&dll_scheme_make_byte_string}, 466 {"scheme_make_byte_string", (void **)&dll_scheme_make_byte_string},
467 {"scheme_make_byte_string_output_port", 467 {"scheme_make_byte_string_output_port",
468 (void **)&dll_scheme_make_byte_string_output_port}, 468 (void **)&dll_scheme_make_byte_string_output_port},
469 # endif 469 # endif
470 {"scheme_make_struct_instance", 470 {"scheme_make_struct_instance",
471 (void **)&dll_scheme_make_struct_instance}, 471 (void **)&dll_scheme_make_struct_instance},
472 {"scheme_make_struct_names", (void **)&dll_scheme_make_struct_names}, 472 {"scheme_make_struct_names", (void **)&dll_scheme_make_struct_names},
473 {"scheme_make_struct_type", (void **)&dll_scheme_make_struct_type}, 473 {"scheme_make_struct_type", (void **)&dll_scheme_make_struct_type},
474 {"scheme_make_struct_values", (void **)&dll_scheme_make_struct_values}, 474 {"scheme_make_struct_values", (void **)&dll_scheme_make_struct_values},
475 {"scheme_make_type", (void **)&dll_scheme_make_type}, 475 {"scheme_make_type", (void **)&dll_scheme_make_type},
523 return FAIL; 523 return FAIL;
524 } 524 }
525 525
526 for (thunk = mzsch_imports; thunk->name; thunk++) 526 for (thunk = mzsch_imports; thunk->name; thunk++)
527 { 527 {
528 if ((*thunk->ptr = 528 if ((*thunk->ptr =
529 (void *)GetProcAddress(hMzSch, thunk->name)) == NULL) 529 (void *)GetProcAddress(hMzSch, thunk->name)) == NULL)
530 { 530 {
531 FreeLibrary(hMzSch); 531 FreeLibrary(hMzSch);
532 hMzSch = 0; 532 hMzSch = 0;
533 FreeLibrary(hMzGC); 533 FreeLibrary(hMzGC);
537 return FAIL; 537 return FAIL;
538 } 538 }
539 } 539 }
540 for (thunk = mzgc_imports; thunk->name; thunk++) 540 for (thunk = mzgc_imports; thunk->name; thunk++)
541 { 541 {
542 if ((*thunk->ptr = 542 if ((*thunk->ptr =
543 (void *)GetProcAddress(hMzGC, thunk->name)) == NULL) 543 (void *)GetProcAddress(hMzGC, thunk->name)) == NULL)
544 { 544 {
545 FreeLibrary(hMzSch); 545 FreeLibrary(hMzSch);
546 hMzSch = 0; 546 hMzSch = 0;
547 FreeLibrary(hMzGC); 547 FreeLibrary(hMzGC);
2653 mod); 2653 mod);
2654 } 2654 }
2655 scheme_add_global("global-namespace", (Scheme_Object *)environment, mod); 2655 scheme_add_global("global-namespace", (Scheme_Object *)environment, mod);
2656 scheme_finish_primitive_module(mod); 2656 scheme_finish_primitive_module(mod);
2657 } 2657 }
2658 2658
2659 #ifdef HAVE_SANDBOX 2659 #ifdef HAVE_SANDBOX
2660 static Scheme_Object *M_write = NULL; 2660 static Scheme_Object *M_write = NULL;
2661 static Scheme_Object *M_read = NULL; 2661 static Scheme_Object *M_read = NULL;
2662 static Scheme_Object *M_execute = NULL; 2662 static Scheme_Object *M_execute = NULL;
2663 static Scheme_Object *M_delete = NULL; 2663 static Scheme_Object *M_delete = NULL;
2667 { 2667 {
2668 if (sandbox) 2668 if (sandbox)
2669 raise_vim_exn(_("not allowed in the Vim sandbox")); 2669 raise_vim_exn(_("not allowed in the Vim sandbox"));
2670 } 2670 }
2671 2671
2672 /* security guards to force Vim's sandbox restrictions on MzScheme level */ 2672 /* security guards to force Vim's sandbox restrictions on MzScheme level */
2673 static Scheme_Object * 2673 static Scheme_Object *
2674 sandbox_file_guard(int argc, Scheme_Object **argv) 2674 sandbox_file_guard(int argc, Scheme_Object **argv)
2675 { 2675 {
2676 if (sandbox) 2676 if (sandbox)
2677 { 2677 {