/* Allocate more memory from malloc for the heap. Return a blue block of at least the requested size. The blue block is chained to a sequence of blue blocks (through their field 0); the last block of the chain is pointed by field 1 of the first. There may be a fragment after the last block. The caller must insert the blocks into the free list. [request] is a number of words and must be less than or equal to [Max_wosize]. Return NULL when out of memory. */ static value *expand_heap (mlsize_t request) { /* these point to headers, but we do arithmetic on them, hence [value *]. */ value *mem, *hp, *prev; asize_t over_request, malloc_request, remain; Assert (request <= Max_wosize); over_request = Whsize_wosize (request + request / 100 * caml_percent_free); malloc_request = caml_round_heap_chunk_wsz (over_request); mem = (value *) caml_alloc_for_heap (Bsize_wsize (malloc_request)); if (mem == NULL){ caml_gc_message (0x04, "No room for growing heap\n", 0); return NULL; } remain = malloc_request; prev = hp = mem; /* FIXME find a way to do this with a call to caml_make_free_blocks */ while (Wosize_whsize (remain) > Max_wosize){ Hd_hp (hp) = Make_header (Max_wosize, 0, Caml_blue); #ifdef DEBUG caml_set_fields (Val_hp (hp), 0, Debug_free_major); #endif hp += Whsize_wosize (Max_wosize); remain -= Whsize_wosize (Max_wosize); Field (Val_hp (mem), 1) = Field (Val_hp (prev), 0) = Val_hp (hp); prev = hp; } if (remain > 1){ Hd_hp (hp) = Make_header (Wosize_whsize (remain), 0, Caml_blue); #ifdef DEBUG caml_set_fields (Val_hp (hp), 0, Debug_free_major); #endif Field (Val_hp (mem), 1) = Field (Val_hp (prev), 0) = Val_hp (hp); Field (Val_hp (hp), 0) = (value) NULL; }else{ Field (Val_hp (prev), 0) = (value) NULL; if (remain == 1) Hd_hp (hp) = Make_header (0, 0, Caml_white); } Assert (Wosize_hp (mem) >= request); if (caml_add_to_heap ((char *) mem) != 0){ caml_free_for_heap ((char *) mem); return NULL; } return Op_hp (mem); }
/* Allocate more memory from malloc for the heap. Return a blue block of at least the requested size. The blue block is chained to a sequence of blue blocks (through their field 0); the last block of the chain is pointed by field 1 of the first. There may be a fragment after the last block. The caller must insert the blocks into the free list. The request must be less than or equal to Max_wosize. Return NULL when out of memory. */ static char *expand_heap (mlsize_t request) { char *mem, *hp, *prev; asize_t over_request, malloc_request, remain; Assert (request <= Max_wosize); over_request = request + request / 100 * caml_percent_free; malloc_request = caml_round_heap_chunk_size (Bhsize_wosize (over_request)); mem = caml_alloc_for_heap (malloc_request); if (mem == NULL){ caml_gc_message (0x04, "No room for growing heap\n", 0); return NULL; } remain = malloc_request; prev = hp = mem; /* FIXME find a way to do this with a call to caml_make_free_blocks */ while (Wosize_bhsize (remain) > Max_wosize){ Hd_hp (hp) = Make_header (Max_wosize, 0, Caml_blue); #ifdef DEBUG caml_set_fields (Bp_hp (hp), 0, Debug_free_major); #endif hp += Bhsize_wosize (Max_wosize); remain -= Bhsize_wosize (Max_wosize); Field (Op_hp (mem), 1) = Field (Op_hp (prev), 0) = (value) Op_hp (hp); prev = hp; } if (remain > 1){ Hd_hp (hp) = Make_header (Wosize_bhsize (remain), 0, Caml_blue); #ifdef DEBUG caml_set_fields (Bp_hp (hp), 0, Debug_free_major); #endif Field (Op_hp (mem), 1) = Field (Op_hp (prev), 0) = (value) Op_hp (hp); Field (Op_hp (hp), 0) = (value) NULL; }else{ Field (Op_hp (prev), 0) = (value) NULL; if (remain == 1) Hd_hp (hp) = Make_header (0, 0, Caml_white); } Assert (Wosize_hp (mem) >= request); if (caml_add_to_heap (mem) != 0){ caml_free_for_heap (mem); return NULL; } return Bp_hp (mem); }
/* Allocate more memory from malloc for the heap. Return a blue block of at least the requested size (in words). The caller must insert the block into the free list. The request must be less than or equal to Max_wosize. Return NULL when out of memory. */ static char *expand_heap (mlsize_t request) { char *mem; asize_t malloc_request; malloc_request = caml_round_heap_chunk_size (Bhsize_wosize (request)); mem = caml_alloc_for_heap (malloc_request); if (mem == NULL){ caml_gc_message (0x04, "No room for growing heap\n", 0); return NULL; } Assert (Wosize_bhsize (malloc_request) >= request); Hd_hp (mem) = Make_header (Wosize_bhsize (malloc_request), 0, Caml_blue); if (caml_add_to_heap (mem) != 0){ caml_free_for_heap (mem); return NULL; } return Bp_hp (mem); }
static void ocamlpool_chunk_alloc(void) { ocamlpool_assert(ocamlpool_next_chunk_size > 1); void *block = caml_alloc_for_heap(ocamlpool_next_chunk_size * WORD_SIZE); abort_unless(block != NULL); size_t chunk_size = Chunk_size(block); ocamlpool_assert(IS_WORD_ALIGNED(chunk_size)); ocamlpool_color = caml_allocation_color(block); ocamlpool_allocated_chunks_counter += 1; size_t words = (chunk_size / WORD_SIZE); ocamlpool_root = (value)((value*)block + 1); /* Make it look like a well-formed string */ OCAMLPOOL_SET_HEADER(ocamlpool_root, words - 1, String_tag, ocamlpool_color); caml_add_to_heap(block); caml_allocated_words += words; }