+4 -6

Changes

reviewed

··· 188 188 (David Allsopp, Antonin Décimo, and Samuel Hym, review by Nicolas 189 189 Ojeda Bar) 190 190 191 191 - - #11911, #12383: Restore statmemprof functionality in part 192 192 - (backtrace buffers). (Nick Barnes, review by Gabriel Scherer) 193 193 - 194 194 - - #11911, #12383: Restore statmemprof functionality in part (backtrace 195 195 - buffers). (Nick Barnes, review by Gabriel Scherer and Fabrice 196 196 - Buoro). 191 191 + - #11911, #12382, #12383: Restore statmemprof functionality in part 192 192 + (backtrace buffers, per-thread and per-domain data 193 193 + structures). (Nick Barnes, review by Gabriel Scherer, Fabrice Buoro, 194 194 + Sadiq Jaffer, and Guillaume Munch-Maccagnoni). 197 195 198 196 - #12735: Store both ends of the stack chain in continuations 199 197 (Leo White, review by Miod Vallat and KC Sivaramakrishnan)

+11 -2

otherlibs/systhreads/st_stubs.c

reviewed

··· 88 88 value * gc_regs; /* saved value of Caml_state->gc_regs */ 89 89 value * gc_regs_buckets; /* saved value of Caml_state->gc_regs_buckets */ 90 90 void * exn_handler; /* saved value of Caml_state->exn_handler */ 91 91 + memprof_thread_t memprof; /* memprof's internal thread data structure */ 91 92 92 93 #ifndef NATIVE_CODE 93 94 intnat trap_sp_off; /* saved value of Caml_state->trap_sp_off */ ··· 225 226 Caml_state->trap_barrier_off = th->trap_barrier_off; 226 227 Caml_state->external_raise = th->external_raise; 227 228 #endif 229 229 + caml_memprof_enter_thread(th->memprof); 228 230 } 229 231 230 232 CAMLprim value caml_thread_cleanup(value unit); ··· 297 299 th->external_raise = NULL; 298 300 #endif 299 301 302 302 + th->memprof = caml_memprof_new_thread(domain_state); 300 303 return th; 301 304 } 302 305 ··· 384 387 th = Active_thread->next; 385 388 while (th != Active_thread) { 386 389 next = th->next; 390 390 + caml_memprof_delete_thread(th->memprof); 387 391 caml_thread_free_info(th); 388 392 th = next; 389 393 } ··· 459 463 new_thread->next = new_thread; 460 464 new_thread->prev = new_thread; 461 465 new_thread->backtrace_last_exn = Val_unit; 466 466 + new_thread->memprof = caml_memprof_main_thread(Caml_state); 462 467 463 468 st_tls_set(caml_thread_key, new_thread); 464 469 465 470 Active_thread = new_thread; 466 466 - 471 471 + caml_memprof_enter_thread(new_thread->memprof); 467 472 } 468 473 469 474 CAMLprim value caml_thread_yield(value unit); ··· 510 515 caml_domain_external_interrupt_hook = caml_thread_interrupt_hook; 511 516 caml_domain_initialize_hook = caml_thread_domain_initialize_hook; 512 517 caml_domain_stop_hook = caml_thread_domain_stop_hook; 513 513 - 514 518 caml_atfork_hook = caml_thread_reinitialize; 515 519 516 520 return Val_unit; ··· 543 547 /* The main domain thread does not go through [caml_thread_stop]. There is 544 548 always one more thread in the chain at this point in time. */ 545 549 CAMLassert(Active_thread->next != Active_thread); 550 550 + 551 551 + /* Tell memprof that this thread is terminating */ 552 552 + caml_memprof_delete_thread(Active_thread->memprof); 553 553 + 546 554 /* Signal that the thread has terminated */ 547 555 caml_threadstatus_terminate(Terminated(Active_thread->descr)); 548 556 ··· 674 682 th->prev = Active_thread; 675 683 Active_thread->next->prev = th; 676 684 Active_thread->next = th; 685 685 + 677 686 /* Associate the thread descriptor with the thread */ 678 687 st_tls_set(caml_thread_key, (void *) th); 679 688 /* Allocate the thread descriptor on the heap */

+10 -6

runtime/caml/domain_state.tbl

reviewed

