1 /**************************************************************************/
2 /* */
3 /* OCaml */
4 /* */
5 /* Xavier Leroy and Damien Doligez, INRIA Rocquencourt */
6 /* */
7 /* Copyright 1996 Institut National de Recherche en Informatique et */
8 /* en Automatique. */
9 /* */
10 /* All rights reserved. This file is distributed under the terms of */
11 /* the GNU Lesser General Public License version 2.1, with the */
12 /* special exception on linking described in the file LICENSE. */
13 /* */
14 /**************************************************************************/
15
16 #define CAML_INTERNALS
17
18 /* Some runtime initialization functions that are common to bytecode
19 and native code. */
20
21 #include <stdio.h>
22 #include "caml/backtrace.h"
23 #include "caml/memory.h"
24 #include "caml/callback.h"
25 #include "caml/major_gc.h"
26 #ifndef NATIVE_CODE
27 #include "caml/dynlink.h"
28 #endif
29 #include "caml/osdeps.h"
30 #include "caml/startup_aux.h"
31
32
33 #ifdef _WIN32
34 extern void caml_win32_unregister_overflow_detection (void);
35 #endif
36
37 CAMLexport header_t *caml_atom_table = NULL;
38
39 /* Initialize the atom table */
40 void caml_init_atom_table(void)
41 {
42 caml_stat_block b;
43 int i;
44
45 /* PR#9128: We need to give the atom table its own page to make sure
46 it does not share a page with a non-value, which would break code
47 which depend on the correctness of the page table. For example,
48 if the atom table shares a page with bytecode, then functions in
49 the runtime may decide to follow a code pointer in a closure, as
50 if it were a pointer to a value.
51
52 We add 1 padding at the end of the atom table because the atom
53 pointer actually points to the word *following* the corresponding
54 entry in the table (the entry is an empty block *header*).
55 */
56 asize_t request = (256 + 1) * sizeof(header_t);
57 request = (request + Page_size - 1) / Page_size * Page_size;
58 caml_atom_table =
59 caml_stat_alloc_aligned_noexc(request, 0, &b);
60
61 for(i = 0; i < 256; i++) {
62 #ifdef NATIVE_CODE
63 caml_atom_table[i] = Make_header_allocated_here(0, i, Caml_white);
64 #else
65 caml_atom_table[i] = Make_header(0, i, Caml_white);
66 #endif
67 }
68 if (caml_page_table_add(In_static_data,
69 caml_atom_table, caml_atom_table + 256 + 1) != 0) {
70 caml_fatal_error("not enough memory for initial page table");
71 }
72 }
73
74
75 /* Parse the OCAMLRUNPARAM environment variable. */
76
77 uintnat caml_init_percent_free = Percent_free_def;
78 uintnat caml_init_max_percent_free = Max_percent_free_def;
79 uintnat caml_init_minor_heap_wsz = Minor_heap_def;
80 uintnat caml_init_heap_chunk_sz = Heap_chunk_def;
81 uintnat caml_init_heap_wsz = Init_heap_def;
82 uintnat caml_init_max_stack_wsz = Max_stack_def;
83 uintnat caml_init_major_window = Major_window_def;
84 uintnat caml_init_custom_major_ratio = Custom_major_ratio_def;
85 uintnat caml_init_custom_minor_ratio = Custom_minor_ratio_def;
86 uintnat caml_init_custom_minor_max_bsz = Custom_minor_max_bsz_def;
87 extern int caml_parser_trace;
88 uintnat caml_trace_level = 0;
89 int caml_cleanup_on_exit = 0;
90
91
92 static void scanmult (char_os *opt, uintnat *var)
93 {
94 char_os mult = ' ';
95 unsigned int val = 1;
96 sscanf_os (opt, T("=%u%c"), &val, &mult);
97 sscanf_os (opt, T("=0x%x%c"), &val, &mult);
98 switch (mult) {
99 case 'k': *var = (uintnat) val * 1024; break;
100 case 'M': *var = (uintnat) val * (1024 * 1024); break;
101 case 'G': *var = (uintnat) val * (1024 * 1024 * 1024); break;
102 default: *var = (uintnat) val; break;
103 }
104 }
105
106 void caml_parse_ocamlrunparam(void)
107 {
108 char_os *opt = caml_secure_getenv (T("OCAMLRUNPARAM"));
109 uintnat p;
110
111 if (opt == NULL) opt = caml_secure_getenv (T("CAMLRUNPARAM"));
112
113 if (opt != NULL){
114 while (*opt != '\0'){
115 switch (*opt++){
116 case 'a': scanmult (opt, &p); caml_set_allocation_policy ((intnat) p);
117 break;
118 case 'b': scanmult (opt, &p); caml_record_backtrace(Val_bool (p));
119 break;
120 case 'c': scanmult (opt, &p); caml_cleanup_on_exit = (p != 0); break;
121 case 'h': scanmult (opt, &caml_init_heap_wsz); break;
122 case 'H': scanmult (opt, &caml_use_huge_pages); break;
123 case 'i': scanmult (opt, &caml_init_heap_chunk_sz); break;
124 case 'l': scanmult (opt, &caml_init_max_stack_wsz); break;
125 case 'M': scanmult (opt, &caml_init_custom_major_ratio); break;
126 case 'm': scanmult (opt, &caml_init_custom_minor_ratio); break;
127 case 'n': scanmult (opt, &caml_init_custom_minor_max_bsz); break;
128 case 'o': scanmult (opt, &caml_init_percent_free); break;
129 case 'O': scanmult (opt, &caml_init_max_percent_free); break;
130 case 'p': scanmult (opt, &p); caml_parser_trace = (p != 0); break;
131 case 'R': break; /* see stdlib/hashtbl.mli */
132 case 's': scanmult (opt, &caml_init_minor_heap_wsz); break;
133 case 't': scanmult (opt, &caml_trace_level); break;
134 case 'v': scanmult (opt, &caml_verb_gc); break;
135 case 'w': scanmult (opt, &caml_init_major_window); break;
136 case 'W': scanmult (opt, &caml_runtime_warnings); break;
137 }
138 while (*opt != '\0'){
139 if (*opt++ == ',') break;
140 }
141 }
142 }
143 }
144
145
146 /* The number of outstanding calls to caml_startup */
147 static int startup_count = 0;
148
149 /* Has the runtime been shut down already? */
150 static int shutdown_happened = 0;
151
152
153 int caml_startup_aux(int pooling)
154 {
155 if (shutdown_happened == 1)
156 caml_fatal_error("caml_startup was called after the runtime "
157 "was shut down with caml_shutdown");
158
159 /* Second and subsequent calls are ignored,
160 since the runtime has already started */
161 startup_count++;
162 if (startup_count > 1)
163 return 0;
164
165 if (pooling)
166 caml_stat_create_pool();
167
168 return 1;
169 }
170
171 static void call_registered_value(char* name)
172 {
173 const value *f = caml_named_value(name);
174 if (f != NULL)
175 caml_callback_exn(*f, Val_unit);
176 }
177
178 CAMLexport void caml_shutdown(void)
179 {
180 if (startup_count <= 0)
181 caml_fatal_error("a call to caml_shutdown has no "
182 "corresponding call to caml_startup");
183
184 /* Do nothing unless it's the last call remaining */
185 startup_count--;
186 if (startup_count > 0)
187 return;
188
189 call_registered_value("Pervasives.do_at_exit");
190 call_registered_value("Thread.at_shutdown");
191 caml_finalise_heap();
192 caml_free_locale();
193 #ifndef NATIVE_CODE
194 caml_free_shared_libs();
195 #endif
196 caml_stat_destroy_pool();
197 #if defined(_WIN32) && defined(NATIVE_CODE)
198 caml_win32_unregister_overflow_detection();
199 #endif
200
201 shutdown_happened = 1;
202 }
203