make make-vector future-safe
One interesting corner case is when a vector is allocated in a way that would exceed a memory limit. The custodian captured with a future is used to guard large allocations.
This commit is contained in:
Matthew Flatt
parent
8b915ea977
commit
20842aaf3a
|
|
@ -163,9 +163,15 @@ GC2_EXTERN int GC_set_account_hook(int type, void *c1, uintptr_t b, void *c2);
|
|||
|
||||
GC2_EXTERN uintptr_t GC_get_account_memory_limit(void *c1);
|
||||
/*
|
||||
Returns a moemory accounting limit for c1 (or any ancestor),
|
||||
Returns a memory accounting limit for c1 (or any ancestor),
|
||||
or 0 if none is set. */
|
||||
|
||||
GC2_EXTERN void GC_set_accounting_custodian(void *c);
|
||||
/*
|
||||
Sets a custodian for checking memory limits for the next allocation.
|
||||
This custodian should be cleared when allocation returns, but it
|
||||
will be reset to NULL if a GC is triggered. */
|
||||
|
||||
GC2_EXTERN void GC_gcollect(void);
|
||||
GC2_EXTERN void GC_gcollect_minor(void);
|
||||
/*
|
||||
|
|
|
|||
|
|
@ -145,7 +145,7 @@ inline static int create_blank_owner_set(NewGC *gc)
|
|||
return create_blank_owner_set(gc);
|
||||
}
|
||||
|
||||
inline static int custodian_to_owner_set(NewGC *gc,Scheme_Custodian *cust)
|
||||
inline static int custodian_to_owner_set(NewGC *gc, Scheme_Custodian *cust)
|
||||
{
|
||||
int i;
|
||||
|
||||
|
|
@ -878,11 +878,16 @@ int BTC_single_allocation_limit(NewGC *gc, size_t sizeb)
|
|||
* GC_out_of_memory protects any user-requested allocation whose size
|
||||
* is independent of any existing object, then we can enforce the limit. */
|
||||
{
|
||||
Scheme_Thread *p = scheme_current_thread;
|
||||
if (p)
|
||||
return (custodian_single_time_limit(gc, thread_get_owner(p)) < sizeb);
|
||||
else
|
||||
return (gc->place_memory_limit < sizeb);
|
||||
if (gc->alternate_accounting_custodian) {
|
||||
int set = custodian_to_owner_set(gc, gc->alternate_accounting_custodian);
|
||||
return (custodian_single_time_limit(gc, set) < sizeb);
|
||||
} else {
|
||||
Scheme_Thread *p = scheme_current_thread;
|
||||
if (p)
|
||||
return (custodian_single_time_limit(gc, thread_get_owner(p)) < sizeb);
|
||||
else
|
||||
return (gc->place_memory_limit < sizeb);
|
||||
}
|
||||
}
|
||||
|
||||
static uintptr_t BTC_get_account_hook(void *c1)
|
||||
|
|
|
|||
|
|
@ -230,6 +230,11 @@ inline static void out_of_memory_gc(NewGC* gc) {
|
|||
out_of_memory();
|
||||
}
|
||||
|
||||
void GC_set_accounting_custodian(void *c) {
|
||||
NewGC *gc = GC_get_GC();
|
||||
gc->alternate_accounting_custodian = c;
|
||||
}
|
||||
|
||||
/*****************************************************************************/
|
||||
/* OS-level memory management */
|
||||
/* */
|
||||
|
|
@ -1289,11 +1294,13 @@ static void *allocate_big(const size_t request_size_bytes, int type)
|
|||
if (GC_gen0_alloc_only) return NULL;
|
||||
|
||||
#ifdef NEWGC_BTC_ACCOUNT
|
||||
if(GC_out_of_memory) {
|
||||
if (GC_out_of_memory || gc->alternate_accounting_custodian) {
|
||||
if (premaster_or_place_gc(gc)) {
|
||||
if (BTC_single_allocation_limit(gc, request_size_bytes)) {
|
||||
/* We're allowed to fail. Check for allocations that exceed a single-time
|
||||
limit. See BTC_single_allocation_limit() for more information. */
|
||||
if (gc->alternate_accounting_custodian)
|
||||
return NULL;
|
||||
GC_out_of_memory();
|
||||
}
|
||||
}
|
||||
|
|
@ -5502,6 +5509,8 @@ static void garbage_collect(NewGC *gc, int force_full, int no_full,
|
|||
gc->mark_gen1 = (gc->gc_full || gc->started_incremental) && !gc->all_marked_incremental;
|
||||
gc->check_gen1 = gc->gc_full && !gc->all_marked_incremental;
|
||||
|
||||
gc->alternate_accounting_custodian = NULL;
|
||||
|
||||
/* ------------------------------------------------------------ */
|
||||
/* Prepare */
|
||||
|
||||
|
|
|
|||
|
|
@ -337,6 +337,7 @@ typedef struct NewGC {
|
|||
GC_Post_Propagate_Hook_Proc GC_post_propagate_hook;
|
||||
GC_Treat_As_Incremental_Mark_Proc treat_as_incremental_mark_hook;
|
||||
short treat_as_incremental_mark_tag;
|
||||
void *alternate_accounting_custodian;
|
||||
|
||||
GC_Immobile_Box *immobile_boxes;
|
||||
|
||||
|
|
|
|||
|
|
@ -432,6 +432,10 @@ static void init_cpucount(void);
|
|||
# define scheme_future_longjmp(newbuf, v) scheme_longjmp(newbuf, v)
|
||||
#endif
|
||||
|
||||
#ifndef MZ_PRECISE_GC
|
||||
# define GC_set_accounting_custodian(c) /* nothing */
|
||||
#endif
|
||||
|
||||
/**********************************************************************/
|
||||
/* Arguments for a newly created future thread */
|
||||
/**********************************************************************/
|
||||
|
|
@ -3145,6 +3149,35 @@ Scheme_Structure *scheme_rtcall_allocate_structure(int count, Scheme_Struct_Type
|
|||
return (Scheme_Structure *)retval;
|
||||
}
|
||||
|
||||
Scheme_Object *scheme_rtcall_allocate_vector(int count)
|
||||
XFORM_SKIP_PROC
|
||||
/* Called in future thread */
|
||||
{
|
||||
Scheme_Future_Thread_State *fts = scheme_future_thread_state;
|
||||
future_t *future = fts->thread->current_ft;
|
||||
Scheme_Object *retval;
|
||||
|
||||
future->prim_protocol = SIG_ALLOC_VECTOR;
|
||||
|
||||
future->arg_i0 = count;
|
||||
|
||||
future->time_of_request = get_future_timestamp();
|
||||
future->source_of_request = "[allocate_structure]";
|
||||
future->source_type = FSRC_OTHER;
|
||||
|
||||
future_do_runtimecall(fts, NULL, 1, 0, 0);
|
||||
|
||||
/* Fetch the future again, in case moved by a GC */
|
||||
future = fts->thread->current_ft;
|
||||
|
||||
future->arg_s0 = NULL;
|
||||
|
||||
retval = future->retval_s;
|
||||
future->retval_s = NULL;
|
||||
|
||||
return retval;
|
||||
}
|
||||
|
||||
Scheme_Object *scheme_rtcall_tail_apply(Scheme_Object *rator, int argc, Scheme_Object **argv)
|
||||
XFORM_SKIP_PROC
|
||||
/* Called in future thread */
|
||||
|
|
@ -3535,6 +3568,28 @@ static void do_invoke_rtcall(Scheme_Future_State *fs, future_t *future)
|
|||
|
||||
future->retval_s = (Scheme_Object *)res;
|
||||
|
||||
break;
|
||||
}
|
||||
case SIG_ALLOC_VECTOR:
|
||||
{
|
||||
GC_CAN_IGNORE Scheme_Object *res;
|
||||
intptr_t count = future->arg_i0;
|
||||
|
||||
future->arg_s0 = NULL;
|
||||
|
||||
GC_set_accounting_custodian(future->cust);
|
||||
|
||||
res = scheme_malloc_tagged(sizeof(Scheme_Vector)
|
||||
+ ((count - mzFLEX_DELTA) * sizeof(Scheme_Object *)));
|
||||
if (res) {
|
||||
res->type = scheme_vector_type;
|
||||
SCHEME_VEC_SIZE(res) = count;
|
||||
}
|
||||
|
||||
GC_set_accounting_custodian(NULL);
|
||||
|
||||
future->retval_s = res;
|
||||
|
||||
break;
|
||||
}
|
||||
case SIG_TAIL_APPLY:
|
||||
|
|
|
|||
|
|
@ -241,11 +241,12 @@ typedef struct fsemaphore_t {
|
|||
#define SIG_ALLOC_MARK_SEGMENT 3
|
||||
#define SIG_ALLOC_VALUES 4
|
||||
#define SIG_ALLOC_STRUCT 5
|
||||
#define SIG_MAKE_FSEMAPHORE 6
|
||||
#define SIG_FUTURE 7
|
||||
#define SIG_WRONG_TYPE_EXN 8
|
||||
#define SIG_TAIL_APPLY 9
|
||||
#define SIG_APPLY_AFRESH 10
|
||||
#define SIG_ALLOC_VECTOR 6
|
||||
#define SIG_MAKE_FSEMAPHORE 7
|
||||
#define SIG_FUTURE 8
|
||||
#define SIG_WRONG_TYPE_EXN 9
|
||||
#define SIG_TAIL_APPLY 10
|
||||
#define SIG_APPLY_AFRESH 11
|
||||
|
||||
# include "jit_ts_protos.h"
|
||||
|
||||
|
|
@ -256,6 +257,7 @@ extern uintptr_t scheme_rtcall_alloc(void);
|
|||
extern void scheme_rtcall_new_mark_segment(Scheme_Thread *p);
|
||||
extern void scheme_rtcall_allocate_values(int count, Scheme_Thread *t);
|
||||
extern Scheme_Structure *scheme_rtcall_allocate_structure(int argc, Scheme_Struct_Type *stype);
|
||||
extern Scheme_Object *scheme_rtcall_allocate_vector(int count);
|
||||
extern Scheme_Object *scheme_rtcall_make_fsemaphore(Scheme_Object *ready);
|
||||
extern Scheme_Object *scheme_rtcall_make_future(Scheme_Object *proc);
|
||||
extern Scheme_Object *scheme_rtcall_tail_apply(Scheme_Object *rator, int argc, Scheme_Object **argv);
|
||||
|
|
|
|||
|
|
@ -153,7 +153,7 @@
|
|||
})
|
||||
(newline))
|
||||
|
||||
(define proto-counter 11)
|
||||
(define proto-counter 20)
|
||||
|
||||
(define (gen-protos t)
|
||||
(define-values (arg-types result-type) (parse-type t))
|
||||
|
|
|
|||
|
|
@ -141,6 +141,7 @@ define_ts_l_s(scheme_jit_make_vector, FSRC_OTHER)
|
|||
# endif
|
||||
define_ts_ss_s(equal_as_bool, FSRC_MARKS)
|
||||
define_ts_sss_s(extract_one_cc_mark_to_tag, FSRC_MARKS)
|
||||
define_ts_iS_s(scheme_checked_make_vector, FSRC_MARKS)
|
||||
#endif
|
||||
|
||||
#ifdef JIT_APPLY_TS_PROCS
|
||||
|
|
@ -225,6 +226,7 @@ define_ts_s_s(scheme_box, FSRC_OTHER)
|
|||
# define ts_scheme_string_eq_2 scheme_string_eq_2
|
||||
# define ts_scheme_byte_string_eq_2 scheme_byte_string_eq_2
|
||||
# define ts_extract_one_cc_mark_to_tag extract_one_cc_mark_to_tag
|
||||
# define ts_scheme_checked_make_vector scheme_checked_make_vector
|
||||
# define ts_tail_call_with_values_from_multiple_result tail_call_with_values_from_multiple_result
|
||||
# define ts_raise_bad_call_with_values raise_bad_call_with_values
|
||||
# define ts_call_with_values_from_multiple_result_multi call_with_values_from_multiple_result_multi
|
||||
|
|
|
|||
|
|
@ -1,90 +1,90 @@
|
|||
#define SIG_siS_s 11
|
||||
#define SIG_siS_s 20
|
||||
typedef Scheme_Object* (*prim_siS_s)(Scheme_Object*, int, Scheme_Object**);
|
||||
Scheme_Object* scheme_rtcall_siS_s(const char *who, int src_type, prim_siS_s f, Scheme_Object* g358, int g359, Scheme_Object** g360);
|
||||
#define SIG_iSs_s 12
|
||||
#define SIG_iSs_s 21
|
||||
typedef Scheme_Object* (*prim_iSs_s)(int, Scheme_Object**, Scheme_Object*);
|
||||
Scheme_Object* scheme_rtcall_iSs_s(const char *who, int src_type, prim_iSs_s f, int g361, Scheme_Object** g362, Scheme_Object* g363);
|
||||
#define SIG_s_s 13
|
||||
#define SIG_s_s 22
|
||||
typedef Scheme_Object* (*prim_s_s)(Scheme_Object*);
|
||||
Scheme_Object* scheme_rtcall_s_s(const char *who, int src_type, prim_s_s f, Scheme_Object* g364);
|
||||
#define SIG_n_s 14
|
||||
#define SIG_n_s 23
|
||||
typedef Scheme_Object* (*prim_n_s)(Scheme_Native_Lambda*);
|
||||
Scheme_Object* scheme_rtcall_n_s(const char *who, int src_type, prim_n_s f, Scheme_Native_Lambda* g365);
|
||||
#define SIG__s 15
|
||||
#define SIG__s 24
|
||||
typedef Scheme_Object* (*prim__s)();
|
||||
Scheme_Object* scheme_rtcall__s(const char *who, int src_type, prim__s f );
|
||||
#define SIG_ss_s 16
|
||||
#define SIG_ss_s 25
|
||||
typedef Scheme_Object* (*prim_ss_s)(Scheme_Object*, Scheme_Object*);
|
||||
Scheme_Object* scheme_rtcall_ss_s(const char *who, int src_type, prim_ss_s f, Scheme_Object* g366, Scheme_Object* g367);
|
||||
#define SIG_ssi_s 17
|
||||
#define SIG_ssi_s 26
|
||||
typedef Scheme_Object* (*prim_ssi_s)(Scheme_Object*, Scheme_Object*, int);
|
||||
Scheme_Object* scheme_rtcall_ssi_s(const char *who, int src_type, prim_ssi_s f, Scheme_Object* g368, Scheme_Object* g369, int g370);
|
||||
#define SIG_tt_s 18
|
||||
#define SIG_tt_s 27
|
||||
typedef Scheme_Object* (*prim_tt_s)(const Scheme_Object*, const Scheme_Object*);
|
||||
Scheme_Object* scheme_rtcall_tt_s(const char *who, int src_type, prim_tt_s f, const Scheme_Object* g371, const Scheme_Object* g372);
|
||||
#define SIG_ss_m 19
|
||||
#define SIG_ss_m 28
|
||||
typedef MZ_MARK_STACK_TYPE (*prim_ss_m)(Scheme_Object*, Scheme_Object*);
|
||||
MZ_MARK_STACK_TYPE scheme_rtcall_ss_m(const char *who, int src_type, prim_ss_m f, Scheme_Object* g373, Scheme_Object* g374);
|
||||
#define SIG_Sl_s 20
|
||||
#define SIG_Sl_s 29
|
||||
typedef Scheme_Object* (*prim_Sl_s)(Scheme_Object**, intptr_t);
|
||||
Scheme_Object* scheme_rtcall_Sl_s(const char *who, int src_type, prim_Sl_s f, Scheme_Object** g375, intptr_t g376);
|
||||
#define SIG_l_s 21
|
||||
#define SIG_l_s 30
|
||||
typedef Scheme_Object* (*prim_l_s)(intptr_t);
|
||||
Scheme_Object* scheme_rtcall_l_s(const char *who, int src_type, prim_l_s f, intptr_t g377);
|
||||
#define SIG_bsi_v 22
|
||||
#define SIG_bsi_v 31
|
||||
typedef void (*prim_bsi_v)(Scheme_Bucket*, Scheme_Object*, int);
|
||||
void scheme_rtcall_bsi_v(const char *who, int src_type, prim_bsi_v f, Scheme_Bucket* g378, Scheme_Object* g379, int g380);
|
||||
#define SIG_iiS_v 23
|
||||
#define SIG_iiS_v 32
|
||||
typedef void (*prim_iiS_v)(int, int, Scheme_Object**);
|
||||
void scheme_rtcall_iiS_v(const char *who, int src_type, prim_iiS_v f, int g381, int g382, Scheme_Object** g383);
|
||||
#define SIG_ss_v 24
|
||||
#define SIG_ss_v 33
|
||||
typedef void (*prim_ss_v)(Scheme_Object*, Scheme_Object*);
|
||||
void scheme_rtcall_ss_v(const char *who, int src_type, prim_ss_v f, Scheme_Object* g384, Scheme_Object* g385);
|
||||
#define SIG_b_v 25
|
||||
#define SIG_b_v 34
|
||||
typedef void (*prim_b_v)(Scheme_Bucket*);
|
||||
void scheme_rtcall_b_v(const char *who, int src_type, prim_b_v f, Scheme_Bucket* g386);
|
||||
#define SIG_sl_s 26
|
||||
#define SIG_sl_s 35
|
||||
typedef Scheme_Object* (*prim_sl_s)(Scheme_Object*, intptr_t);
|
||||
Scheme_Object* scheme_rtcall_sl_s(const char *who, int src_type, prim_sl_s f, Scheme_Object* g387, intptr_t g388);
|
||||
#define SIG_iS_s 27
|
||||
#define SIG_iS_s 36
|
||||
typedef Scheme_Object* (*prim_iS_s)(int, Scheme_Object**);
|
||||
Scheme_Object* scheme_rtcall_iS_s(const char *who, int src_type, prim_iS_s f, int g389, Scheme_Object** g390);
|
||||
#define SIG_S_s 28
|
||||
#define SIG_S_s 37
|
||||
typedef Scheme_Object* (*prim_S_s)(Scheme_Object**);
|
||||
Scheme_Object* scheme_rtcall_S_s(const char *who, int src_type, prim_S_s f, Scheme_Object** g391);
|
||||
#define SIG_s_v 29
|
||||
#define SIG_s_v 38
|
||||
typedef void (*prim_s_v)(Scheme_Object*);
|
||||
void scheme_rtcall_s_v(const char *who, int src_type, prim_s_v f, Scheme_Object* g392);
|
||||
#define SIG_iSi_s 30
|
||||
#define SIG_iSi_s 39
|
||||
typedef Scheme_Object* (*prim_iSi_s)(int, Scheme_Object**, int);
|
||||
Scheme_Object* scheme_rtcall_iSi_s(const char *who, int src_type, prim_iSi_s f, int g393, Scheme_Object** g394, int g395);
|
||||
#define SIG_siS_v 31
|
||||
#define SIG_siS_v 40
|
||||
typedef void (*prim_siS_v)(Scheme_Object*, int, Scheme_Object**);
|
||||
void scheme_rtcall_siS_v(const char *who, int src_type, prim_siS_v f, Scheme_Object* g396, int g397, Scheme_Object** g398);
|
||||
#define SIG_Sii_s 32
|
||||
#define SIG_Sii_s 41
|
||||
typedef Scheme_Object* (*prim_Sii_s)(Scheme_Object**, int, int);
|
||||
Scheme_Object* scheme_rtcall_Sii_s(const char *who, int src_type, prim_Sii_s f, Scheme_Object** g399, int g400, int g401);
|
||||
#define SIG_z_p 33
|
||||
#define SIG_z_p 42
|
||||
typedef void* (*prim_z_p)(size_t);
|
||||
void* scheme_rtcall_z_p(const char *who, int src_type, prim_z_p f, size_t g402);
|
||||
#define SIG_si_s 34
|
||||
#define SIG_si_s 43
|
||||
typedef Scheme_Object* (*prim_si_s)(Scheme_Object*, int);
|
||||
Scheme_Object* scheme_rtcall_si_s(const char *who, int src_type, prim_si_s f, Scheme_Object* g403, int g404);
|
||||
#define SIG_sis_v 35
|
||||
#define SIG_sis_v 44
|
||||
typedef void (*prim_sis_v)(Scheme_Object*, int, Scheme_Object*);
|
||||
void scheme_rtcall_sis_v(const char *who, int src_type, prim_sis_v f, Scheme_Object* g405, int g406, Scheme_Object* g407);
|
||||
#define SIG_ss_i 36
|
||||
#define SIG_ss_i 45
|
||||
typedef int (*prim_ss_i)(Scheme_Object*, Scheme_Object*);
|
||||
int scheme_rtcall_ss_i(const char *who, int src_type, prim_ss_i f, Scheme_Object* g408, Scheme_Object* g409);
|
||||
#define SIG_iSp_v 37
|
||||
#define SIG_iSp_v 46
|
||||
typedef void (*prim_iSp_v)(int, Scheme_Object**, void*);
|
||||
void scheme_rtcall_iSp_v(const char *who, int src_type, prim_iSp_v f, int g410, Scheme_Object** g411, void* g412);
|
||||
#define SIG_sss_s 38
|
||||
#define SIG_sss_s 47
|
||||
typedef Scheme_Object* (*prim_sss_s)(Scheme_Object*, Scheme_Object*, Scheme_Object*);
|
||||
Scheme_Object* scheme_rtcall_sss_s(const char *who, int src_type, prim_sss_s f, Scheme_Object* g413, Scheme_Object* g414, Scheme_Object* g415);
|
||||
#define SIG__v 39
|
||||
#define SIG__v 48
|
||||
typedef void (*prim__v)();
|
||||
void scheme_rtcall__v(const char *who, int src_type, prim__v f );
|
||||
#define SIG_iS_v 40
|
||||
#define SIG_iS_v 49
|
||||
typedef void (*prim_iS_v)(int, Scheme_Object**);
|
||||
void scheme_rtcall_iS_v(const char *who, int src_type, prim_iS_v f, int g416, Scheme_Object** g417);
|
||||
|
|
|
|||
|
|
@ -773,6 +773,51 @@ static Scheme_Object *alloc_structure(Scheme_Object *_stype, int argc)
|
|||
return (Scheme_Object *)inst;
|
||||
}
|
||||
|
||||
#ifdef MZ_USE_FUTURES
|
||||
static Scheme_Object *checked_make_vector(int argc)
|
||||
XFORM_SKIP_PROC
|
||||
/* Arguments on runstack */
|
||||
{
|
||||
Scheme_Object *vec, *val, *c = MZ_RUNSTACK[0];
|
||||
|
||||
if (SCHEME_INTP(c)
|
||||
&& (SCHEME_INT_VAL(c) >= 0)
|
||||
/* Upper bound ensures that we don't have to deal with overflow: */
|
||||
&& (SCHEME_INT_VAL(c) < 0x1000000)) {
|
||||
/* In a future thread, we can try to call scheme_malloc_tagged() directory,
|
||||
but it might fail and return NULL */
|
||||
intptr_t count = SCHEME_INT_VAL(c), i, size;
|
||||
size = (sizeof(Scheme_Vector)
|
||||
+ ((count - mzFLEX_DELTA) * sizeof(Scheme_Object *)));
|
||||
if ((count < 1024) || scheme_use_rtcall)
|
||||
vec = scheme_malloc_tagged(size);
|
||||
else
|
||||
vec = scheme_malloc_fail_ok(scheme_malloc_tagged, size);
|
||||
if (vec) {
|
||||
vec->type = scheme_vector_type;
|
||||
SCHEME_VEC_SIZE(vec) = count;
|
||||
} else {
|
||||
/* Must be in a future thread */
|
||||
vec = scheme_rtcall_allocate_vector(count);
|
||||
if (!vec) {
|
||||
/* Unusual failure --- maybe "out of memory" */
|
||||
return ts_scheme_checked_make_vector(argc, MZ_RUNSTACK);
|
||||
}
|
||||
}
|
||||
|
||||
val = ((argc > 1) ? MZ_RUNSTACK[1] : scheme_make_integer(0));
|
||||
for (i = 0; i < count; i++) {
|
||||
SCHEME_VEC_ELS(vec)[i] = val;
|
||||
}
|
||||
|
||||
return vec;
|
||||
} else
|
||||
return ts_scheme_checked_make_vector(argc, MZ_RUNSTACK);
|
||||
}
|
||||
#else
|
||||
# define checked_make_vector ts_scheme_checked_make_vector
|
||||
#endif
|
||||
|
||||
Scheme_Structure *scheme_jit_allocate_structure(int argc, Scheme_Struct_Type *stype)
|
||||
{
|
||||
Scheme_Structure *inst;
|
||||
|
|
@ -1108,6 +1153,10 @@ static int generate_inlined_constant_varref_test(mz_jit_state *jitter, Scheme_Ob
|
|||
static int generate_vector_alloc(mz_jit_state *jitter, Scheme_Object *rator,
|
||||
Scheme_App_Rec *app, Scheme_App2_Rec *app2, Scheme_App3_Rec *app3,
|
||||
int dest);
|
||||
static int generate_make_vector_alloc(mz_jit_state *jitter,
|
||||
Scheme_Object *rator,
|
||||
Scheme_Object *rand1, Scheme_Object *rand2,
|
||||
int dest);
|
||||
|
||||
int scheme_generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, int is_tail, int multi_ok,
|
||||
Branch_Info *for_branch, int branch_short, int result_ignored,
|
||||
|
|
@ -2063,6 +2112,8 @@ int scheme_generate_inlined_unary(mz_jit_state *jitter, Scheme_App2_Rec *app, in
|
|||
} else if (IS_NAMED_PRIM(rator, "vector-immutable")
|
||||
|| IS_NAMED_PRIM(rator, "vector")) {
|
||||
return generate_vector_alloc(jitter, rator, NULL, app, NULL, dest);
|
||||
} else if (IS_NAMED_PRIM(rator, "make-vector")) {
|
||||
return generate_make_vector_alloc(jitter, rator, app->rand, NULL, dest);
|
||||
} else if (IS_NAMED_PRIM(rator, "list*")
|
||||
|| IS_NAMED_PRIM(rator, "values")) {
|
||||
/* on a single argument, `list*' or `values' is identity */
|
||||
|
|
@ -3916,6 +3967,8 @@ int scheme_generate_inlined_binary(mz_jit_state *jitter, Scheme_App3_Rec *app, i
|
|||
} else if (IS_NAMED_PRIM(rator, "vector-immutable")
|
||||
|| IS_NAMED_PRIM(rator, "vector")) {
|
||||
return generate_vector_alloc(jitter, rator, NULL, NULL, app, dest);
|
||||
} else if (IS_NAMED_PRIM(rator, "make-vector")) {
|
||||
return generate_make_vector_alloc(jitter, rator, app->rand1, app->rand2, dest);
|
||||
} else if (IS_NAMED_PRIM(rator, "make-rectangular")) {
|
||||
GC_CAN_IGNORE jit_insn *ref, *ref2, *ref3, *ref4, *refslow, *refdone;
|
||||
|
||||
|
|
@ -5276,6 +5329,38 @@ static int generate_vector_alloc(mz_jit_state *jitter, Scheme_Object *rator,
|
|||
return 1;
|
||||
}
|
||||
|
||||
int generate_make_vector_alloc(mz_jit_state *jitter,
|
||||
Scheme_Object *rator,
|
||||
Scheme_Object *rand1, Scheme_Object *rand2,
|
||||
int dest)
|
||||
/* de-sync'd ok */
|
||||
{
|
||||
GC_CAN_IGNORE jit_insn *refrts USED_ONLY_FOR_FUTURES;
|
||||
Scheme_Object *args[3];
|
||||
int argc = (rand2 ? 2 : 1);
|
||||
|
||||
args[0] = rator;
|
||||
args[1] = rand1;
|
||||
args[2] = rand2;
|
||||
|
||||
scheme_generate_app(NULL, args, argc, argc, jitter, 0, 0, 0, 2);
|
||||
|
||||
mz_rs_sync();
|
||||
JIT_UPDATE_THREAD_RSPTR_IF_NEEDED();
|
||||
|
||||
jit_movi_i(JIT_R1, argc);
|
||||
|
||||
jit_prepare(1);
|
||||
jit_pusharg_i(JIT_R1);
|
||||
(void)mz_finish_lwe(checked_make_vector, refrts);
|
||||
jit_retval(dest);
|
||||
|
||||
jit_addi_l(JIT_RUNSTACK, JIT_RUNSTACK, WORDS_TO_BYTES(argc));
|
||||
mz_runstack_popped(jitter, argc);
|
||||
|
||||
return 1;
|
||||
}
|
||||
|
||||
int scheme_generate_inlined_test(mz_jit_state *jitter, Scheme_Object *obj, int branch_short,
|
||||
Branch_Info *for_branch)
|
||||
/* de-sync'd ok; syncs before jump */
|
||||
|
|
|
|||
|
|
@ -4475,6 +4475,7 @@ Scheme_Object *scheme_checked_make_flrectangular (int argc, Scheme_Object *argv[
|
|||
Scheme_Object *scheme_procedure_arity_includes(int argc, Scheme_Object *argv[]);
|
||||
Scheme_Object *scheme_checked_char_to_integer (int argc, Scheme_Object *argv[]);
|
||||
Scheme_Object *scheme_checked_integer_to_char (int argc, Scheme_Object *argv[]);
|
||||
Scheme_Object *scheme_checked_make_vector (int argc, Scheme_Object *argv[]);
|
||||
|
||||
Scheme_Object *scheme_check_not_undefined (int argc, Scheme_Object *argv[]);
|
||||
Scheme_Object *scheme_check_assign_not_undefined (int argc, Scheme_Object *argv[]);
|
||||
|
|
|
|||
|
|
@ -41,7 +41,6 @@ READ_ONLY Scheme_Object *scheme_unsafe_struct_ref_proc;
|
|||
|
||||
/* locals */
|
||||
static Scheme_Object *vector_p (int argc, Scheme_Object *argv[]);
|
||||
static Scheme_Object *make_vector (int argc, Scheme_Object *argv[]);
|
||||
static Scheme_Object *vector (int argc, Scheme_Object *argv[]);
|
||||
static Scheme_Object *vector_immutable (int argc, Scheme_Object *argv[]);
|
||||
static Scheme_Object *vector_length (int argc, Scheme_Object *argv[]);
|
||||
|
|
@ -84,7 +83,9 @@ scheme_init_vector (Scheme_Env *env)
|
|||
scheme_vector_p_proc = p;
|
||||
|
||||
REGISTER_SO(scheme_make_vector_proc);
|
||||
p = scheme_make_immed_prim(make_vector, "make-vector", 1, 2);
|
||||
p = scheme_make_immed_prim(scheme_checked_make_vector, "make-vector", 1, 2);
|
||||
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
|
||||
| SCHEME_PRIM_IS_BINARY_INLINED);
|
||||
scheme_add_global_constant("make-vector", p, env);
|
||||
scheme_make_vector_proc = p;
|
||||
|
||||
|
|
@ -319,8 +320,8 @@ vector_p (int argc, Scheme_Object *argv[])
|
|||
return (SCHEME_CHAPERONE_VECTORP(argv[0]) ? scheme_true : scheme_false);
|
||||
}
|
||||
|
||||
static Scheme_Object *
|
||||
make_vector (int argc, Scheme_Object *argv[])
|
||||
Scheme_Object *
|
||||
scheme_checked_make_vector (int argc, Scheme_Object *argv[])
|
||||
{
|
||||
Scheme_Object *vec, *fill;
|
||||
intptr_t len;
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user