Language-MzScheme
view release on metacpan or search on metacpan
mzscheme_wrap.h view on Meta::CPAN
#else
# include "../sconfig.h"
#endif
#ifdef INCLUDE_WITHOUT_PATHS
# include "schvers.h"
#else
# include "../src/schvers.h"
#endif
#if defined(__MWERKS__)
# ifdef MZSCHEME_USES_NEAR_GLOBALS
# pragma far_data off
# endif
#endif
#if SGC_STD_DEBUGGING
# ifndef USE_SENORA_GC
# define USE_SENORA_GC
# endif
# define USE_MEMORY_TRACING
#endif
#ifdef MZ_PRECISE_GC
# define MUST_REGISTER_GLOBALS
# define MZTAG_REQUIRED
# undef UNIX_IMAGE_DUMPS
/* In case SGC is used to build PRECISE_GC: */
# undef USE_SENORA_GC
#endif
#ifdef USE_SENORA_GC
# define MUST_REGISTER_GLOBALS
# undef UNIX_IMAGE_DUMPS
#endif
#ifdef USE_SINGLE_FLOATS
# define MZ_USE_SINGLE_FLOATS
#endif
#ifdef DONT_ITIMER
# undef USE_ITIMER
#endif
#if defined(USE_ITIMER) || defined(USE_WIN32_THREAD_TIMER)
# define FUEL_AUTODECEREMENTS
#endif
#ifdef MZ_PRECISE_GC
# define MZ_HASH_KEY_EX short keyex;
#else
# define MZ_HASH_KEY_EX /**/
#endif
#ifdef PALMOS_STUFF
# include <PalmOS.h>
typedef long FILE;
# define _LINUX_TYPES_H /* Blocks types.h */
#endif
#ifndef SCHEME_DIRECT_EMBEDDED
# define SCHEME_DIRECT_EMBEDDED 1
#endif
#ifndef MSC_IZE
# define MSC_IZE(x) x
#endif
#ifndef MSCBOR_IZE
# define MSCBOR_IZE(x) MSC_IZE(x)
#endif
#ifdef SIGSET_IS_SIGNAL
# define MZ_SIGSET(s, f) signal(s, f)
#else
# define MZ_SIGSET(s, f) sigset(s, f)
#endif
#ifdef PALMOS_STUFF
typedef jmpbuf jmp_buf[1];
#endif
#define GC_MIGHT_USE_REGISTERED_STATICS
#ifdef MACINTOSH_EVENTS
/* We avoid #including the Carbon headers because we only
need a few abstract struct types: */
typedef struct FSSpec mzFSSpec;
#endif
/* Set up MZ_EXTERN for DLL build */
#if defined(WINDOWS_DYNAMIC_LOAD) \
&& !defined(LINK_EXTENSIONS_BY_TABLE) \
&& !defined(SCHEME_EMBEDDED_NO_DLL)
# define MZ_DLLIMPORT __declspec(dllimport)
# ifdef __mzscheme_private__
# define MZ_DLLSPEC __declspec(dllexport)
# else
# define MZ_DLLSPEC __declspec(dllimport)
# endif
#else
# define MZ_DLLSPEC
# define MZ_DLLIMPORT
#endif
#define MZ_EXTERN extern MZ_DLLSPEC
/* Define _W64 for MSC if needed. */
#if defined(_MSC_VER) && !defined(_W64)
# if !defined(__midl) && (defined(_X86_) || defined(_M_IX86)) && _MSC_VER >= 1300
# define _W64 __w64
# else
# define _W64
# endif
#endif
/* PPC Linux plays a slimy trick: it defines strcpy() as a macro that
uses __extension__. This breaks the 3m xform. */
#if defined(MZ_XFORM) && defined(strcpy)
START_XFORM_SKIP;
static inline void _mzstrcpy(char *a, const char *b)
{
strcpy(a, b);
}
END_XFORM_SKIP;
# undef strcpy
# define strcpy _mzstrcpy
#endif
#ifdef __cplusplus
extern "C"
{
#endif
/*========================================================================*/
/* basic Scheme values */
/*========================================================================*/
typedef short Scheme_Type;
/* Used to use `short' for app arg counts, etc., but adding limit
checks is difficult, and seems arbitrary. We can switch back
to short if the expense turns out to be noticable; in that case
also define MZSHORT_IS_SHORT. */
typedef int mzshort;
/* MzScheme values have the type `Scheme_Object *'.
The actual Scheme_Object structure only defines a few variants.
The important thing is that all `Scheme_Object *'s start with
a Scheme_Type field.
The structures are defined here, instead of in a private header, so
that macros can provide quick access. Of course, don't access the
fields of these structures directly; use the macros instead. */
mzscheme_wrap.h view on Meta::CPAN
mz_pre_jmp_buf jb;
long gcvs; /* declared as `long' so it isn't pushed when on the stack! */
long gcvs_cnt;
} mz_jmp_buf;
#else
# define mz_jmp_buf mz_pre_jmp_buf
#endif
/* Like setjmp & longjmp, but you can jmp to a deeper stack position */
/* Intialize a Scheme_Jumpup_Buf record before using it */
typedef struct Scheme_Jumpup_Buf_Holder {
Scheme_Type type; /* for precise GC only */
Scheme_Jumpup_Buf buf;
} Scheme_Jumpup_Buf_Holder;
typedef struct Scheme_Continuation_Jump_State {
struct Scheme_Escaping_Cont *jumping_to_continuation;
union {
Scheme_Object **vals;
Scheme_Object *val;
} u;
mzshort num_vals;
short is_kill;
} Scheme_Continuation_Jump_State;
/* Although it's really an integer, it seems beneficial to declare the
mark position counter as a poiner, perhaps due to locality effects. */
#define MZ_MARK_POS_TYPE char*
#define MZ_MARK_STACK_TYPE char*
typedef struct Scheme_Cont_Frame_Data {
MZ_MARK_POS_TYPE cont_mark_pos;
MZ_MARK_STACK_TYPE cont_mark_stack;
} Scheme_Cont_Frame_Data;
/*========================================================================*/
/* threads */
/*========================================================================*/
typedef void (Scheme_Close_Custodian_Client)(Scheme_Object *o, void *data);
typedef void (*Scheme_Exit_Closer_Func)(Scheme_Object *, Scheme_Close_Custodian_Client *, void *);
typedef Scheme_Object *(*Scheme_Custodian_Extractor)(Scheme_Object *o);
#ifdef MZ_PRECISE_GC
typedef struct Scheme_Object Scheme_Custodian_Reference;
#else
typedef struct Scheme_Custodian *Scheme_Custodian_Reference;
#endif
typedef struct Scheme_Custodian Scheme_Custodian;
typedef int (*Scheme_Ready_Fun)(Scheme_Object *o);
typedef void (*Scheme_Needs_Wakeup_Fun)(Scheme_Object *, void *);
typedef Scheme_Object *(*Scheme_Wait_Sema_Fun)(Scheme_Object *, int *repost);
typedef int (*Scheme_Wait_Filter_Fun)(Scheme_Object *);
/* The Scheme_Thread structure represents a MzScheme thread. */
#if !SCHEME_DIRECT_EMBEDDED
# ifdef LINK_EXTENSIONS_BY_TABLE
# define scheme_current_thread (*scheme_current_thread_ptr)
# endif
#endif
typedef void (*Scheme_Kill_Action_Func)(void *);
# define BEGIN_ESCAPEABLE(func, data) \
{ mz_jmp_buf savebuf; \
scheme_push_kill_action((Scheme_Kill_Action_Func)func, (void *)data); \
memcpy(&savebuf, &scheme_error_buf, sizeof(mz_jmp_buf)); \
if (scheme_setjmp(scheme_error_buf)) { \
func(data); \
scheme_longjmp(savebuf, 1); \
} else {
# define END_ESCAPEABLE() \
scheme_pop_kill_action(); \
memcpy(&scheme_error_buf, &savebuf, sizeof(mz_jmp_buf)); } }
/*========================================================================*/
/* parameters */
/*========================================================================*/
enum {
MZCONFIG_ENV,
MZCONFIG_INPUT_PORT,
MZCONFIG_OUTPUT_PORT,
MZCONFIG_ERROR_PORT,
MZCONFIG_ENABLE_BREAK,
MZCONFIG_ERROR_DISPLAY_HANDLER,
MZCONFIG_ERROR_PRINT_VALUE_HANDLER,
MZCONFIG_EXIT_HANDLER,
MZCONFIG_EXN_HANDLER,
MZCONFIG_INIT_EXN_HANDLER,
MZCONFIG_EVAL_HANDLER,
MZCONFIG_LOAD_HANDLER,
MZCONFIG_PRINT_HANDLER,
MZCONFIG_PROMPT_READ_HANDLER,
MZCONFIG_CAN_READ_GRAPH,
MZCONFIG_CAN_READ_COMPILED,
MZCONFIG_CAN_READ_BOX,
MZCONFIG_CAN_READ_PIPE_QUOTE,
MZCONFIG_CAN_READ_DOT,
MZCONFIG_CAN_READ_QUASI,
MZCONFIG_READ_DECIMAL_INEXACT,
MZCONFIG_PRINT_GRAPH,
MZCONFIG_PRINT_STRUCT,
MZCONFIG_PRINT_BOX,
MZCONFIG_PRINT_VEC_SHORTHAND,
MZCONFIG_PRINT_HASH_TABLE,
mzscheme_wrap.h view on Meta::CPAN
#else
# define SCHEME_TAIL_CALL_WAITING scheme_tail_call_waiting
# define SCHEME_EVAL_WAITING scheme_eval_waiting
# define SCHEME_MULTIPLE_VALUES scheme_multiple_values
#endif
#define SCHEME_ASSERT(expr,msg) ((expr) ? 1 : (scheme_signal_error(msg), 0))
#define scheme_eval_wait_expr (scheme_current_thread->ku.eval.wait_expr)
#define scheme_tail_rator (scheme_current_thread->ku.apply.tail_rator)
#define scheme_tail_num_rands (scheme_current_thread->ku.apply.tail_num_rands)
#define scheme_tail_rands (scheme_current_thread->ku.apply.tail_rands)
#define scheme_overflow_k (scheme_current_thread->overflow_k)
#define scheme_overflow_reply (scheme_current_thread->overflow_reply)
#define scheme_error_buf (scheme_current_thread->error_buf)
#define scheme_jumping_to_continuation (scheme_current_thread->cjs.jumping_to_continuation)
#define scheme_config (scheme_current_thread->config)
#define scheme_multiple_count (scheme_current_thread->ku.multiple.count)
#define scheme_multiple_array (scheme_current_thread->ku.multiple.array)
#define scheme_setjmpup(b, base, s) scheme_setjmpup_relative(b, base, s, NULL)
#define scheme_do_eval_w_thread(r,n,e,f,p) scheme_do_eval(r,n,e,f)
#define scheme_apply_wp(r,n,a,p) scheme_apply(r,n,a)
#define scheme_apply_multi_wp(r,n,a,p) scheme_apply_multi(r,n,a)
#define scheme_apply_eb_wp(r,n,a,p) scheme_apply_eb(r,n,a)
#define scheme_apply_multi_eb_wp(r,n,a,p) scheme_apply_multi_eb(r,n,a)
#define _scheme_apply(r,n,rs) scheme_do_eval(r,n,rs,1)
#define _scheme_apply_multi(r,n,rs) scheme_do_eval(r,n,rs,-1)
#define _scheme_apply_wp(r,n,rs,p) scheme_do_eval_w_thread(r,n,rs,1,p)
#define _scheme_apply_multi_wp(r,n,rs,p) scheme_do_eval_w_thread(r,n,rs,-1,p)
#define _scheme_tail_apply scheme_tail_apply
#define _scheme_tail_apply_wp scheme_tail_apply_wp
#define _scheme_tail_eval scheme_tail_eval
#define _scheme_tail_eval_wp scheme_tail_eval_wp
#define _scheme_direct_apply_primitive_multi(prim, argc, argv) \
(((Scheme_Primitive_Proc *)prim)->prim_val(argc, argv))
#define _scheme_direct_apply_primitive(prim, argc, argv) \
scheme_check_one_value(_scheme_direct_apply_primitive_multi(prim, argc, argv))
#define _scheme_direct_apply_closed_primitive_multi(prim, argc, argv) \
(((Scheme_Closed_Primitive_Proc *)prim)->prim_val(((Scheme_Closed_Primitive_Proc *)prim)->data, argc, argv))
#define _scheme_direct_apply_closed_primitive(prim, argc, argv) \
scheme_check_one_value(_scheme_direct_apply_closed_primitive_multi(prim, argc, argv))
#define _scheme_force_value(v) ((v == SCHEME_TAIL_CALL_WAITING) ? scheme_force_value(v) : v)
#define scheme_tail_apply_buffer_wp(n, p) ((p)->tail_buffer)
#define scheme_tail_apply_buffer(n) scheme_tail_apply_buffer_wp(n, scheme_current_thread)
#define _scheme_tail_apply_no_copy_wp_tcw(f, n, args, p, tcw) (p->ku.apply.tail_rator = f, p->ku.apply.tail_rands = args, p->ku.apply.tail_num_rands = n, tcw)
#define _scheme_tail_apply_no_copy_wp(f, n, args, p) _scheme_tail_apply_no_copy_wp_tcw(f, n, args, p, SCHEME_TAIL_CALL_WAITING)
#define _scheme_tail_apply_no_copy(f, n, args) _scheme_tail_apply_no_copy_wp(f, n, args, scheme_current_thread)
#define scheme_thread_block_w_thread(t,p) scheme_thread_block(t)
#if !SCHEME_DIRECT_EMBEDDED
# ifdef LINK_EXTENSIONS_BY_TABLE
# define scheme_fuel_counter (*scheme_fuel_counter_ptr)
# endif
#else
#endif
#ifdef FUEL_AUTODECEREMENTS
# define DECREMENT_FUEL(f, p) (f)
#else
# define DECREMENT_FUEL(f, p) (f -= (p))
#endif
#define SCHEME_USE_FUEL(n) \
{ if (DECREMENT_FUEL(scheme_fuel_counter, n) <= 0) { scheme_out_of_fuel(); }}
#if SCHEME_DIRECT_EMBEDDED
#define scheme_tail_eval(obj) \
(scheme_eval_wait_expr = obj, SCHEME_EVAL_WAITING)
#endif
#define scheme_break_waiting(p) (p->external_break)
#ifndef USE_MZ_SETJMP
# ifdef USE_UNDERSCORE_SETJMP
# define scheme_mz_longjmp(b, v) _longjmp(b, v)
# define scheme_mz_setjmp(b) _setjmp(b)
# else
# define scheme_mz_longjmp(b, v) longjmp(b, v)
# define scheme_mz_setjmp(b) setjmp(b)
# endif
#endif
#ifdef MZ_PRECISE_GC
/* Need to make sure that a __gc_var_stack__ is always available where
setjmp & longjmp are used. */
# define scheme_longjmp(b, v) (((long *)((b).gcvs))[1] = (b).gcvs_cnt, \
GC_variable_stack = (void **)(b).gcvs, \
scheme_mz_longjmp((b).jb, v))
# define scheme_setjmp(b) ((b).gcvs = (long)__gc_var_stack__, \
(b).gcvs_cnt = (long)(__gc_var_stack__[1]), \
scheme_mz_setjmp((b).jb))
#else
# define scheme_longjmp(b, v) scheme_mz_longjmp(b, v)
# define scheme_setjmp(b) scheme_mz_setjmp(b)
#endif
/*========================================================================*/
/* memory management macros */
/*========================================================================*/
/* Allocation */
#define scheme_alloc_object() \
((Scheme_Object *) scheme_malloc_tagged(sizeof(Scheme_Object)))
#define scheme_alloc_small_object() \
((Scheme_Object *) scheme_malloc_tagged(sizeof(Scheme_Small_Object)))
#define scheme_alloc_stubborn_object() \
((Scheme_Object *) scheme_malloc_stubborn_tagged(sizeof(Scheme_Object)))
#define scheme_alloc_stubborn_small_object() \
((Scheme_Object *) scheme_malloc_stubborn_tagged(sizeof(Scheme_Small_Object)))
#define scheme_alloc_eternal_object() \
((Scheme_Object *) scheme_malloc_eternal_tagged(sizeof(Scheme_Object)))
#define scheme_alloc_eternal_small_object() \
((Scheme_Object *) scheme_malloc_eternal_tagged(sizeof(Scheme_Small_Object)))
#ifdef SCHEME_NO_GC
void *scheme_malloc(size_t size);
# define scheme_malloc_atomic scheme_malloc
# define scheme_malloc_stubborn scheme_malloc
# define scheme_malloc_uncollectable scheme_malloc
#else
# define scheme_malloc GC_malloc
# define scheme_malloc_atomic GC_malloc_atomic
# ifdef MZ_PRECISE_GC
# define scheme_malloc_stubborn scheme_malloc
# else
# define scheme_malloc_stubborn GC_malloc_stubborn
# endif
# define scheme_malloc_uncollectable GC_malloc_uncollectable
#endif
#ifdef USE_MEMORY_TRACING
# define USE_TAGGED_ALLOCATION
# define MEMORY_COUNTING_ON
#endif
#ifdef MZ_PRECISE_GC
# ifndef GC2_EXTERN
# define GC2_EXTERN MZ_EXTERN
# endif
# ifdef INCLUDE_WITHOUT_PATHS
# if SCHEME_DIRECT_EMBEDDED
# include "gc2.h"
# else
# define GC2_JUST_MACROS_AND_TYPEDEFS
# include "schemegc2.h"
# endif
# else
# include "../gc2/gc2.h"
# endif
# define scheme_malloc_tagged GC_malloc_one_tagged
# define scheme_malloc_array_tagged GC_malloc_array_tagged
# define scheme_malloc_atomic_tagged GC_malloc_atomic_tagged
# define scheme_malloc_stubborn_tagged GC_malloc_one_tagged
# define scheme_malloc_eternal_tagged GC_malloc_atomic_uncollectable
# define scheme_malloc_uncollectable_tagged >> error <<
# define scheme_malloc_envunbox GC_malloc
# define scheme_malloc_weak GC_malloc_weak
# define scheme_malloc_weak_tagged GC_malloc_one_weak_tagged
# define scheme_malloc_allow_interior GC_malloc_allow_interior
#else
# ifdef USE_TAGGED_ALLOCATION
extern void *scheme_malloc_tagged(size_t);
# define scheme_malloc_array_tagged scheme_malloc
extern void *scheme_malloc_atomic_tagged(size_t);
extern void *scheme_malloc_stubborn_tagged(size_t);
extern void *scheme_malloc_eternal_tagged(size_t);
extern void *scheme_malloc_uncollectable_tagged(size_t);
extern void *scheme_malloc_envunbox(size_t);
# else
# define scheme_malloc_tagged scheme_malloc
# define scheme_malloc_array_tagged scheme_malloc
# define scheme_malloc_atomic_tagged scheme_malloc_atomic
# define scheme_malloc_stubborn_tagged scheme_malloc_stubborn
# define scheme_malloc_eternal_tagged scheme_malloc_eternal
# define scheme_malloc_uncollectable_tagged scheme_malloc_uncollectable
# define scheme_malloc_envunbox scheme_malloc
# endif
# define scheme_malloc_allow_interior scheme_malloc
#endif
#ifdef MZ_PRECISE_GC
# define MZ_GC_DECL_REG(size) void *__gc_var_stack__[size+2] = { 0, size };
# define MZ_GC_VAR_IN_REG(x, v) (__gc_var_stack__[x+2] = (void *)&(v))
# define MZ_GC_ARRAY_VAR_IN_REG(x, v, l) (__gc_var_stack__[x+2] = (void *)0, \
__gc_var_stack__[x+3] = (void *)&(v), \
__gc_var_stack__[x+4] = (void *)l)
# define MZ_GC_REG() (__gc_var_stack__[0] = GC_variable_stack, \
GC_variable_stack = __gc_var_stack__)
# define MZ_GC_UNREG() (GC_variable_stack = __gc_var_stack__[0])
#else
# define MZ_GC_DECL_REG(size) /* empty */
# define MZ_GC_VAR_IN_REG(x, v) /* empty */
# define MZ_GC_ARRAY_VAR_IN_REG(x, v, l) /* empty */
# define MZ_GC_REG() /* empty */
# define MZ_GC_UNREG() /* empty */
#endif
/*========================================================================*/
/* embedding configuration and hooks */
/*========================================================================*/
#if SCHEME_DIRECT_EMBEDDED
#if defined(_IBMR2)
#endif
/* These flags must be set before MzScheme is started: */
/* Set these global hooks (optionally): */
#ifdef MZ_PRECISE_GC
#endif
#ifdef USE_WIN32_THREADS
int scheme_set_in_main_thread(void);
void scheme_restore_nonmain_thread(void);
#endif
#ifdef MAC_FILE_SYSTEM
extern long scheme_creator_id;
#endif
/* Initialization */
#ifdef USE_MSVC_MD_LIBRARY
#endif
/* image dump enabling startup: */
/* GC registration: */
#ifdef GC_MIGHT_USE_REGISTERED_STATICS
#endif
#if defined(MUST_REGISTER_GLOBALS) || defined(GC_MIGHT_USE_REGISTERED_STATICS)
# define MZ_REGISTER_STATIC(x) scheme_register_static((void *)&x, sizeof(x))
#else
# define MZ_REGISTER_STATIC(x) /* empty */
#endif
#endif /* SCHEME_DIRECT_EMBEDDED */
/*========================================================================*/
/* FFI functions */
/*========================================================================*/
/* If MzScheme is being empbedded, then we just include the
prototypes. Otherwise, we may include a function-table definition
instead, plus macros that map the usual name to table lookups. */
#if SCHEME_DIRECT_EMBEDDED
/* All functions & global constants prototyped here */
#ifdef INCLUDE_WITHOUT_PATHS
# include "schemef.h"
#else
# include "../src/schemef.h"
#endif
#else
#ifdef LINK_EXTENSIONS_BY_TABLE
/* Constants and function prototypes as function pointers in a struct: */
# ifdef INCLUDE_WITHOUT_PATHS
# include "schemex.h"
# else
# include "../src/schemex.h"
# endif
extern Scheme_Extension_Table *scheme_extension_table;
/* Macro mapping names to record access */
# ifdef INCLUDE_WITHOUT_PATHS
# include "schemexm.h"
# else
# include "../src/schemexm.h"
# endif
#else
/* Not LINK_EXTENSIONS_BY_TABLE */
# ifdef INCLUDE_WITHOUT_PATHS
# include "schemef.h"
# else
# include "../src/schemef.h"
# endif
#endif
#endif
/*========================================================================*/
/* misc flags */
/*========================================================================*/
/* For use with scheme_symbol_name_and_size: */
#define SCHEME_SNF_FOR_TS 0x1
#define SCHEME_SNF_PIPE_QUOTE 0x2
#define SCHEME_SNF_NO_PIPE_QUOTE 0x4
#define SCHEME_SNF_NEED_CASE 0x8
/* For use with scheme_make_struct_values et al.: */
#define SCHEME_STRUCT_NO_TYPE 0x01
#define SCHEME_STRUCT_NO_CONSTR 0x02
#define SCHEME_STRUCT_NO_PRED 0x04
#define SCHEME_STRUCT_NO_GET 0x08
#define SCHEME_STRUCT_NO_SET 0x10
#define SCHEME_STRUCT_GEN_GET 0x20
#define SCHEME_STRUCT_GEN_SET 0x40
#define SCHEME_STRUCT_EXPTIME 0x80
( run in 1.091 second using v1.01-cache-2.11-cpan-71847e10f99 )