··· 15 15 /**************************************************************************/ 16 16 17 17 DOMAIN_STATE(atomic_uintnat, young_limit) 18 18 + 18 19 /* Minor heap limit. Typically [young_start] <= [young_limit] <= 19 20 * [young_end], but this field can be set atomically to UINTNAT_MAX by 20 20 - * another thread (typically from another domain) in order to 21 21 - * interrupt this domain (by causing an allocation failure). Setting 22 22 - * [young_limit] to UINTNAT_MAX can be done safely at any time 23 23 - * whatsoever by any thread. To avoid races, setting [young_limit] to 24 24 - * anything else than UINTNAT_MAX should only be done via 25 25 - * [caml_reset_young_limit] by the domain itself. */ 21 21 + * another thread (typically from another domain), or by the memory 22 22 + * profiler, in order to interrupt this domain (by causing an 23 23 + * allocation failure). Setting [young_limit] to UINTNAT_MAX can be 24 24 + * done safely at any time whatsoever by any thread. To avoid races, 25 25 + * setting [young_limit] to anything else than UINTNAT_MAX should only 26 26 + * be done via [caml_reset_young_limit] by the domain itself. */ 26 27 27 28 DOMAIN_STATE(value*, young_ptr) 28 29 /* Minor heap pointer */ ··· 156 157 DOMAIN_STATE(int64_t, trap_barrier_block) 157 158 DOMAIN_STATE(struct caml_exception_context*, external_raise) 158 159 /* Bytecode TLS vars, not used for native code */ 160 160 + 161 161 + DOMAIN_STATE(struct memprof_domain_s *, memprof) 162 162 + DOMAIN_STATE(value *, memprof_young_trigger) 159 163 160 164 DOMAIN_STATE(extra_params_area, extra_params) 161 165 /* This member must occur last, because it is an array, not a scalar */

+14 -24

runtime/caml/memprof.h

reviewed

··· 22 22 #include "mlvalues.h" 23 23 #include "roots.h" 24 24 25 25 - extern void caml_memprof_set_suspended(int); 25 25 + /* Suspend or unsuspend profiling */ 26 26 + extern void caml_memprof_update_suspended(_Bool); 26 27 27 27 - extern value caml_memprof_handle_postponed_exn(void); 28 28 + /* Freshly set sampling point on minor heap */ 29 29 + extern void caml_memprof_renew_minor_sample(caml_domain_state *state); 28 30 29 29 - extern void caml_memprof_track_alloc_shr(value block); 30 30 - extern void caml_memprof_track_custom(value block, mlsize_t bytes); 31 31 - extern void caml_memprof_track_young(uintnat wosize, int from_caml, 32 32 - int nallocs, unsigned char* alloc_lens); 33 33 - extern void caml_memprof_track_interned(header_t* block, header_t* blockend); 34 34 - 35 35 - extern void caml_memprof_renew_minor_sample(void); 36 36 - extern value* caml_memprof_young_trigger; 37 37 - 38 38 - extern void caml_memprof_oldify_young_roots(void); 39 39 - extern void caml_memprof_minor_update(void); 40 40 - extern void caml_memprof_do_roots(scanning_action f); 41 41 - extern void caml_memprof_update_clean_phase(void); 42 42 - extern void caml_memprof_invert_tracked(void); 31 31 + /* Multi-domain support. */ 43 32 44 44 - CAMLextern struct caml_memprof_th_ctx caml_memprof_main_ctx; 33 33 + extern void caml_memprof_new_domain(caml_domain_state *parent, 34 34 + caml_domain_state *domain); 35 35 + extern void caml_memprof_delete_domain(caml_domain_state *domain); 45 36 46 46 - CAMLextern struct caml_memprof_th_ctx* caml_memprof_new_th_ctx(void); 47 47 - CAMLextern void caml_memprof_leave_thread(void); 48 48 - CAMLextern void caml_memprof_enter_thread(struct caml_memprof_th_ctx*); 49 49 - CAMLextern void caml_memprof_delete_th_ctx(struct caml_memprof_th_ctx*); 37 37 + /* Multi-thread support */ 50 38 51 51 - typedef void (*th_ctx_action)(struct caml_memprof_th_ctx*, void*); 39 39 + typedef struct memprof_thread_s *memprof_thread_t; 52 40 53 53 - /* This hook is not modified after other domains are spawned. */ 54 54 - extern void (*caml_memprof_th_ctx_iter_hook)(th_ctx_action, void*); 41 41 + CAMLextern memprof_thread_t caml_memprof_main_thread(caml_domain_state *domain); 42 42 + CAMLextern memprof_thread_t caml_memprof_new_thread(caml_domain_state *domain); 43 43 + CAMLextern void caml_memprof_enter_thread(memprof_thread_t); 44 44 + CAMLextern void caml_memprof_delete_thread(memprof_thread_t); 55 45 56 46 #endif 57 47

