2016-02-18 07:11:59 -08:00
|
|
|
/**************************************************************************/
|
|
|
|
/* */
|
|
|
|
/* OCaml */
|
|
|
|
/* */
|
|
|
|
/* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */
|
|
|
|
/* */
|
|
|
|
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
|
|
|
/* en Automatique. */
|
|
|
|
/* */
|
|
|
|
/* All rights reserved. This file is distributed under the terms of */
|
|
|
|
/* the GNU Lesser General Public License version 2.1, with the */
|
|
|
|
/* special exception on linking described in the file LICENSE. */
|
|
|
|
/* */
|
|
|
|
/**************************************************************************/
|
2015-05-04 08:44:40 -07:00
|
|
|
|
2016-07-04 10:00:57 -07:00
|
|
|
#define CAML_INTERNALS
|
|
|
|
|
2015-05-04 08:44:40 -07:00
|
|
|
/* Some runtime initialization functions that are common to bytecode
|
|
|
|
and native code. */
|
|
|
|
|
|
|
|
#include <stdio.h>
|
|
|
|
#include "caml/backtrace.h"
|
|
|
|
#include "caml/memory.h"
|
2015-11-29 10:26:18 -08:00
|
|
|
#include "caml/callback.h"
|
2014-05-29 13:19:13 -07:00
|
|
|
#include "caml/major_gc.h"
|
2014-05-30 17:14:04 -07:00
|
|
|
#ifndef NATIVE_CODE
|
|
|
|
#include "caml/dynlink.h"
|
|
|
|
#endif
|
2017-06-23 08:32:50 -07:00
|
|
|
#include "caml/osdeps.h"
|
2015-11-29 10:26:18 -08:00
|
|
|
#include "caml/startup_aux.h"
|
2015-05-04 08:44:40 -07:00
|
|
|
|
|
|
|
|
2019-10-10 05:19:30 -07:00
|
|
|
#ifdef _WIN32
|
|
|
|
extern void caml_win32_unregister_overflow_detection (void);
|
|
|
|
#endif
|
|
|
|
|
2019-11-19 14:41:50 -08:00
|
|
|
CAMLexport header_t *caml_atom_table = NULL;
|
2015-05-04 08:44:40 -07:00
|
|
|
|
2019-11-19 14:41:50 -08:00
|
|
|
/* Initialize the atom table */
|
2015-05-04 08:44:40 -07:00
|
|
|
void caml_init_atom_table(void)
|
|
|
|
{
|
2019-11-19 14:41:50 -08:00
|
|
|
caml_stat_block b;
|
2015-05-04 08:44:40 -07:00
|
|
|
int i;
|
2019-11-19 14:41:50 -08:00
|
|
|
|
|
|
|
/* PR#9128: We need to give the atom table its own page to make sure
|
|
|
|
it does not share a page with a non-value, which would break code
|
|
|
|
which depend on the correctness of the page table. For example,
|
|
|
|
if the atom table shares a page with bytecode, then functions in
|
|
|
|
the runtime may decide to follow a code pointer in a closure, as
|
|
|
|
if it were a pointer to a value.
|
|
|
|
|
|
|
|
We add 1 padding at the end of the atom table because the atom
|
|
|
|
pointer actually points to the word *following* the corresponding
|
|
|
|
entry in the table (the entry is an empty block *header*).
|
|
|
|
*/
|
|
|
|
asize_t request = (256 + 1) * sizeof(header_t);
|
|
|
|
request = (request + Page_size - 1) / Page_size * Page_size;
|
|
|
|
caml_atom_table =
|
|
|
|
caml_stat_alloc_aligned_noexc(request, 0, &b);
|
|
|
|
|
2016-07-29 07:07:10 -07:00
|
|
|
for(i = 0; i < 256; i++) {
|
2020-05-29 07:26:55 -07:00
|
|
|
caml_atom_table[i] = Make_header(0, i, Caml_black);
|
2016-07-29 07:07:10 -07:00
|
|
|
}
|
2015-05-04 08:44:40 -07:00
|
|
|
if (caml_page_table_add(In_static_data,
|
2019-11-19 14:41:50 -08:00
|
|
|
caml_atom_table, caml_atom_table + 256 + 1) != 0) {
|
2018-05-17 06:17:04 -07:00
|
|
|
caml_fatal_error("not enough memory for initial page table");
|
2015-05-04 08:44:40 -07:00
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
/* Parse the OCAMLRUNPARAM environment variable. */
|
|
|
|
|
|
|
|
uintnat caml_init_percent_free = Percent_free_def;
|
|
|
|
uintnat caml_init_max_percent_free = Max_percent_free_def;
|
|
|
|
uintnat caml_init_minor_heap_wsz = Minor_heap_def;
|
|
|
|
uintnat caml_init_heap_chunk_sz = Heap_chunk_def;
|
|
|
|
uintnat caml_init_heap_wsz = Init_heap_def;
|
|
|
|
uintnat caml_init_max_stack_wsz = Max_stack_def;
|
2015-11-20 08:54:26 -08:00
|
|
|
uintnat caml_init_major_window = Major_window_def;
|
2018-11-06 04:42:48 -08:00
|
|
|
uintnat caml_init_custom_major_ratio = Custom_major_ratio_def;
|
|
|
|
uintnat caml_init_custom_minor_ratio = Custom_minor_ratio_def;
|
|
|
|
uintnat caml_init_custom_minor_max_bsz = Custom_minor_max_bsz_def;
|
2015-05-04 08:44:40 -07:00
|
|
|
extern int caml_parser_trace;
|
|
|
|
uintnat caml_trace_level = 0;
|
Cleaning up the C code (#1812)
Running Clang 6.0 and GCC 8 with full warnings on suggests a few simple improvements and clean-ups to the C code of OCaml. This commit implements them.
* Remove old-style, unprototyped function declarations
It's `int f(void)`, not `int f()`. [-Wstrict-prototypes]
* Be more explicit about conversions involving `float` and `double`
byterun/bigarray.c, byterun/ints.c:
add explicit casts to clarify the intent
renamed float field of conversion union from `d` to `f`.
byterun/compact.c, byterun/gc_ctrl.c:
some local variables were of type `float` while all FP computations
here are done in double precision;
turned these variables into `double`.
[-Wdouble-promotion -Wfloat-conversion]
*Add explicit initialization of struct field `compare_ext`
[-Wmissing-field-initializers]
* Declare more functions "noreturn"
[-Wmissing-noreturn]
* Make CAMLassert compliant with ISO C
In `e1 ? e2 : e3`, expressions `e2` and `e3` must have the same type.
`e2` of type `void` and `e3` of type `int`, as in the original code,
is a GNU extension.
* Remove or conditionalize unused macros
Some macros were defined and never used.
Some other macros were always defined but conditionally used.
[-Wunused-macros]
* Replace some uses of `int` by more appropriate types like `intnat`
On a 64-bit platform, `int` is only 32 bits and may not represent correctly
the length of a string or the size of an OCaml heap block.
This commit replaces a number of uses of `int` by other types that
are 64-bit wide on 64-bit architectures, such as `intnat` or `uintnat`
or `size_t` or `mlsize_t`.
Sometimes an `intnat` was used as an `int` and is intended as a Boolean
(0 or 1); then it was replaced by an `int`.
There are many remaining cases where we assign a 64-bit quantity to a
32-bit `int` variable. Either I believe these cases are safe
(e.g. the 64-bit quantity is the difference between two pointers
within an I/O buffer, something that always fits in 32 bits), or
the code change was not obvious and too risky.
[-Wshorten-64-to-32]
* Put `inline` before return type
`static inline void f(void)` is cleaner than `static void inline f(void)`.
[-Wold-style-declaration]
* Unused assignment to unused parameter
Looks very useless. [-Wunused-but-set-parameter]
2018-06-07 03:55:09 -07:00
|
|
|
int caml_cleanup_on_exit = 0;
|
2015-05-04 08:44:40 -07:00
|
|
|
|
|
|
|
|
2017-09-21 03:29:03 -07:00
|
|
|
static void scanmult (char_os *opt, uintnat *var)
|
2015-05-04 08:44:40 -07:00
|
|
|
{
|
2019-04-14 00:13:24 -07:00
|
|
|
char_os mult = ' ';
|
2015-05-04 08:44:40 -07:00
|
|
|
unsigned int val = 1;
|
2019-04-14 00:13:24 -07:00
|
|
|
sscanf_os (opt, T("=%u%c"), &val, &mult);
|
|
|
|
sscanf_os (opt, T("=0x%x%c"), &val, &mult);
|
2015-05-04 08:44:40 -07:00
|
|
|
switch (mult) {
|
2019-04-14 00:13:24 -07:00
|
|
|
case 'k': *var = (uintnat) val * 1024; break;
|
|
|
|
case 'M': *var = (uintnat) val * (1024 * 1024); break;
|
|
|
|
case 'G': *var = (uintnat) val * (1024 * 1024 * 1024); break;
|
2015-05-04 08:44:40 -07:00
|
|
|
default: *var = (uintnat) val; break;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
|
|
|
|
void caml_parse_ocamlrunparam(void)
|
|
|
|
{
|
2019-04-14 00:13:24 -07:00
|
|
|
char_os *opt = caml_secure_getenv (T("OCAMLRUNPARAM"));
|
2015-05-04 08:44:40 -07:00
|
|
|
uintnat p;
|
|
|
|
|
2019-04-14 00:13:24 -07:00
|
|
|
if (opt == NULL) opt = caml_secure_getenv (T("CAMLRUNPARAM"));
|
2015-05-04 08:44:40 -07:00
|
|
|
|
|
|
|
if (opt != NULL){
|
2019-04-14 00:13:24 -07:00
|
|
|
while (*opt != '\0'){
|
2015-05-04 08:44:40 -07:00
|
|
|
switch (*opt++){
|
2019-10-15 04:52:16 -07:00
|
|
|
case 'a': scanmult (opt, &p); caml_set_allocation_policy ((intnat) p);
|
|
|
|
break;
|
2018-12-11 01:17:04 -08:00
|
|
|
case 'b': scanmult (opt, &p); caml_record_backtrace(Val_int (p));
|
2019-10-15 04:52:16 -07:00
|
|
|
break;
|
2019-04-14 00:13:24 -07:00
|
|
|
case 'c': scanmult (opt, &p); caml_cleanup_on_exit = (p != 0); break;
|
|
|
|
case 'h': scanmult (opt, &caml_init_heap_wsz); break;
|
|
|
|
case 'H': scanmult (opt, &caml_use_huge_pages); break;
|
|
|
|
case 'i': scanmult (opt, &caml_init_heap_chunk_sz); break;
|
|
|
|
case 'l': scanmult (opt, &caml_init_max_stack_wsz); break;
|
|
|
|
case 'M': scanmult (opt, &caml_init_custom_major_ratio); break;
|
|
|
|
case 'm': scanmult (opt, &caml_init_custom_minor_ratio); break;
|
|
|
|
case 'n': scanmult (opt, &caml_init_custom_minor_max_bsz); break;
|
|
|
|
case 'o': scanmult (opt, &caml_init_percent_free); break;
|
|
|
|
case 'O': scanmult (opt, &caml_init_max_percent_free); break;
|
|
|
|
case 'p': scanmult (opt, &p); caml_parser_trace = (p != 0); break;
|
|
|
|
case 'R': break; /* see stdlib/hashtbl.mli */
|
|
|
|
case 's': scanmult (opt, &caml_init_minor_heap_wsz); break;
|
|
|
|
case 't': scanmult (opt, &caml_trace_level); break;
|
|
|
|
case 'v': scanmult (opt, &caml_verb_gc); break;
|
|
|
|
case 'w': scanmult (opt, &caml_init_major_window); break;
|
|
|
|
case 'W': scanmult (opt, &caml_runtime_warnings); break;
|
2020-06-03 23:35:48 -07:00
|
|
|
case ',': continue;
|
2015-05-04 08:44:40 -07:00
|
|
|
}
|
2019-04-14 00:13:24 -07:00
|
|
|
while (*opt != '\0'){
|
2015-05-04 08:44:40 -07:00
|
|
|
if (*opt++ == ',') break;
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
|
|
|
}
|
2014-05-29 11:47:18 -07:00
|
|
|
|
2015-06-19 07:53:38 -07:00
|
|
|
|
|
|
|
/* The number of outstanding calls to caml_startup */
|
|
|
|
static int startup_count = 0;
|
|
|
|
|
|
|
|
/* Has the runtime been shut down already? */
|
|
|
|
static int shutdown_happened = 0;
|
|
|
|
|
|
|
|
|
2016-11-13 13:31:36 -08:00
|
|
|
int caml_startup_aux(int pooling)
|
2015-06-19 07:53:38 -07:00
|
|
|
{
|
|
|
|
if (shutdown_happened == 1)
|
2018-05-17 06:17:04 -07:00
|
|
|
caml_fatal_error("caml_startup was called after the runtime "
|
2015-06-19 07:53:38 -07:00
|
|
|
"was shut down with caml_shutdown");
|
|
|
|
|
|
|
|
/* Second and subsequent calls are ignored,
|
|
|
|
since the runtime has already started */
|
|
|
|
startup_count++;
|
|
|
|
if (startup_count > 1)
|
|
|
|
return 0;
|
|
|
|
|
2016-11-13 13:31:36 -08:00
|
|
|
if (pooling)
|
|
|
|
caml_stat_create_pool();
|
2015-06-19 07:53:38 -07:00
|
|
|
|
|
|
|
return 1;
|
|
|
|
}
|
|
|
|
|
2017-07-30 07:41:42 -07:00
|
|
|
static void call_registered_value(char* name)
|
2015-11-29 10:26:18 -08:00
|
|
|
{
|
2019-03-06 01:00:38 -08:00
|
|
|
const value *f = caml_named_value(name);
|
2017-07-30 07:41:42 -07:00
|
|
|
if (f != NULL)
|
|
|
|
caml_callback_exn(*f, Val_unit);
|
2015-11-29 10:26:18 -08:00
|
|
|
}
|
|
|
|
|
2014-05-29 11:47:18 -07:00
|
|
|
CAMLexport void caml_shutdown(void)
|
|
|
|
{
|
2015-06-19 07:53:38 -07:00
|
|
|
if (startup_count <= 0)
|
2018-05-17 06:17:04 -07:00
|
|
|
caml_fatal_error("a call to caml_shutdown has no "
|
2015-06-19 07:53:38 -07:00
|
|
|
"corresponding call to caml_startup");
|
|
|
|
|
|
|
|
/* Do nothing unless it's the last call remaining */
|
|
|
|
startup_count--;
|
|
|
|
if (startup_count > 0)
|
|
|
|
return;
|
|
|
|
|
2017-07-30 07:41:42 -07:00
|
|
|
call_registered_value("Pervasives.do_at_exit");
|
|
|
|
call_registered_value("Thread.at_shutdown");
|
2014-05-29 13:19:13 -07:00
|
|
|
caml_finalise_heap();
|
2017-05-28 14:56:50 -07:00
|
|
|
caml_free_locale();
|
2014-05-30 17:14:04 -07:00
|
|
|
#ifndef NATIVE_CODE
|
|
|
|
caml_free_shared_libs();
|
|
|
|
#endif
|
2014-05-29 11:47:18 -07:00
|
|
|
caml_stat_destroy_pool();
|
2019-10-10 05:19:30 -07:00
|
|
|
#if defined(_WIN32) && defined(NATIVE_CODE)
|
|
|
|
caml_win32_unregister_overflow_detection();
|
|
|
|
#endif
|
2015-06-19 07:53:38 -07:00
|
|
|
|
|
|
|
shutdown_happened = 1;
|
2014-05-29 11:47:18 -07:00
|
|
|
}
|