Skip to content

Commit b5dfcd1

Browse files
Manuel Fahndrichfacebook-github-bot
authored andcommitted
Fix pool header block problem
Summary: There seems to be a bug in the pool allocation regarding the header block in the scenario where no words are left (besides the header word). Added a panic in the scenario I believe is broken and where the null terminating word is actually overwriting the header word. In OCaml, any heap block has to be at least 2 words (1 header + one block word). The ocamlpool code needs to change so that when we cannot allocate the next block, there is one word left in the pool (in addition to the reserved header word). That way, the zero terminator can be properly written in the String_tagged header block. Reviewed By: rjbailey Differential Revision: D52574962 fbshipit-source-id: 41795b3900551627e444cf627ad8642745a18434
1 parent 6c3a04c commit b5dfcd1

File tree

1 file changed

+6
-4
lines changed

1 file changed

+6
-4
lines changed

ocamlrep_ocamlpool/ocamlpool.c

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -118,7 +118,8 @@ static void assert_out_of_section(void) {
118118
*/
119119

120120
static void init_cursor(void) {
121-
ocamlpool_limit = (value*)ocamlpool_root;
121+
ocamlpool_limit =
122+
(value*)ocamlpool_root + 1; // Need one word left for header block
122123
ocamlpool_bound = (value*)ocamlpool_root + Wosize_val(ocamlpool_root);
123124
ocamlpool_cursor = ocamlpool_bound;
124125
}
@@ -135,6 +136,7 @@ __attribute__((no_sanitize("undefined"))) static void ocamlpool_chunk_truncate(
135136

136137
OCAMLPOOL_SET_HEADER(ocamlpool_root, word_size, String_tag, ocamlpool_color);
137138
value* first_word = (value*)ocamlpool_root;
139+
abort_unless(word_size > 0, "ocamlpool_truncate 0 words left for terminator");
138140
first_word[word_size - 1] = 0;
139141
}
140142

@@ -253,8 +255,8 @@ value ocamlpool_reserve_block(int tag, size_t words) {
253255
if (pointer < ocamlpool_limit || pointer >= ocamlpool_bound) {
254256
size_t old_ocamlpool_next_chunk_size = ocamlpool_next_chunk_size;
255257
if (size >= ocamlpool_next_chunk_size) {
256-
// Add 1 word for ocaml's header
257-
ocamlpool_next_chunk_size = size + 1;
258+
// Add 2 words for ocaml's header + block
259+
ocamlpool_next_chunk_size = size + 2;
258260
}
259261
ocamlpool_chunk_truncate();
260262
ocamlpool_chunk_alloc();
@@ -276,7 +278,7 @@ value ocamlpool_reserve_string(size_t bytes) {
276278
size_t words =
277279
((bytes + 1 /*null-ending*/ + (WORD_SIZE - 1) /*rounding*/) / WORD_SIZE);
278280
size_t length = (words * WORD_SIZE);
279-
281+
abort_unless(words > 0, "ocamlpool_reserve_string 0 length");
280282
value result = ocamlpool_reserve_block(String_tag, words);
281283

282284
((value*)result)[words - 1] = 0;

0 commit comments

Comments
 (0)