diff --git a/racket/src/bc/src/env.c b/racket/src/bc/src/env.c index 37a3919919..8e8c101729 100644 --- a/racket/src/bc/src/env.c +++ b/racket/src/bc/src/env.c @@ -16,6 +16,8 @@ void scheme_set_allow_set_undefined(int v) { scheme_allow_set_undefined = v; } int scheme_get_allow_set_undefined() { return scheme_allow_set_undefined; } THREAD_LOCAL_DECL(int scheme_starting_up); +int scheme_keep_builtin_context; + /* globals READ-ONLY SHARED */ READ_ONLY static Scheme_Object *kernel_symbol; @@ -178,7 +180,7 @@ Scheme_Env *scheme_basic_env() scheme_init_hash_key_procs(); #endif - scheme_init_getenv(); /* checks PLTNOJIT */ + scheme_init_getenv(); /* checks PLTNOJIT and PLT_SHOW_BUILTIN_CONTEXT */ #ifdef WINDOWS_PROCESSES /* Must be called before first scheme_make_thread() */ diff --git a/racket/src/bc/src/jit.c b/racket/src/bc/src/jit.c index 88b870ffbf..ec52fe1c88 100644 --- a/racket/src/bc/src/jit.c +++ b/racket/src/bc/src/jit.c @@ -20,7 +20,6 @@ static int lambda_has_been_jitted(Scheme_Native_Lambda *nlam); void scheme_jit_fill_threadlocal_table(); - typedef struct { Scheme_Native_Lambda nc; Scheme_Native_Lambda *case_lam; @@ -4029,7 +4028,8 @@ static void on_demand_generate_lambda(Scheme_Native_Closure *nc, Scheme_Native_L start_code = gdata.start_code; tail_code = gdata.tail_code; - if (lam->name) { + if (lam->name && (scheme_keep_builtin_context + || ((SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_STATUS_MASK) != LAMBDA_STATUS_BUILTIN))) { scheme_jit_add_symbol((uintptr_t)jit_unadjust_ip(start_code), (uintptr_t)jit_unadjust_ip(gdata.code_end) - 1, lam->name, 1); diff --git a/racket/src/bc/src/marshal.c b/racket/src/bc/src/marshal.c index e99d1a7ecb..6f8eeca699 100644 --- a/racket/src/bc/src/marshal.c +++ b/racket/src/bc/src/marshal.c @@ -210,6 +210,7 @@ Scheme_Object *scheme_read_lambda(int flags, int closure_size, int num_params, i data = (Scheme_Lambda *)scheme_malloc_tagged(sizeof(Scheme_Lambda)); data->iso.so.type = scheme_lambda_type; + if (scheme_starting_up) flags |= LAMBDA_STATUS_BUILTIN; SCHEME_LAMBDA_FLAGS(data) = (short)flags; data->num_params = num_params; diff --git a/racket/src/bc/src/optimize.c b/racket/src/bc/src/optimize.c index 8eb0199421..5152f48417 100644 --- a/racket/src/bc/src/optimize.c +++ b/racket/src/bc/src/optimize.c @@ -4265,7 +4265,7 @@ static Scheme_Object *finish_optimize_application(Scheme_App_Rec *app, Optimize_ rator_flags = get_rator_flags(rator, app->num_args, info); info->preserves_marks = !!(rator_flags & LAMBDA_PRESERVES_MARKS); info->single_result = !!(rator_flags & LAMBDA_SINGLE_RESULT); - if (rator_flags & LAMBDA_RESULT_TENTATIVE) { + if ((rator_flags & LAMBDA_STATUS_MASK) == LAMBDA_STATUS_RESULT_TENTATIVE) { info->preserves_marks = -info->preserves_marks; info->single_result = -info->single_result; } @@ -4790,7 +4790,7 @@ static Scheme_Object *finish_optimize_application2(Scheme_App2_Rec *app, Optimiz rator_flags = get_rator_flags(rator, 1, info); info->preserves_marks = !!(rator_flags & LAMBDA_PRESERVES_MARKS); info->single_result = !!(rator_flags & LAMBDA_SINGLE_RESULT); - if (rator_flags & LAMBDA_RESULT_TENTATIVE) { + if ((rator_flags & LAMBDA_STATUS_MASK) == LAMBDA_STATUS_RESULT_TENTATIVE) { info->preserves_marks = -info->preserves_marks; info->single_result = -info->single_result; } @@ -4946,9 +4946,9 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz /* Convert to apply-values form: */ return optimize_apply_values(app->rand2, lam->body, info, ((SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_SINGLE_RESULT) - ? ((SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_RESULT_TENTATIVE) - ? -1 - : 1) + ? (((SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_STATUS_MASK) == LAMBDA_STATUS_RESULT_TENTATIVE) + ? -1 + : 1) : 0), context); } @@ -5298,7 +5298,7 @@ static Scheme_Object *finish_optimize_application3(Scheme_App3_Rec *app, Optimiz rator_flags = get_rator_flags(app->rator, 2, info); info->preserves_marks = !!(rator_flags & LAMBDA_PRESERVES_MARKS); info->single_result = !!(rator_flags & LAMBDA_SINGLE_RESULT); - if (rator_flags & LAMBDA_RESULT_TENTATIVE) { + if ((rator_flags & LAMBDA_STATUS_MASK) == LAMBDA_STATUS_RESULT_TENTATIVE) { info->preserves_marks = -info->preserves_marks; info->single_result = -info->single_result; } @@ -5334,7 +5334,7 @@ Scheme_Object *optimize_apply_values(Scheme_Object *f, Scheme_Object *e, int flags = SCHEME_LAMBDA_FLAGS(lam); info->preserves_marks = !!(flags & LAMBDA_PRESERVES_MARKS); info->single_result = !!(flags & LAMBDA_SINGLE_RESULT); - if (flags & LAMBDA_RESULT_TENTATIVE) { + if ((flags & LAMBDA_STATUS_MASK) == LAMBDA_STATUS_RESULT_TENTATIVE) { info->preserves_marks = -info->preserves_marks; info->single_result = -info->single_result; } @@ -7256,7 +7256,7 @@ static int set_one_code_flags(Scheme_Object *value, int flags, merge_lambda_arg_types(lam, lam2); } - if (!just_tentative || (SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_RESULT_TENTATIVE)) { + if (!just_tentative || ((SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_STATUS_MASK) == LAMBDA_STATUS_RESULT_TENTATIVE)) { flags = (flags & SCHEME_LAMBDA_FLAGS(lam)); SCHEME_LAMBDA_FLAGS(lam2) = set_flags | (SCHEME_LAMBDA_FLAGS(lam2) & mask_flags); SCHEME_LAMBDA_FLAGS(lam3) = set_flags | (SCHEME_LAMBDA_FLAGS(lam3) & mask_flags); @@ -8070,7 +8070,7 @@ static Scheme_Object *optimize_lets(Scheme_Object *form, Optimize_Info *info, in /* Set-flags loop: */ clones = make_clones(retry_start, pre_body, rhs_info); (void)set_code_flags(retry_start, pre_body, clones, - LAMBDA_SINGLE_RESULT | LAMBDA_PRESERVES_MARKS | LAMBDA_RESULT_TENTATIVE, + LAMBDA_SINGLE_RESULT | LAMBDA_PRESERVES_MARKS | LAMBDA_STATUS_RESULT_TENTATIVE, 0xFFFF, 0, 0); @@ -8172,7 +8172,7 @@ static Scheme_Object *optimize_lets(Scheme_Object *form, Optimize_Info *info, in /* Reset-flags loop: */ (void)set_code_flags(retry_start, pre_body, clones, (flags & (LAMBDA_SINGLE_RESULT | LAMBDA_PRESERVES_MARKS)), - ~(LAMBDA_SINGLE_RESULT | LAMBDA_PRESERVES_MARKS | LAMBDA_RESULT_TENTATIVE), + ~(LAMBDA_SINGLE_RESULT | LAMBDA_PRESERVES_MARKS | LAMBDA_STATUS_MASK), 1, 1); } @@ -8579,8 +8579,8 @@ optimize_lambda(Scheme_Object *_lam, Optimize_Info *info, int context) SCHEME_LAMBDA_FLAGS(lam) -= LAMBDA_PRESERVES_MARKS; if ((info->single_result > 0) && (info->preserves_marks > 0) - && (SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_RESULT_TENTATIVE)) - SCHEME_LAMBDA_FLAGS(lam) -= LAMBDA_RESULT_TENTATIVE; + && ((SCHEME_LAMBDA_FLAGS(lam) & LAMBDA_STATUS_MASK) == LAMBDA_STATUS_RESULT_TENTATIVE)) + SCHEME_LAMBDA_FLAGS(lam) -= LAMBDA_STATUS_RESULT_TENTATIVE; lam->body = code; @@ -9352,7 +9352,7 @@ Scheme_Linklet *scheme_optimize_linklet(Scheme_Linklet *linklet, LAMBDA_PRESERVES_MARKS for all, but then assume not for all if any turn out not (i.e., approximate fix point). */ (void)set_code_closure_flags(cl_first, - LAMBDA_SINGLE_RESULT | LAMBDA_PRESERVES_MARKS | LAMBDA_RESULT_TENTATIVE, + LAMBDA_SINGLE_RESULT | LAMBDA_PRESERVES_MARKS | LAMBDA_STATUS_RESULT_TENTATIVE, 0xFFFF, 0); @@ -9430,7 +9430,7 @@ Scheme_Linklet *scheme_optimize_linklet(Scheme_Linklet *linklet, flags = set_code_closure_flags(cl_first, 0, 0xFFFF, 0); (void)set_code_closure_flags(cl_first, (flags & (LAMBDA_SINGLE_RESULT | LAMBDA_PRESERVES_MARKS)), - ~(LAMBDA_SINGLE_RESULT | LAMBDA_PRESERVES_MARKS | LAMBDA_RESULT_TENTATIVE), + ~(LAMBDA_SINGLE_RESULT | LAMBDA_PRESERVES_MARKS | LAMBDA_STATUS_MASK), 1); } diff --git a/racket/src/bc/src/schpriv.h b/racket/src/bc/src/schpriv.h index 6ef29525e4..b55766e443 100644 --- a/racket/src/bc/src/schpriv.h +++ b/racket/src/bc/src/schpriv.h @@ -501,6 +501,8 @@ Scheme_Object *scheme_get_startup_export(const char *s); extern int scheme_init_load_on_demand; +extern int scheme_keep_builtin_context; + /*========================================================================*/ /* constants */ /*========================================================================*/ @@ -2708,11 +2710,16 @@ Scheme_Comp_Env *scheme_set_comp_env_name(Scheme_Comp_Env *env, Scheme_Object *n #define LAMBDA_NEED_REST_CLEAR 8 #define LAMBDA_IS_METHOD 16 #define LAMBDA_SINGLE_RESULT 32 -#define LAMBDA_RESULT_TENTATIVE 64 -#define LAMBDA_VALIDATED 128 +#define LAMBDA_STATUS_MASK (64 | 128) #define LAMBDA_SFS 256 /* BITS 8-15 (overlaps LAMBDA_SFS) used by write_lambda() */ +/* These modes correspond to different times for a given `lambda`, + assuming that builtin functions are not validated: */ +#define LAMBDA_STATUS_RESULT_TENTATIVE 64 +#define LAMBDA_STATUS_VALIDATED 128 +#define LAMBDA_STATUS_BUILTIN (128 | 64) + #define COMP_ALLOW_SET_UNDEFINED 0x1 #define COMP_CAN_INLINE 0x2 #define COMP_ENFORCE_CONSTS 0x4 diff --git a/racket/src/bc/src/string.c b/racket/src/bc/src/string.c index 9bc2433147..af6da101bf 100644 --- a/racket/src/bc/src/string.c +++ b/racket/src/bc/src/string.c @@ -2099,7 +2099,10 @@ static int sch_bool_getenv(const char* name); void scheme_init_getenv(void) { if (sch_bool_getenv("PLTNOMZJIT")) { - scheme_set_startup_use_jit(0); + scheme_set_startup_use_jit(0); + } + if (sch_bool_getenv("PLT_SHOW_BUILTIN_CONTEXT")) { + scheme_keep_builtin_context = 1; } } diff --git a/racket/src/bc/src/validate.c b/racket/src/bc/src/validate.c index 6051dcdf6b..d9fb5b8b9e 100644 --- a/racket/src/bc/src/validate.c +++ b/racket/src/bc/src/validate.c @@ -1839,10 +1839,10 @@ static int validate_expr(Mz_CPort *port, Scheme_Object *expr, no_typed(need_local_type, port); expr = (Scheme_Object *)SCHEME_CLOSURE_CODE(expr); data = (Scheme_Lambda *)expr; - if (SCHEME_LAMBDA_FLAGS(data) & LAMBDA_VALIDATED) { + if ((SCHEME_LAMBDA_FLAGS(data) & LAMBDA_STATUS_MASK) == LAMBDA_STATUS_VALIDATED) { /* Done with this one. */ } else { - SCHEME_LAMBDA_FLAGS(data) |= LAMBDA_VALIDATED; + SCHEME_LAMBDA_FLAGS(data) = (SCHEME_LAMBDA_FLAGS(data) & ~LAMBDA_STATUS_MASK) | LAMBDA_STATUS_VALIDATED; did_one = 0; goto top; } diff --git a/racket/src/cs/rumble/error.ss b/racket/src/cs/rumble/error.ss index 6a45f94bf5..45c46f638f 100644 --- a/racket/src/cs/rumble/error.ss +++ b/racket/src/cs/rumble/error.ss @@ -534,6 +534,10 @@ ;; uses even more memory. (define trace-length-limit 65535) +(define suppress-generation-in-trace (if (getenv "PLT_SHOW_BUILTIN_CONTEXT") + -1 + 255)) + ;; Convert a continuation to a list of function-name and ;; source information. Cache the result half-way up the ;; traversal, so that it's amortized constant time. @@ -553,17 +557,18 @@ (let* ([name (or (and (not offset) (let ([attachments (continuation-next-attachments k)]) (and (pair? attachments) - (not (eq? attachments (continuation-next-attachments (#%$continuation-link k)))) + (not (fx= attachments (continuation-next-attachments (#%$continuation-link k)))) (let ([n (extract-mark-from-frame (car attachments) linklet-instantiate-key #f)]) (and n (string->symbol (format "body of ~a" n))))))) - (let* ([c (if offset - (#%$continuation-stack-return-code k offset) - (#%$continuation-return-code k))] - [n (#%$code-name c)]) - (if (path-or-empty-procedure-name-string? n) - #f - n)))] + (let ([c (if offset + (#%$continuation-stack-return-code k offset) + (#%$continuation-return-code k))]) + (and (not (eq? (#%$generation c) suppress-generation-in-trace)) + (let ([n (#%$code-name c)]) + (if (path-or-empty-procedure-name-string? n) + #f + n)))))] [desc (let* ([ci (#%$code-info (if offset (#%$continuation-stack-return-code k offset) @@ -683,13 +688,16 @@ (when (or (continuation-condition? v) (and (exn? v) (not (exn:fail:user? v)))) - (let ([n (|#%app| error-print-context-length)]) - (unless (zero? n) + (let* ([n (|#%app| error-print-context-length)] + [l (if (zero? n) + '() + (traces->context + (if (exn? v) + (continuation-mark-set-traces (exn-continuation-marks v)) + (list (continuation->trace (condition-continuation v))))))]) + (unless (null? l) (eprintf "\n context...:") - (let loop ([l (traces->context - (if (exn? v) - (continuation-mark-set-traces (exn-continuation-marks v)) - (list (continuation->trace (condition-continuation v)))))] + (let loop ([l l] [prev #f] [repeats 0] [n n])