diff options
Diffstat (limited to 'ocaml-binary-annot/byterun/startup.c')
| -rw-r--r-- | ocaml-binary-annot/byterun/startup.c | 505 |
1 files changed, 505 insertions, 0 deletions
diff --git a/ocaml-binary-annot/byterun/startup.c b/ocaml-binary-annot/byterun/startup.c new file mode 100644 index 0000000000..b69c04f220 --- /dev/null +++ b/ocaml-binary-annot/byterun/startup.c @@ -0,0 +1,505 @@ +/***********************************************************************/ +/* */ +/* Objective Caml */ +/* */ +/* 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 Library General Public License, with */ +/* the special exception on linking described in file ../LICENSE. */ +/* */ +/***********************************************************************/ + +/* $Id$ */ + +/* Start-up code */ + +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <fcntl.h> +#include "config.h" +#ifdef HAS_UNISTD +#include <unistd.h> +#endif +#ifdef _WIN32 +#include <process.h> +#endif +#include "alloc.h" +#include "backtrace.h" +#include "callback.h" +#include "custom.h" +#include "debugger.h" +#include "dynlink.h" +#include "exec.h" +#include "fail.h" +#include "fix_code.h" +#include "freelist.h" +#include "gc_ctrl.h" +#include "instrtrace.h" +#include "interp.h" +#include "intext.h" +#include "io.h" +#include "memory.h" +#include "minor_gc.h" +#include "misc.h" +#include "mlvalues.h" +#include "osdeps.h" +#include "prims.h" +#include "printexc.h" +#include "reverse.h" +#include "signals.h" +#include "stacks.h" +#include "sys.h" +#include "startup.h" +#include "version.h" + +#ifndef O_BINARY +#define O_BINARY 0 +#endif + +#ifndef SEEK_END +#define SEEK_END 2 +#endif + +extern int caml_parser_trace; + +CAMLexport header_t caml_atom_table[256]; + +/* Initialize the atom table */ + +static void init_atoms(void) +{ + int i; + for(i = 0; i < 256; i++) caml_atom_table[i] = Make_header(0, i, Caml_white); + if (caml_page_table_add(In_static_data, + caml_atom_table, caml_atom_table + 256) != 0) { + caml_fatal_error("Fatal error: not enough memory for the initial page table"); + } +} + +/* Read the trailer of a bytecode file */ + +static void fixup_endianness_trailer(uint32 * p) +{ +#ifndef ARCH_BIG_ENDIAN + Reverse_32(p, p); +#endif +} + +static int read_trailer(int fd, struct exec_trailer *trail) +{ + lseek(fd, (long) -TRAILER_SIZE, SEEK_END); + if (read(fd, (char *) trail, TRAILER_SIZE) < TRAILER_SIZE) + return BAD_BYTECODE; + fixup_endianness_trailer(&trail->num_sections); + if (strncmp(trail->magic, EXEC_MAGIC, 12) == 0) + return 0; + else + return BAD_BYTECODE; +} + +int caml_attempt_open(char **name, struct exec_trailer *trail, + int do_open_script) +{ + char * truename; + int fd; + int err; + char buf [2]; + + truename = caml_search_exe_in_path(*name); + *name = truename; + caml_gc_message(0x100, "Opening bytecode executable %s\n", + (uintnat) truename); + fd = open(truename, O_RDONLY | O_BINARY); + if (fd == -1) { + caml_gc_message(0x100, "Cannot open file\n", 0); + return FILE_NOT_FOUND; + } + if (!do_open_script) { + err = read (fd, buf, 2); + if (err < 2 || (buf [0] == '#' && buf [1] == '!')) { + close(fd); + caml_gc_message(0x100, "Rejected #! script\n", 0); + return BAD_BYTECODE; + } + } + err = read_trailer(fd, trail); + if (err != 0) { + close(fd); + caml_gc_message(0x100, "Not a bytecode executable\n", 0); + return err; + } + return fd; +} + +/* Read the section descriptors */ + +void caml_read_section_descriptors(int fd, struct exec_trailer *trail) +{ + int toc_size, i; + + toc_size = trail->num_sections * 8; + trail->section = caml_stat_alloc(toc_size); + lseek(fd, - (long) (TRAILER_SIZE + toc_size), SEEK_END); + if (read(fd, (char *) trail->section, toc_size) != toc_size) + caml_fatal_error("Fatal error: cannot read section table\n"); + /* Fixup endianness of lengths */ + for (i = 0; i < trail->num_sections; i++) + fixup_endianness_trailer(&(trail->section[i].len)); +} + +/* Position fd at the beginning of the section having the given name. + Return the length of the section data in bytes, or -1 if no section + found with that name. */ + +int32 caml_seek_optional_section(int fd, struct exec_trailer *trail, char *name) +{ + long ofs; + int i; + + ofs = TRAILER_SIZE + trail->num_sections * 8; + for (i = trail->num_sections - 1; i >= 0; i--) { + ofs += trail->section[i].len; + if (strncmp(trail->section[i].name, name, 4) == 0) { + lseek(fd, -ofs, SEEK_END); + return trail->section[i].len; + } + } + return -1; +} + +/* Position fd at the beginning of the section having the given name. + Return the length of the section data in bytes. */ + +int32 caml_seek_section(int fd, struct exec_trailer *trail, char *name) +{ + int32 len = caml_seek_optional_section(fd, trail, name); + if (len == -1) + caml_fatal_error_arg("Fatal_error: section `%s' is missing\n", name); + return len; +} + +/* Read and return the contents of the section having the given name. + Add a terminating 0. Return NULL if no such section. */ + +static char * read_section(int fd, struct exec_trailer *trail, char *name) +{ + int32 len; + char * data; + + len = caml_seek_optional_section(fd, trail, name); + if (len == -1) return NULL; + data = caml_stat_alloc(len + 1); + if (read(fd, data, len) != len) + caml_fatal_error_arg("Fatal error: error reading section %s\n", name); + data[len] = 0; + return data; +} + +/* Invocation of ocamlrun: 4 cases. + + 1. runtime + bytecode + user types: ocamlrun [options] bytecode args... + arguments: ocamlrun [options] bytecode args... + + 2. bytecode script + user types: bytecode args... + 2a (kernel 1) arguments: ocamlrun ./bytecode args... + 2b (kernel 2) arguments: bytecode bytecode args... + + 3. concatenated runtime and bytecode + user types: composite args... + arguments: composite args... + +Algorithm: + 1- If argument 0 is a valid byte-code file that does not start with #!, + then we are in case 3 and we pass the same command line to the + Objective Caml program. + 2- In all other cases, we parse the command line as: + (whatever) [options] bytecode args... + and we strip "(whatever) [options]" from the command line. + +*/ + +/* Configuration parameters and flags */ + +static uintnat percent_free_init = Percent_free_def; +static uintnat max_percent_free_init = Max_percent_free_def; +static uintnat minor_heap_init = Minor_heap_def; +static uintnat heap_chunk_init = Heap_chunk_def; +static uintnat heap_size_init = Init_heap_def; +static uintnat max_stack_init = Max_stack_def; + +/* Parse options on the command line */ + +static int parse_command_line(char **argv) +{ + int i, j; + + for(i = 1; argv[i] != NULL && argv[i][0] == '-'; i++) { + switch(argv[i][1]) { +#ifdef DEBUG + case 't': + caml_trace_flag++; + break; +#endif + case 'v': + if (!strcmp (argv[i], "-version")){ + printf ("The Objective Caml runtime, version " OCAML_VERSION "\n"); + exit (0); + }else if (!strcmp (argv[i], "-vnum")){ + printf (OCAML_VERSION "\n"); + exit (0); + }else{ + caml_verb_gc = 0x001+0x004+0x008+0x010+0x020; + } + break; + case 'p': + for (j = 0; caml_names_of_builtin_cprim[j] != NULL; j++) + printf("%s\n", caml_names_of_builtin_cprim[j]); + exit(0); + break; + case 'b': + caml_record_backtrace(Val_true); + break; + case 'I': + if (argv[i + 1] != NULL) { + caml_ext_table_add(&caml_shared_libs_path, argv[i + 1]); + i++; + } + break; + default: + caml_fatal_error_arg("Unknown option %s.\n", argv[i]); + } + } + return i; +} + +/* Parse the OCAMLRUNPARAM variable */ +/* The option letter for each runtime option is the first letter of the + last word of the ML name of the option (see [stdlib/gc.mli]). + Except for l (maximum stack size) and h (initial heap size). +*/ + +/* If you change these functions, see also their copy in asmrun/startup.c */ + +static void scanmult (char *opt, uintnat *var) +{ + char mult = ' '; + int val; + sscanf (opt, "=%u%c", &val, &mult); + sscanf (opt, "=0x%x%c", &val, &mult); + switch (mult) { + case 'k': *var = (uintnat) val * 1024; break; + case 'M': *var = (uintnat) val * 1024 * 1024; break; + case 'G': *var = (uintnat) val * 1024 * 1024 * 1024; break; + default: *var = (uintnat) val; break; + } +} + +static void parse_camlrunparam(void) +{ + char *opt = getenv ("OCAMLRUNPARAM"); + uintnat p; + + if (opt == NULL) opt = getenv ("CAMLRUNPARAM"); + + if (opt != NULL){ + while (*opt != '\0'){ + switch (*opt++){ + case 's': scanmult (opt, &minor_heap_init); break; + case 'i': scanmult (opt, &heap_chunk_init); break; + case 'h': scanmult (opt, &heap_size_init); break; + case 'l': scanmult (opt, &max_stack_init); break; + case 'o': scanmult (opt, &percent_free_init); break; + case 'O': scanmult (opt, &max_percent_free_init); break; + case 'v': scanmult (opt, &caml_verb_gc); break; + case 'b': caml_record_backtrace(Val_true); break; + case 'p': caml_parser_trace = 1; break; + case 'a': scanmult (opt, &p); caml_set_allocation_policy (p); break; + } + } + } +} + +extern void caml_init_ieee_floats (void); + +#ifdef _WIN32 +extern void caml_signal_thread(void * lpParam); +#endif + +/* Main entry point when loading code from a file */ + +CAMLexport void caml_main(char **argv) +{ + int fd, pos; + struct exec_trailer trail; + struct channel * chan; + value res; + char * shared_lib_path, * shared_libs, * req_prims; + char * exe_name; +#ifdef __linux__ + static char proc_self_exe[256]; +#endif + + /* Machine-dependent initialization of the floating-point hardware + so that it behaves as much as possible as specified in IEEE */ + caml_init_ieee_floats(); + caml_init_custom_operations(); + caml_ext_table_init(&caml_shared_libs_path, 8); + caml_external_raise = NULL; + /* Determine options and position of bytecode file */ +#ifdef DEBUG + caml_verb_gc = 0xBF; +#endif + parse_camlrunparam(); + pos = 0; + exe_name = argv[0]; +#ifdef __linux__ + if (caml_executable_name(proc_self_exe, sizeof(proc_self_exe)) == 0) + exe_name = proc_self_exe; +#endif + fd = caml_attempt_open(&exe_name, &trail, 0); + if (fd < 0) { + pos = parse_command_line(argv); + if (argv[pos] == 0) + caml_fatal_error("No bytecode file specified.\n"); + exe_name = argv[pos]; + fd = caml_attempt_open(&exe_name, &trail, 1); + switch(fd) { + case FILE_NOT_FOUND: + caml_fatal_error_arg("Fatal error: cannot find file %s\n", argv[pos]); + break; + case BAD_BYTECODE: + caml_fatal_error_arg( + "Fatal error: the file %s is not a bytecode executable file\n", + argv[pos]); + break; + } + } + /* Read the table of contents (section descriptors) */ + caml_read_section_descriptors(fd, &trail); + /* Initialize the abstract machine */ + caml_init_gc (minor_heap_init, heap_size_init, heap_chunk_init, + percent_free_init, max_percent_free_init); + caml_init_stack (max_stack_init); + init_atoms(); + /* Initialize the interpreter */ + caml_interprete(NULL, 0); + /* Initialize the debugger, if needed */ + caml_debugger_init(); + /* Load the code */ + caml_code_size = caml_seek_section(fd, &trail, "CODE"); + caml_load_code(fd, caml_code_size); + /* Build the table of primitives */ + shared_lib_path = read_section(fd, &trail, "DLPT"); + shared_libs = read_section(fd, &trail, "DLLS"); + req_prims = read_section(fd, &trail, "PRIM"); + if (req_prims == NULL) caml_fatal_error("Fatal error: no PRIM section\n"); + caml_build_primitive_table(shared_lib_path, shared_libs, req_prims); + caml_stat_free(shared_lib_path); + caml_stat_free(shared_libs); + caml_stat_free(req_prims); + /* Load the globals */ + caml_seek_section(fd, &trail, "DATA"); + chan = caml_open_descriptor_in(fd); + caml_global_data = caml_input_val(chan); + caml_close_channel(chan); /* this also closes fd */ + caml_stat_free(trail.section); + /* Ensure that the globals are in the major heap. */ + caml_oldify_one (caml_global_data, &caml_global_data); + caml_oldify_mopup (); + /* Initialize system libraries */ + caml_init_exceptions(); + caml_sys_init(exe_name, argv + pos); +#ifdef _WIN32 + /* Start a thread to handle signals */ + if (getenv("CAMLSIGPIPE")) + _beginthread(caml_signal_thread, 4096, NULL); +#endif + /* Execute the program */ + caml_debugger(PROGRAM_START); + res = caml_interprete(caml_start_code, caml_code_size); + if (Is_exception_result(res)) { + caml_exn_bucket = Extract_exception(res); + if (caml_debugger_in_use) { + caml_extern_sp = &caml_exn_bucket; /* The debugger needs the + exception value.*/ + caml_debugger(UNCAUGHT_EXC); + } + caml_fatal_uncaught_exception(caml_exn_bucket); + } +} + +/* Main entry point when code is linked in as initialized data */ + +CAMLexport void caml_startup_code( + code_t code, asize_t code_size, + char *data, asize_t data_size, + char *section_table, asize_t section_table_size, + char **argv) +{ + value res; + char* cds_file; + + caml_init_ieee_floats(); + caml_init_custom_operations(); +#ifdef DEBUG + caml_verb_gc = 63; +#endif + cds_file = getenv("CAML_DEBUG_FILE"); + if (cds_file != NULL) { + caml_cds_file = caml_stat_alloc(strlen(cds_file) + 1); + strcpy(caml_cds_file, cds_file); + } + parse_camlrunparam(); + caml_external_raise = NULL; + /* Initialize the abstract machine */ + caml_init_gc (minor_heap_init, heap_size_init, heap_chunk_init, + percent_free_init, max_percent_free_init); + caml_init_stack (max_stack_init); + init_atoms(); + /* Initialize the interpreter */ + caml_interprete(NULL, 0); + /* Initialize the debugger, if needed */ + caml_debugger_init(); + /* Load the code */ + caml_start_code = code; + caml_code_size = code_size; + if (caml_debugger_in_use) { + int len, i; + len = code_size / sizeof(opcode_t); + caml_saved_code = (unsigned char *) caml_stat_alloc(len); + for (i = 0; i < len; i++) caml_saved_code[i] = caml_start_code[i]; + } +#ifdef THREADED_CODE + caml_thread_code(caml_start_code, code_size); +#endif + /* Use the builtin table of primitives */ + caml_build_primitive_table_builtin(); + /* Load the globals */ + caml_global_data = caml_input_value_from_block(data, data_size); + /* Ensure that the globals are in the major heap. */ + caml_oldify_one (caml_global_data, &caml_global_data); + caml_oldify_mopup (); + /* Record the sections (for caml_get_section_table in meta.c) */ + caml_section_table = section_table; + caml_section_table_size = section_table_size; + /* Initialize system libraries */ + caml_init_exceptions(); + caml_sys_init("", argv); + /* Execute the program */ + caml_debugger(PROGRAM_START); + res = caml_interprete(caml_start_code, caml_code_size); + if (Is_exception_result(res)) { + caml_exn_bucket = Extract_exception(res); + if (caml_debugger_in_use) { + caml_extern_sp = &caml_exn_bucket; /* The debugger needs the + exception value.*/ + caml_debugger(UNCAUGHT_EXC); + } + caml_fatal_uncaught_exception(caml_exn_bucket); + } +} |