add scheme_register_process_global() to C API
This commit is contained in:
parent
b85934d2d4
commit
207114e7e9
|
@ -577,3 +577,4 @@ EXPORTS
|
||||||
scheme_get_signal_handle
|
scheme_get_signal_handle
|
||||||
scheme_char_strlen
|
scheme_char_strlen
|
||||||
scheme_stx_extract_marks
|
scheme_stx_extract_marks
|
||||||
|
scheme_register_process_global
|
||||||
|
|
|
@ -593,3 +593,4 @@ EXPORTS
|
||||||
scheme_get_signal_handle
|
scheme_get_signal_handle
|
||||||
scheme_char_strlen
|
scheme_char_strlen
|
||||||
scheme_stx_extract_marks
|
scheme_stx_extract_marks
|
||||||
|
scheme_register_process_global
|
||||||
|
|
|
@ -594,3 +594,4 @@ scheme_signal_received_at
|
||||||
scheme_get_signal_handle
|
scheme_get_signal_handle
|
||||||
scheme_char_strlen
|
scheme_char_strlen
|
||||||
scheme_stx_extract_marks
|
scheme_stx_extract_marks
|
||||||
|
scheme_register_process_global
|
||||||
|
|
|
@ -601,3 +601,4 @@ scheme_signal_received_at
|
||||||
scheme_get_signal_handle
|
scheme_get_signal_handle
|
||||||
scheme_char_strlen
|
scheme_char_strlen
|
||||||
scheme_stx_extract_marks
|
scheme_stx_extract_marks
|
||||||
|
scheme_register_process_global
|
||||||
|
|
|
@ -316,6 +316,8 @@ Scheme_Env *scheme_engine_instance_init() {
|
||||||
init_scheme_local();
|
init_scheme_local();
|
||||||
init_toplevels();
|
init_toplevels();
|
||||||
|
|
||||||
|
scheme_init_process_globals();
|
||||||
|
|
||||||
scheme_init_true_false();
|
scheme_init_true_false();
|
||||||
|
|
||||||
#ifdef MZ_PRECISE_GC
|
#ifdef MZ_PRECISE_GC
|
||||||
|
|
|
@ -1119,3 +1119,5 @@ MZ_EXTERN void *scheme_get_signal_handle();
|
||||||
MZ_EXTERN int scheme_char_strlen(const mzchar *s);
|
MZ_EXTERN int scheme_char_strlen(const mzchar *s);
|
||||||
|
|
||||||
MZ_EXTERN Scheme_Object *scheme_stx_extract_marks(Scheme_Object *stx);
|
MZ_EXTERN Scheme_Object *scheme_stx_extract_marks(Scheme_Object *stx);
|
||||||
|
|
||||||
|
MZ_EXTERN void *scheme_register_process_global(const char *key, void *val);
|
||||||
|
|
|
@ -923,6 +923,7 @@ void (*scheme_signal_received_at)(void *);
|
||||||
void *(*scheme_get_signal_handle)();
|
void *(*scheme_get_signal_handle)();
|
||||||
int (*scheme_char_strlen)(const mzchar *s);
|
int (*scheme_char_strlen)(const mzchar *s);
|
||||||
Scheme_Object *(*scheme_stx_extract_marks)(Scheme_Object *stx);
|
Scheme_Object *(*scheme_stx_extract_marks)(Scheme_Object *stx);
|
||||||
|
void *(*scheme_register_process_global)(const char *key, void *val);
|
||||||
#ifndef SCHEME_EX_INLINE
|
#ifndef SCHEME_EX_INLINE
|
||||||
} Scheme_Extension_Table;
|
} Scheme_Extension_Table;
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -649,3 +649,4 @@
|
||||||
scheme_extension_table->scheme_get_signal_handle = scheme_get_signal_handle;
|
scheme_extension_table->scheme_get_signal_handle = scheme_get_signal_handle;
|
||||||
scheme_extension_table->scheme_char_strlen = scheme_char_strlen;
|
scheme_extension_table->scheme_char_strlen = scheme_char_strlen;
|
||||||
scheme_extension_table->scheme_stx_extract_marks = scheme_stx_extract_marks;
|
scheme_extension_table->scheme_stx_extract_marks = scheme_stx_extract_marks;
|
||||||
|
scheme_extension_table->scheme_register_process_global = scheme_register_process_global;
|
||||||
|
|
|
@ -649,6 +649,7 @@
|
||||||
#define scheme_get_signal_handle (scheme_extension_table->scheme_get_signal_handle)
|
#define scheme_get_signal_handle (scheme_extension_table->scheme_get_signal_handle)
|
||||||
#define scheme_char_strlen (scheme_extension_table->scheme_char_strlen)
|
#define scheme_char_strlen (scheme_extension_table->scheme_char_strlen)
|
||||||
#define scheme_stx_extract_marks (scheme_extension_table->scheme_stx_extract_marks)
|
#define scheme_stx_extract_marks (scheme_extension_table->scheme_stx_extract_marks)
|
||||||
|
#define scheme_register_process_global (scheme_extension_table->scheme_register_process_global)
|
||||||
#ifdef MZ_PRECISE_GC
|
#ifdef MZ_PRECISE_GC
|
||||||
#pragma GC_VARIABLE_STACK_THOUGH_TABLE
|
#pragma GC_VARIABLE_STACK_THOUGH_TABLE
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -180,6 +180,7 @@ void scheme_register_traversers(void);
|
||||||
void scheme_init_hash_key_procs(void);
|
void scheme_init_hash_key_procs(void);
|
||||||
#endif
|
#endif
|
||||||
Scheme_Thread *scheme_make_thread(void*);
|
Scheme_Thread *scheme_make_thread(void*);
|
||||||
|
void scheme_init_process_globals(void);
|
||||||
void scheme_init_true_false(void);
|
void scheme_init_true_false(void);
|
||||||
void scheme_init_symbol_table(void);
|
void scheme_init_symbol_table(void);
|
||||||
void scheme_init_symbol_type(Scheme_Env *env);
|
void scheme_init_symbol_type(Scheme_Env *env);
|
||||||
|
|
|
@ -271,6 +271,17 @@ typedef struct {
|
||||||
# define xCUSTODIAN_FAM(x) (*(x))
|
# define xCUSTODIAN_FAM(x) (*(x))
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
typedef struct Proc_Global_Rec {
|
||||||
|
const char *key;
|
||||||
|
void *val;
|
||||||
|
struct Proc_Global_Rec *next;
|
||||||
|
} Proc_Global_Rec;
|
||||||
|
|
||||||
|
SHARED_OK static Proc_Global_Rec *process_globals;
|
||||||
|
#if defined(MZ_USE_MZRT)
|
||||||
|
static mzrt_mutex *process_global_lock;
|
||||||
|
#endif
|
||||||
|
|
||||||
#ifdef MZ_PRECISE_GC
|
#ifdef MZ_PRECISE_GC
|
||||||
static void register_traversers(void);
|
static void register_traversers(void);
|
||||||
#endif
|
#endif
|
||||||
|
@ -2524,6 +2535,49 @@ void scheme_set_runstack_limits(Scheme_Object **rs, long len, long start, long e
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void *scheme_register_process_global(const char *key, void *val)
|
||||||
|
{
|
||||||
|
void *old_val = NULL;
|
||||||
|
char *key2;
|
||||||
|
Proc_Global_Rec *pg;
|
||||||
|
long len;
|
||||||
|
|
||||||
|
#if defined(MZ_USE_MZRT)
|
||||||
|
mzrt_mutex_lock(process_global_lock);
|
||||||
|
#endif
|
||||||
|
|
||||||
|
for (pg = process_globals; pg; pg = pg->next) {
|
||||||
|
if (!strcmp(pg->key, key)) {
|
||||||
|
old_val = pg->val;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (!old_val && val) {
|
||||||
|
len = strlen(key);
|
||||||
|
key2 = (char *)malloc(len + 1);
|
||||||
|
memcpy(key2, key, len + 1);
|
||||||
|
pg = (Proc_Global_Rec *)malloc(sizeof(Proc_Global_Rec));
|
||||||
|
pg->key = key2;
|
||||||
|
pg->val = val;
|
||||||
|
pg->next = process_globals;
|
||||||
|
process_globals = pg;
|
||||||
|
}
|
||||||
|
|
||||||
|
#if defined(MZ_USE_MZRT)
|
||||||
|
mzrt_mutex_unlock(process_global_lock);
|
||||||
|
#endif
|
||||||
|
|
||||||
|
return old_val;
|
||||||
|
}
|
||||||
|
|
||||||
|
void scheme_init_process_globals(void)
|
||||||
|
{
|
||||||
|
#if defined(MZ_USE_MZRT)
|
||||||
|
mzrt_mutex_create(&process_global_lock);
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
/*========================================================================*/
|
/*========================================================================*/
|
||||||
/* thread creation and swapping */
|
/* thread creation and swapping */
|
||||||
/*========================================================================*/
|
/*========================================================================*/
|
||||||
|
|
Loading…
Reference in New Issue
Block a user