+62 -19

runtime/domain.c

reviewed

··· 58 58 #include "caml/intext.h" 59 59 #include "caml/major_gc.h" 60 60 #include "caml/minor_gc.h" 61 61 + #include "caml/memprof.h" 61 62 #include "caml/misc.h" 62 63 #include "caml/memory.h" 63 64 #include "caml/osdeps.h" ··· 518 519 * major slice is scheduled. */ 519 520 domain_state->young_trigger = domain_state->young_start 520 521 + (domain_state->young_end - domain_state->young_start) / 2; 522 522 + caml_memprof_renew_minor_sample(domain_state); 521 523 caml_reset_young_limit(domain_state); 522 524 523 525 check_minor_heap(); ··· 555 557 } 556 558 557 559 /* must be run on the domain's thread */ 558 558 - static void domain_create(uintnat initial_minor_heap_wsize) { 560 560 + static void domain_create(uintnat initial_minor_heap_wsize, 561 561 + caml_domain_state *parent) 562 562 + { 559 563 dom_internal* d = 0; 560 564 caml_domain_state* domain_state; 561 565 struct interruptor* s; ··· 583 587 CAMLassert(!s->running); 584 588 CAMLassert(!s->interrupt_pending); 585 589 586 586 - domain_self = d; 587 587 - 588 590 /* If the chosen domain slot has not been previously used, allocate a fresh 589 591 domain state. Otherwise, reuse it. 590 592 ··· 606 608 domain_state = d->state; 607 609 } 608 610 611 611 + s->unique_id = fresh_domain_unique_id(); 612 612 + s->running = 1; 613 613 + atomic_fetch_add(&caml_num_domains_running, 1); 614 614 + 615 615 + /* Note: until we take d->domain_lock, the domain_state may still be 616 616 + * shared with a domain which is terminating (see 617 617 + * domain_terminate). */ 618 618 + 619 619 + caml_plat_lock(&d->domain_lock); 620 620 + 621 621 + /* Set domain_self if we have successfully allocated the 622 622 + * caml_domain_state. Otherwise domain_self will be NULL and it's up 623 623 + * to the caller to deal with that. */ 624 624 + 625 625 + domain_self = d; 609 626 caml_state = domain_state; 610 627 611 628 domain_state->young_limit = 0; ··· 615 632 atomic_store_explicit(&s->interrupt_word, &domain_state->young_limit, 616 633 memory_order_release); 617 634 618 618 - s->unique_id = fresh_domain_unique_id(); 619 619 - s->running = 1; 620 620 - atomic_fetch_add(&caml_num_domains_running, 1); 621 621 - 622 622 - caml_plat_lock(&d->domain_lock); 635 635 + /* Tell memprof system about the new domain before either (a) new 636 636 + * domain can allocate anything or (b) parent domain can go away. */ 637 637 + caml_memprof_new_domain(parent, domain_state); 638 638 + if (!domain_state->memprof) { 639 639 + goto init_memprof_failure; 640 640 + } 623 641 624 642 domain_state->id = d->id; 625 643 domain_state->unique_id = d->interruptor.unique_id; ··· 730 748 caml_free_minor_tables(domain_state->minor_tables); 731 749 domain_state->minor_tables = NULL; 732 750 alloc_minor_tables_failure: 751 751 + caml_memprof_delete_domain(domain_state); 752 752 + init_memprof_failure: 733 753 domain_self = NULL; 734 754 735 755 ··· 921 941 dom->backup_thread_msg = BT_INIT; 922 942 } 923 943 924 924 - domain_create(minor_heap_wsz); 944 944 + domain_create(minor_heap_wsz, NULL); 925 945 if (!domain_self) caml_fatal_error("Failed to create main domain"); 926 946 CAMLassert (domain_self->state->unique_id == 0); 927 947 ··· 968 988 parameters returned to the parent by the child. 969 989 */ 970 990 struct domain_startup_params { 971 971 - struct interruptor* parent; /* in */ 991 991 + dom_internal *parent; /* in */ 972 992 enum domain_status status; /* in+out: 973 993 parent and child synchronize on this value. */ 974 994 struct domain_ml_values* ml_values; /* in */ ··· 1156 1176 } 1157 1177 #endif 1158 1178 1159 1159 - domain_create(caml_params->init_minor_heap_wsz); 1179 1179 + domain_create(caml_params->init_minor_heap_wsz, p->parent->state); 1180 1180 + 1181 1181 + if (!domain_self) { 1182 1182 + caml_fatal_error("Failed to create domain"); 1183 1183 + } 1184 1184 + 1160 1185 /* this domain is now part of the STW participant set */ 1161 1186 p->newdom = domain_self; 1162 1187 1163 1188 /* handshake with the parent domain */ 1164 1164 - caml_plat_lock(&p->parent->lock); 1189 1189 + caml_plat_lock(&p->parent->interruptor.lock); 1165 1190 if (domain_self) { 1166 1191 p->status = Dom_started; 1167 1192 p->unique_id = domain_self->interruptor.unique_id; 1168 1193 } else { 1169 1194 p->status = Dom_failed; 1170 1195 } 1171 1171 - caml_plat_broadcast(&p->parent->cond); 1172 1172 - caml_plat_unlock(&p->parent->lock); 1196 1196 + caml_plat_broadcast(&p->parent->interruptor.cond); 1197 1197 + caml_plat_unlock(&p->parent->interruptor.lock); 1173 1198 /* Cannot access p below here. */ 1174 1199 1175 1200 if (domain_self) { ··· 1228 1253 if (caml_debugger_in_use) 1229 1254 caml_fatal_error("ocamldebug does not support spawning multiple domains"); 1230 1255 #endif 1231 1231 - p.parent = &domain_self->interruptor; 1256 1256 + p.parent = domain_self; 1232 1257 p.status = Dom_starting; 1233 1258 1234 1259 p.ml_values = ··· 1620 1645 races. */ 1621 1646 void caml_reset_young_limit(caml_domain_state * dom_st) 1622 1647 { 1623 1623 - CAMLassert ((uintnat)dom_st->young_ptr >= (uintnat)dom_st->young_trigger); 1624 1648 /* An interrupt might have been queued in the meanwhile; the 1625 1649 atomic_exchange achieves the proper synchronisation with the 1626 1650 reads that follow (an atomic_store is not enough). */ 1627 1627 - atomic_exchange(&dom_st->young_limit, (uintnat)dom_st->young_trigger); 1628 1628 - /* In case of actions that we never delay, interrupt the domain 1629 1629 - again immediately. */ 1651 1651 + value *trigger = dom_st->young_trigger > dom_st->memprof_young_trigger ? 1652 1652 + dom_st->young_trigger : dom_st->memprof_young_trigger; 1653 1653 + CAMLassert ((uintnat)dom_st->young_ptr > 1654 1654 + (uintnat)dom_st->memprof_young_trigger); 1655 1655 + CAMLassert ((uintnat)dom_st->young_ptr > 1656 1656 + (uintnat)dom_st->young_trigger); 1657 1657 + /* An interrupt might have been queued in the meanwhile; this 1658 1658 + achieves the proper synchronisation. */ 1659 1659 + atomic_exchange(&dom_st->young_limit, (uintnat)trigger); 1660 1660 + 1630 1661 dom_internal * d = &all_domains[dom_st->id]; 1631 1662 if (atomic_load_relaxed(&d->interruptor.interrupt_pending) 1632 1663 || dom_st->requested_minor_gc ··· 1897 1928 } 1898 1929 caml_plat_unlock(&all_domains_lock); 1899 1930 } 1931 1931 + 1932 1932 + /* domain_state may be re-used by a fresh domain here (now that we 1933 1933 + * have done remove_from_stw_domains and released the 1934 1934 + * all_domains_lock). However, domain_create() won't touch it until 1935 1935 + * it has claimed the domain_lock, so we hang onto that while we are 1936 1936 + * tearing down the state. */ 1937 1937 + 1938 1938 + /* Delete the domain state from statmemprof after any promotion 1939 1939 + * (etc) done by this domain: any remaining memprof state will be 1940 1940 + * handed over to surviving domains. */ 1941 1941 + caml_memprof_delete_domain(domain_state); 1942 1942 + 1900 1943 /* We can not touch domain_self->interruptor after here 1901 1944 because it may be reused */ 1902 1945 caml_remove_generational_global_root(&domain_state->dls_root);

