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. */
|
|
|
|
/* */
|
|
|
|
/**************************************************************************/
|
1995-08-09 08:06:35 -07:00
|
|
|
|
2016-07-04 10:00:57 -07:00
|
|
|
#define CAML_INTERNALS
|
|
|
|
|
1995-07-10 02:48:27 -07:00
|
|
|
/* Start-up code */
|
|
|
|
|
|
|
|
#include <stdio.h>
|
|
|
|
#include <stdlib.h>
|
2014-12-27 06:41:49 -08:00
|
|
|
#include "caml/callback.h"
|
|
|
|
#include "caml/backtrace.h"
|
|
|
|
#include "caml/custom.h"
|
2020-06-11 01:39:19 -07:00
|
|
|
#include "caml/codefrag.h"
|
2014-12-27 06:41:49 -08:00
|
|
|
#include "caml/debugger.h"
|
2019-06-03 04:56:45 -07:00
|
|
|
#include "caml/domain.h"
|
2019-11-15 04:52:35 -08:00
|
|
|
#include "caml/eventlog.h"
|
2014-12-27 06:41:49 -08:00
|
|
|
#include "caml/fail.h"
|
|
|
|
#include "caml/freelist.h"
|
|
|
|
#include "caml/gc.h"
|
|
|
|
#include "caml/gc_ctrl.h"
|
|
|
|
#include "caml/intext.h"
|
|
|
|
#include "caml/memory.h"
|
|
|
|
#include "caml/misc.h"
|
|
|
|
#include "caml/mlvalues.h"
|
|
|
|
#include "caml/osdeps.h"
|
|
|
|
#include "caml/printexc.h"
|
2016-07-04 10:00:57 -07:00
|
|
|
#include "caml/stack.h"
|
2015-05-04 08:44:40 -07:00
|
|
|
#include "caml/startup_aux.h"
|
2014-12-27 06:41:49 -08:00
|
|
|
#include "caml/sys.h"
|
1996-11-07 05:12:16 -08:00
|
|
|
#ifdef HAS_UI
|
2014-12-27 06:41:49 -08:00
|
|
|
#include "caml/ui.h"
|
1996-11-07 05:12:16 -08:00
|
|
|
#endif
|
1995-07-10 02:48:27 -07:00
|
|
|
|
2004-01-01 08:42:43 -08:00
|
|
|
extern int caml_parser_trace;
|
2020-06-15 05:17:42 -07:00
|
|
|
extern char caml_system__code_begin, caml_system__code_end;
|
1995-07-10 02:48:27 -07:00
|
|
|
|
1997-07-02 11:16:15 -07:00
|
|
|
/* Initialize the atom table and the static data and code area limits. */
|
1996-11-07 02:55:49 -08:00
|
|
|
|
1997-07-02 11:16:15 -07:00
|
|
|
struct segment { char * begin; char * end; };
|
|
|
|
|
2015-05-04 08:44:40 -07:00
|
|
|
static void init_static(void)
|
1995-07-10 02:48:27 -07:00
|
|
|
{
|
1997-07-02 11:16:15 -07:00
|
|
|
extern struct segment caml_data_segments[], caml_code_segments[];
|
2020-09-14 01:16:09 -07:00
|
|
|
|
|
|
|
char * caml_code_area_start, * caml_code_area_end;
|
2008-01-03 01:37:10 -08:00
|
|
|
int i;
|
1996-02-20 02:59:35 -08:00
|
|
|
|
2015-05-04 08:44:40 -07:00
|
|
|
caml_init_atom_table ();
|
2008-01-03 01:37:10 -08:00
|
|
|
|
|
|
|
for (i = 0; caml_data_segments[i].begin != 0; i++) {
|
2012-02-18 08:56:29 -08:00
|
|
|
/* PR#5509: we must include the zero word at end of data segment,
|
|
|
|
because pointers equal to caml_data_segments[i].end are static data. */
|
2008-12-03 10:09:09 -08:00
|
|
|
if (caml_page_table_add(In_static_data,
|
2008-01-03 01:37:10 -08:00
|
|
|
caml_data_segments[i].begin,
|
2012-02-18 08:56:29 -08:00
|
|
|
caml_data_segments[i].end + sizeof(value)) != 0)
|
2018-05-17 06:17:04 -07:00
|
|
|
caml_fatal_error("not enough memory for initial page table");
|
2008-01-03 01:37:10 -08:00
|
|
|
}
|
|
|
|
|
|
|
|
caml_code_area_start = caml_code_segments[0].begin;
|
|
|
|
caml_code_area_end = caml_code_segments[0].end;
|
|
|
|
for (i = 1; caml_code_segments[i].begin != 0; i++) {
|
|
|
|
if (caml_code_segments[i].begin < caml_code_area_start)
|
|
|
|
caml_code_area_start = caml_code_segments[i].begin;
|
|
|
|
if (caml_code_segments[i].end > caml_code_area_end)
|
|
|
|
caml_code_area_end = caml_code_segments[i].end;
|
|
|
|
}
|
2012-03-13 07:50:41 -07:00
|
|
|
/* Register the code in the table of code fragments */
|
2020-06-11 01:39:19 -07:00
|
|
|
caml_register_code_fragment(caml_code_area_start,
|
|
|
|
caml_code_area_end,
|
|
|
|
DIGEST_LATER, NULL);
|
2020-06-15 05:17:42 -07:00
|
|
|
/* Also register the glue code written in assembly */
|
|
|
|
caml_register_code_fragment(&caml_system__code_begin,
|
|
|
|
&caml_system__code_end,
|
|
|
|
DIGEST_IGNORE, NULL);
|
1995-07-10 02:48:27 -07:00
|
|
|
}
|
|
|
|
|
2003-06-16 05:31:14 -07:00
|
|
|
/* These are termination hooks used by the systhreads library */
|
|
|
|
struct longjmp_buffer caml_termination_jmpbuf;
|
|
|
|
void (*caml_termination_hook)(void *) = NULL;
|
|
|
|
|
2019-06-03 04:56:45 -07:00
|
|
|
extern value caml_start_program (caml_domain_state*);
|
2004-01-01 08:42:43 -08:00
|
|
|
extern void caml_init_signals (void);
|
2017-05-09 06:34:56 -07:00
|
|
|
#ifdef _WIN32
|
|
|
|
extern void caml_win32_overflow_detection (void);
|
|
|
|
#endif
|
1996-11-07 02:55:49 -08:00
|
|
|
|
2015-12-30 12:24:10 -08:00
|
|
|
#if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
|
2013-01-17 01:04:53 -08:00
|
|
|
|
|
|
|
/* PR 4887: avoid crash box of windows runtime on some system calls */
|
|
|
|
extern void caml_install_invalid_parameter_handler();
|
|
|
|
|
|
|
|
#endif
|
|
|
|
|
2017-09-21 03:29:03 -07:00
|
|
|
value caml_startup_common(char_os **argv, int pooling)
|
1996-11-07 02:55:49 -08:00
|
|
|
{
|
2017-09-21 03:29:03 -07:00
|
|
|
char_os * exe_name, * proc_self_exe;
|
2010-04-27 00:55:08 -07:00
|
|
|
char tos;
|
1999-02-14 08:48:25 -08:00
|
|
|
|
2019-06-17 22:47:26 -07:00
|
|
|
/* Initialize the domain */
|
|
|
|
caml_init_domain();
|
2016-11-13 14:31:58 -08:00
|
|
|
/* Determine options */
|
|
|
|
#ifdef DEBUG
|
|
|
|
caml_verb_gc = 0x3F;
|
|
|
|
#endif
|
|
|
|
caml_parse_ocamlrunparam();
|
2019-11-15 04:52:35 -08:00
|
|
|
CAML_EVENTLOG_INIT();
|
2016-11-13 14:31:58 -08:00
|
|
|
#ifdef DEBUG
|
2017-02-27 08:32:44 -08:00
|
|
|
caml_gc_message (-1, "### OCaml runtime: debug mode ###\n");
|
2016-11-13 14:31:58 -08:00
|
|
|
#endif
|
|
|
|
if (caml_cleanup_on_exit)
|
|
|
|
pooling = 1;
|
2016-11-13 13:31:36 -08:00
|
|
|
if (!caml_startup_aux(pooling))
|
2015-06-19 07:53:38 -07:00
|
|
|
return Val_unit;
|
2014-05-29 10:39:47 -07:00
|
|
|
|
2015-07-26 12:01:47 -07:00
|
|
|
caml_init_frame_descriptors();
|
2017-05-28 14:56:50 -07:00
|
|
|
caml_init_locale();
|
2015-12-30 12:24:10 -08:00
|
|
|
#if defined(_MSC_VER) && __STDC_SECURE_LIB__ >= 200411L
|
2013-01-17 01:04:53 -08:00
|
|
|
caml_install_invalid_parameter_handler();
|
|
|
|
#endif
|
2004-01-01 08:42:43 -08:00
|
|
|
caml_init_custom_operations();
|
2019-06-07 04:38:45 -07:00
|
|
|
Caml_state->top_of_stack = &tos;
|
2015-05-04 08:44:40 -07:00
|
|
|
caml_init_gc (caml_init_minor_heap_wsz, caml_init_heap_wsz,
|
|
|
|
caml_init_heap_chunk_sz, caml_init_percent_free,
|
2018-11-06 04:42:48 -08:00
|
|
|
caml_init_max_percent_free, caml_init_major_window,
|
|
|
|
caml_init_custom_major_ratio, caml_init_custom_minor_ratio,
|
|
|
|
caml_init_custom_minor_max_bsz);
|
2015-05-04 08:44:40 -07:00
|
|
|
init_static();
|
2004-01-01 08:42:43 -08:00
|
|
|
caml_init_signals();
|
2017-05-09 06:34:56 -07:00
|
|
|
#ifdef _WIN32
|
|
|
|
caml_win32_overflow_detection();
|
|
|
|
#endif
|
2015-08-21 23:04:22 -07:00
|
|
|
caml_init_backtrace();
|
2010-04-22 08:41:16 -07:00
|
|
|
caml_debugger_init (); /* force debugger.o stub to be linked */
|
2002-02-11 05:51:40 -08:00
|
|
|
exe_name = argv[0];
|
2019-04-14 00:13:24 -07:00
|
|
|
if (exe_name == NULL) exe_name = T("");
|
2016-09-04 23:49:25 -07:00
|
|
|
proc_self_exe = caml_executable_name();
|
|
|
|
if (proc_self_exe != NULL)
|
2002-02-11 05:51:40 -08:00
|
|
|
exe_name = proc_self_exe;
|
2005-03-24 09:20:54 -08:00
|
|
|
else
|
|
|
|
exe_name = caml_search_exe_in_path(exe_name);
|
2003-12-16 10:09:44 -08:00
|
|
|
caml_sys_init(exe_name, argv);
|
2003-06-16 05:31:14 -07:00
|
|
|
if (sigsetjmp(caml_termination_jmpbuf.buf, 0)) {
|
|
|
|
if (caml_termination_hook != NULL) caml_termination_hook(NULL);
|
2017-02-21 02:49:12 -08:00
|
|
|
return Val_unit;
|
2003-06-16 05:31:14 -07:00
|
|
|
}
|
2019-06-03 04:56:45 -07:00
|
|
|
return caml_start_program(Caml_state);
|
1995-07-10 02:48:27 -07:00
|
|
|
}
|
|
|
|
|
2017-09-21 03:29:03 -07:00
|
|
|
value caml_startup_exn(char_os **argv)
|
2016-11-13 13:31:36 -08:00
|
|
|
{
|
|
|
|
return caml_startup_common(argv, /* pooling */ 0);
|
|
|
|
}
|
|
|
|
|
2017-09-21 03:29:03 -07:00
|
|
|
void caml_startup(char_os **argv)
|
1996-11-07 02:55:49 -08:00
|
|
|
{
|
2017-02-21 02:49:12 -08:00
|
|
|
value res = caml_startup_exn(argv);
|
2016-11-13 13:31:36 -08:00
|
|
|
if (Is_exception_result(res))
|
2017-02-21 02:49:12 -08:00
|
|
|
caml_fatal_uncaught_exception(Extract_exception(res));
|
|
|
|
}
|
|
|
|
|
2017-09-21 03:29:03 -07:00
|
|
|
void caml_main(char_os **argv)
|
2017-02-21 02:49:12 -08:00
|
|
|
{
|
|
|
|
caml_startup(argv);
|
1996-11-07 02:55:49 -08:00
|
|
|
}
|
2016-11-13 13:31:36 -08:00
|
|
|
|
2017-09-21 03:29:03 -07:00
|
|
|
value caml_startup_pooled_exn(char_os **argv)
|
2016-11-13 13:31:36 -08:00
|
|
|
{
|
|
|
|
return caml_startup_common(argv, /* pooling */ 1);
|
|
|
|
}
|
|
|
|
|
2017-09-21 03:29:03 -07:00
|
|
|
void caml_startup_pooled(char_os **argv)
|
2016-11-13 13:31:36 -08:00
|
|
|
{
|
|
|
|
value res = caml_startup_pooled_exn(argv);
|
|
|
|
if (Is_exception_result(res))
|
|
|
|
caml_fatal_uncaught_exception(Extract_exception(res));
|
|
|
|
}
|