From 20842aaf3abe787170978ed730877cfabb68f9c2 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 6 Dec 2016 07:18:02 -0700 Subject: [PATCH] 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. --- racket/src/racket/gc2/gc2.h | 8 ++- racket/src/racket/gc2/mem_account.c | 17 ++++-- racket/src/racket/gc2/newgc.c | 11 +++- racket/src/racket/gc2/newgc.h | 1 + racket/src/racket/src/future.c | 55 +++++++++++++++++ racket/src/racket/src/future.h | 12 ++-- racket/src/racket/src/gen-jit-ts.rkt | 2 +- racket/src/racket/src/jit_ts.c | 2 + racket/src/racket/src/jit_ts_protos.h | 60 +++++++++---------- racket/src/racket/src/jitinline.c | 85 +++++++++++++++++++++++++++ racket/src/racket/src/schpriv.h | 1 + racket/src/racket/src/vector.c | 9 +-- 12 files changed, 215 insertions(+), 48 deletions(-) diff --git a/racket/src/racket/gc2/gc2.h b/racket/src/racket/gc2/gc2.h index e6fd92b5cd..9378872c79 100644 --- a/racket/src/racket/gc2/gc2.h +++ b/racket/src/racket/gc2/gc2.h @@ -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); /* diff --git a/racket/src/racket/gc2/mem_account.c b/racket/src/racket/gc2/mem_account.c index a06ea84c29..24760bf257 100644 --- a/racket/src/racket/gc2/mem_account.c +++ b/racket/src/racket/gc2/mem_account.c @@ -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) diff --git a/racket/src/racket/gc2/newgc.c b/racket/src/racket/gc2/newgc.c index 6828ddc80f..b89adb883b 100644 --- a/racket/src/racket/gc2/newgc.c +++ b/racket/src/racket/gc2/newgc.c @@ -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 */ diff --git a/racket/src/racket/gc2/newgc.h b/racket/src/racket/gc2/newgc.h index c03b5d1489..c4e778d3a9 100644 --- a/racket/src/racket/gc2/newgc.h +++ b/racket/src/racket/gc2/newgc.h @@ -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; diff --git a/racket/src/racket/src/future.c b/racket/src/racket/src/future.c index 53d6f242bb..3c94498f59 100644 --- a/racket/src/racket/src/future.c +++ b/racket/src/racket/src/future.c @@ -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: diff --git a/racket/src/racket/src/future.h b/racket/src/racket/src/future.h index 0e78d93fd0..8d098486bb 100644 --- a/racket/src/racket/src/future.h +++ b/racket/src/racket/src/future.h @@ -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); diff --git a/racket/src/racket/src/gen-jit-ts.rkt b/racket/src/racket/src/gen-jit-ts.rkt index 4de54e7a79..fe1c646e9d 100644 --- a/racket/src/racket/src/gen-jit-ts.rkt +++ b/racket/src/racket/src/gen-jit-ts.rkt @@ -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)) diff --git a/racket/src/racket/src/jit_ts.c b/racket/src/racket/src/jit_ts.c index 10faf239fb..aefd611ca7 100644 --- a/racket/src/racket/src/jit_ts.c +++ b/racket/src/racket/src/jit_ts.c @@ -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 diff --git a/racket/src/racket/src/jit_ts_protos.h b/racket/src/racket/src/jit_ts_protos.h index bb96f2c95e..56f77b9b41 100644 --- a/racket/src/racket/src/jit_ts_protos.h +++ b/racket/src/racket/src/jit_ts_protos.h @@ -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); diff --git a/racket/src/racket/src/jitinline.c b/racket/src/racket/src/jitinline.c index 9f758bce77..41f373d875 100644 --- a/racket/src/racket/src/jitinline.c +++ b/racket/src/racket/src/jitinline.c @@ -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 */ diff --git a/racket/src/racket/src/schpriv.h b/racket/src/racket/src/schpriv.h index 03df4ee9d6..1c6cf7a8c8 100644 --- a/racket/src/racket/src/schpriv.h +++ b/racket/src/racket/src/schpriv.h @@ -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[]); diff --git a/racket/src/racket/src/vector.c b/racket/src/racket/src/vector.c index 8c64867250..00f114f559 100644 --- a/racket/src/racket/src/vector.c +++ b/racket/src/racket/src/vector.c @@ -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;