+257 -83

runtime/memprof.c

reviewed

··· 15 15 16 16 #define CAML_INTERNALS 17 17 18 18 + #include <stdbool.h> 19 19 + #include "caml/memory.h" 20 20 + #include "caml/memprof.h" 21 21 + 22 22 + /* type aliases for the hierarchy of structures for managing memprof status. */ 23 23 + 24 24 + typedef struct memprof_domain_s memprof_domain_s, *memprof_domain_t; 25 25 + typedef struct memprof_thread_s memprof_thread_s, *memprof_thread_t; 26 26 + 27 27 + /* Per-thread memprof state. */ 28 28 + 29 29 + struct memprof_thread_s { 30 30 + /* [suspended] is used for inhibiting memprof callbacks when 31 31 + a callback is running or when an uncaught exception handler is 32 32 + called. */ 33 33 + bool suspended; 34 34 + 35 35 + /* TODO: More fields to add here */ 36 36 + 37 37 + /* Per-domain memprof information */ 38 38 + memprof_domain_t domain; 39 39 + 40 40 + /* Linked list of thread structures for this domain. Could use a 41 41 + * doubly-linked list for performance, but I haven't measured it. */ 42 42 + memprof_thread_t next; 43 43 + }; 44 44 + 45 45 + /* A memprof configuration is held in an object on the Caml 46 46 + * heap. These are getter macros for each field. */ 47 47 + 48 48 + #define Stopped(config) Bool_val(Field(config, 0)) 49 49 + #define Running(config) ((config != Val_unit) && !Stopped(config)) 50 50 + #define Lambda(config) Double_val(Field(config, 1)) 51 51 + #define One_log1m_lambda(config) Double_val(Field(config, 2)) 52 52 + #define Callstack_size(config) Int_val(Field(config, 3) 53 53 + #define Alloc_minor(config) Field(config, 4) 54 54 + #define Alloc_major(config) Field(config, 5) 55 55 + #define Promote(config) Field(config, 6) 56 56 + #define Dealloc_minor(config) Field(config, 7) 57 57 + #define Dealloc_major(config) Field(config, 8) 58 58 + 59 59 + /* The 'stopped' field is the only one we ever update. */ 60 60 + 61 61 + #define Set_stopped(config, flag) (Field(config, 0) = Val_bool(flag)) 62 62 + 63 63 + /* Per-domain memprof state */ 64 64 + 65 65 + struct memprof_domain_s { 66 66 + /* The owning domain */ 67 67 + caml_domain_state *caml_state; 68 68 + 69 69 + /* Linked list of threads in this domain */ 70 70 + memprof_thread_t threads; 71 71 + 72 72 + /* The current thread's memprof state. Note that there may not be a 73 73 + "current thread". TODO: maybe this shouldn't be nullable. 74 74 + Nullability costs us some effort and may be meaningless. See call 75 75 + site of caml_memprof_leave_thread() in st_stubs.c. */ 76 76 + memprof_thread_t current; 77 77 + 78 78 + /* TODO: More fields to add here */ 79 79 + 80 80 + /* The current profiling configuration for this domain. */ 81 81 + value config; 82 82 + }; 83 83 + 84 84 + /**** Create and destroy thread state structures ****/ 85 85 + 86 86 + static memprof_thread_t thread_create(memprof_domain_t domain) 87 87 + { 88 88 + memprof_thread_t thread = caml_stat_alloc(sizeof(memprof_thread_s)); 89 89 + if (!thread) { 90 90 + return NULL; 91 91 + } 92 92 + thread->suspended = false; 93 93 + 94 94 + /* attach to domain record */ 95 95 + thread->domain = domain; 96 96 + thread->next = domain->threads; 97 97 + domain->threads = thread; 98 98 + 99 99 + return thread; 100 100 + } 101 101 + 102 102 + static void thread_destroy(memprof_thread_t thread) 103 103 + { 104 104 + memprof_domain_t domain = thread->domain; 105 105 + 106 106 + if (domain->current == thread) { 107 107 + domain->current = NULL; 108 108 + } 109 109 + /* remove thread from the per-domain list. Could go faster if we 110 110 + * used a doubly-linked list, but that's premature optimisation 111 111 + * at this point. */ 112 112 + memprof_thread_t *p = &domain->threads; 113 113 + while (*p != thread) { 114 114 + p = &(*p)->next; 115 115 + } 116 116 + 117 117 + *p = thread->next; 118 118 + 119 119 + caml_stat_free(thread); 120 120 + } 121 121 + 122 122 + /**** Create and destroy domain state structures ****/ 123 123 + 124 124 + static void domain_destroy(memprof_domain_t domain) 125 125 + { 126 126 + memprof_thread_t thread = domain->threads; 127 127 + while (thread) { 128 128 + memprof_thread_t next = thread->next; 129 129 + thread_destroy(thread); 130 130 + thread = next; 131 131 + } 132 132 + 133 133 + caml_stat_free(domain); 134 134 + } 135 135 + 136 136 + static memprof_domain_t domain_create(caml_domain_state *caml_state) 137 137 + { 138 138 + memprof_domain_t domain = caml_stat_alloc(sizeof(memprof_domain_s)); 139 139 + if (!domain) { 140 140 + return NULL; 141 141 + } 142 142 + 143 143 + domain->caml_state = caml_state; 144 144 + domain->threads = NULL; 145 145 + domain->current = NULL; 146 146 + domain->config = Val_unit; 147 147 + 148 148 + /* create initial thread for domain */ 149 149 + memprof_thread_t thread = thread_create(domain); 150 150 + if (thread) { 151 151 + domain->current = thread; 152 152 + } else { 153 153 + domain_destroy(domain); 154 154 + domain = NULL; 155 155 + } 156 156 + return domain; 157 157 + } 158 158 + 159 159 + /**** Interface to domain module ***/ 160 160 + 161 161 + void caml_memprof_new_domain(caml_domain_state *parent, 162 162 + caml_domain_state *child) 163 163 + { 164 164 + memprof_domain_t domain = domain_create(child); 165 165 + 166 166 + child->memprof = domain; 167 167 + /* domain inherits configuration from parent */ 168 168 + if (domain && parent) { 169 169 + domain->config = parent->memprof->config; 170 170 + } 171 171 + } 172 172 + 173 173 + void caml_memprof_delete_domain(caml_domain_state *state) 174 174 + { 175 175 + if (!state->memprof) { 176 176 + return; 177 177 + } 178 178 + domain_destroy(state->memprof); 179 179 + state->memprof = NULL; 180 180 + } 181 181 + 182 182 + /**** Interface with domain action-pending flag ****/ 183 183 + 184 184 + /* If profiling is active in the current domain, and we may have some 185 185 + * callbacks pending, set the action pending flag. */ 186 186 + 187 187 + static void set_action_pending_as_needed(memprof_domain_t domain) 188 188 + { 189 189 + /* if (condition) caml_set_action_pending(domain->caml_state); */ 190 190 + } 191 191 + 192 192 + /* Set the suspended flag on `domain` to `s`. */ 193 193 + 194 194 + static void update_suspended(memprof_domain_t domain, bool s) 195 195 + { 196 196 + if (domain->current) { 197 197 + domain->current->suspended = s; 198 198 + } 199 199 + caml_memprof_renew_minor_sample(domain->caml_state); 200 200 + if (!s) set_action_pending_as_needed(domain); 201 201 + } 202 202 + 203 203 + /* Set the suspended flag on the current domain to `s`. */ 204 204 + 205 205 + void caml_memprof_update_suspended(bool s) { 206 206 + update_suspended(Caml_state->memprof, s); 207 207 + } 208 208 + 209 209 + /**** Sampling procedures ****/ 210 210 + 211 211 + Caml_inline bool running(memprof_domain_t domain) 212 212 + { 213 213 + memprof_thread_t thread = domain->current; 214 214 + 215 215 + if (thread && !thread->suspended) { 216 216 + value config = domain->config; 217 217 + return Running(config); 218 218 + } 219 219 + return false; 220 220 + } 221 221 + 222 222 + /* Renew the next sample in a domain's minor heap. Could race with 223 223 + * sampling and profile-stopping code, so do not call from another 224 224 + * domain unless the world is stopped. Must be called after each minor 225 225 + * sample and after each minor collection. In practice, this is called 226 226 + * at each minor sample, at each minor collection, and when sampling 227 227 + * is suspended and unsuspended. Extra calls do not change the 228 228 + * statistical properties of the sampling because of the 229 229 + * memorylessness of the geometric distribution. */ 230 230 + 231 231 + void caml_memprof_renew_minor_sample(caml_domain_state *state) 232 232 + { 233 233 + memprof_domain_t domain = state->memprof; 234 234 + value *trigger = state->young_start; 235 235 + if (running(domain)) { 236 236 + /* set trigger based on geometric distribution */ 237 237 + } 238 238 + CAMLassert((trigger >= state->young_start) && 239 239 + (trigger < state->young_ptr)); 240 240 + state->memprof_young_trigger = trigger; 241 241 + caml_reset_young_limit(state); 242 242 + } 243 243 + 244 244 + /**** Interface with systhread. ****/ 245 245 + 246 246 + CAMLexport memprof_thread_t caml_memprof_new_thread(caml_domain_state *state) 247 247 + { 248 248 + return thread_create(state->memprof); 249 249 + } 250 250 + 251 251 + CAMLexport memprof_thread_t caml_memprof_main_thread(caml_domain_state *state) 252 252 + { 253 253 + memprof_domain_t domain = state->memprof; 254 254 + memprof_thread_t thread = domain->threads; 255 255 + 256 256 + /* There should currently be just one thread in this domain */ 257 257 + CAMLassert(thread); 258 258 + CAMLassert(thread->next == NULL); 259 259 + return thread; 260 260 + } 261 261 + 262 262 + CAMLexport void caml_memprof_delete_thread(memprof_thread_t thread) 263 263 + { 264 264 + thread_destroy(thread); 265 265 + } 266 266 + 267 267 + CAMLexport void caml_memprof_enter_thread(memprof_thread_t thread) 268 268 + { 269 269 + thread->domain->current = thread; 270 270 + update_suspended(thread->domain, thread->suspended); 271 271 + } 272 272 + 273 273 + /**** Interface to OCaml ****/ 274 274 + 18 275 #include "caml/fail.h" 19 276 20 277 CAMLprim value caml_memprof_start(value lv, value szv, value tracker_param) ··· 575 832 caml_set_action_pending(Caml_state); 576 833 } 577 834 578 578 - void caml_memprof_set_suspended(int s) 579 579 - { 580 580 - local->suspended = s; 581 581 - caml_memprof_renew_minor_sample(); 582 582 - if (!s) check_action_pending(); 583 583 - } 584 584 - 585 835 /* In case of a thread context switch during a callback, this can be 586 836 called in a reetrant way. */ 587 837 value caml_memprof_handle_postponed_exn(void) ··· 812 1062 caml_reset_young_limit(Caml_state); 813 1063 } 814 1064 815 815 - /* Renew the next sample in the minor heap. This needs to be called 816 816 - after each minor sampling and after each minor collection. In 817 817 - practice, this is called at each sampling in the minor heap and at 818 818 - each minor collection. Extra calls do not change the statistical 819 819 - properties of the sampling because of the memorylessness of the 820 820 - geometric distribution. */ 821 821 - void caml_memprof_renew_minor_sample(void) 822 822 - { 823 823 - if (lambda == 0 || local->suspended) 824 824 - /* No trigger in the current minor heap. */ 825 825 - caml_memprof_young_trigger = Caml_state->young_alloc_start; 826 826 - else { 827 827 - uintnat geom = rand_geom(); 828 828 - if (Caml_state->young_ptr - Caml_state->young_alloc_start < geom) 829 829 - /* No trigger in the current minor heap. */ 830 830 - caml_memprof_young_trigger = Caml_state->young_alloc_start; 831 831 - else 832 832 - caml_memprof_young_trigger = Caml_state->young_ptr - (geom - 1); 833 833 - } 834 834 - 835 835 - caml_reset_young_limit(Caml_state); 836 836 - } 837 837 - 838 1065 /* Called when exceeding the threshold for the next sample in the 839 1066 minor heap, from the C code (the handling is different when called 840 1067 from natively compiled OCaml code). */ ··· 1073 1300 ea->t = NULL; 1074 1301 } 1075 1302 } 1076 1076 - 1077 1077 - static void th_ctx_memprof_stop(struct caml_memprof_th_ctx* ctx, void* data) 1078 1078 - { 1079 1079 - (void)data; 1080 1080 - if (ctx->callback_status != CB_IDLE) ctx->callback_status = CB_STOPPED; 1081 1081 - empty_entry_array(&ctx->entries); 1082 1082 - } 1083 1083 - 1084 1303 CAMLprim value caml_memprof_stop(value unit) 1085 1304 { 1086 1305 if (!started) caml_failwith("Gc.Memprof.stop: not started."); ··· 1107 1326 callstack_buffer_len = 0; 1108 1327 1109 1328 return Val_unit; 1110 1110 - } 1111 1111 - 1112 1112 - /**** Interface with systhread. ****/ 1113 1113 - 1114 1114 - static void th_ctx_iter_default(th_ctx_action f, void* data) { 1115 1115 - f(local, data); 1116 1116 - } 1117 1117 - 1118 1118 - CAMLexport void (*caml_memprof_th_ctx_iter_hook)(th_ctx_action, void*) 1119 1119 - = th_ctx_iter_default; 1120 1120 - 1121 1121 - CAMLexport struct caml_memprof_th_ctx* caml_memprof_new_th_ctx() 1122 1122 - { 1123 1123 - struct caml_memprof_th_ctx* ctx = 1124 1124 - caml_stat_alloc(sizeof(struct caml_memprof_th_ctx)); 1125 1125 - ctx->suspended = 0; 1126 1126 - ctx->callback_status = CB_IDLE; 1127 1127 - ctx->entries.t = NULL; 1128 1128 - ctx->entries.min_alloc_len = MIN_ENTRIES_LOCAL_ALLOC_LEN; 1129 1129 - ctx->entries.alloc_len = ctx->entries.len = 0; 1130 1130 - ctx->entries.young_idx = ctx->entries.delete_idx = 0; 1131 1131 - return ctx; 1132 1132 - } 1133 1133 - 1134 1134 - CAMLexport void caml_memprof_delete_th_ctx(struct caml_memprof_th_ctx* ctx) 1135 1135 - { 1136 1136 - if (ctx->callback_status >= 0) 1137 1137 - /* A callback is running in this thread from the global entries 1138 1138 - array. We delete the corresponding entry. */ 1139 1139 - mark_deleted(&entries_global, ctx->callback_status); 1140 1140 - if (ctx == local) local = NULL; 1141 1141 - caml_stat_free(ctx->entries.t); 1142 1142 - if (ctx != &caml_memprof_main_ctx) caml_stat_free(ctx); 1143 1143 - } 1144 1144 - 1145 1145 - CAMLexport void caml_memprof_leave_thread(void) 1146 1146 - { 1147 1147 - local = NULL; 1148 1148 - } 1149 1149 - 1150 1150 - CAMLexport void caml_memprof_enter_thread(struct caml_memprof_th_ctx* ctx) 1151 1151 - { 1152 1152 - CAMLassert(local == NULL); 1153 1153 - local = ctx; 1154 1154 - caml_memprof_set_suspended(ctx->suspended); 1155 1329 } 1156 1330 1157 1331 #endif

+7

runtime/printexc.c

reviewed

··· 17 17 18 18 /* Print an uncaught exception and abort */ 19 19 20 20 + #include <stdbool.h> 20 21 #include <stdio.h> 21 22 #include <stdlib.h> 22 23 #include <string.h> ··· 142 143 143 144 handle_uncaught_exception = 144 145 caml_named_value("Printexc.handle_uncaught_exception"); 146 146 + 147 147 + /* If the callback allocates, memprof could be called, in which case 148 148 + a memprof callback could raise an exception while 149 149 + [handle_uncaught_exception] is running, and the printing of 150 150 + the exception could fail. */ 151 151 + caml_memprof_update_suspended(true); 145 152 146 153 if (handle_uncaught_exception != NULL) 147 154 /* [Printexc.handle_uncaught_exception] does not raise exception. */