l4/pkg/ocaml/ocaml/contrib/asmrun/startup.c

   1 /***********************************************************************/
   2 /*                                                                     */
   3 /*                           Objective Caml                            */
   4 /*                                                                     */
   5 /*         Xavier Leroy and Damien Doligez, INRIA Rocquencourt         */
   6 /*                                                                     */
   7 /*  Copyright 1996 Institut National de Recherche en Informatique et   */
   8 /*  en Automatique.  All rights reserved.  This file is distributed    */
   9 /*  under the terms of the GNU Library General Public License, with    */
  10 /*  the special exception on linking described in file ../LICENSE.     */
  11 /*                                                                     */
  12 /***********************************************************************/
  13
  14 /* $Id: startup.c 9131 2008-11-18 10:24:43Z doligez $ */
  15
  16 /* Start-up code */
  17
  18 #include <stdio.h>
  19 #include <stdlib.h>
  20 #include "callback.h"
  21 #include "backtrace.h"
  22 #include "custom.h"
  23 #include "fail.h"
  24 #include "freelist.h"
  25 #include "gc.h"
  26 #include "gc_ctrl.h"
  27 #include "memory.h"
  28 #include "misc.h"
  29 #include "mlvalues.h"
  30 #include "osdeps.h"
  31 #include "printexc.h"
  32 #include "sys.h"
  33 #include "natdynlink.h"
  34 #ifdef HAS_UI
  35 #include "ui.h"
  36 #endif
  37
  38 extern int caml_parser_trace;
  39 CAMLexport header_t caml_atom_table[256];
  40 char * caml_code_area_start, * caml_code_area_end;
  41
  42 /* Initialize the atom table and the static data and code area limits. */
  43
  44 struct segment { char * begin; char * end; };
  45
  46 static void init_atoms(void)
  47 {
  48   extern struct segment caml_data_segments[], caml_code_segments[];
  49   int i;
  50
  51   for (i = 0; i < 256; i++) {
  52     caml_atom_table[i] = Make_header(0, i, Caml_white);
  53   }
  54   if (caml_page_table_add(In_static_data,
  55                           caml_atom_table, caml_atom_table + 256) != 0)
  56     caml_fatal_error("Fatal error: not enough memory for the initial page table");
  57
  58   for (i = 0; caml_data_segments[i].begin != 0; i++) {
  59     if (caml_page_table_add(In_static_data,
  60                             caml_data_segments[i].begin,
  61                             caml_data_segments[i].end) != 0)
  62       caml_fatal_error("Fatal error: not enough memory for the initial page table");
  63   }
  64
  65   caml_code_area_start = caml_code_segments[0].begin;
  66   caml_code_area_end = caml_code_segments[0].end;
  67   for (i = 1; caml_code_segments[i].begin != 0; i++) {
  68     if (caml_code_segments[i].begin < caml_code_area_start)
  69       caml_code_area_start = caml_code_segments[i].begin;
  70     if (caml_code_segments[i].end > caml_code_area_end)
  71       caml_code_area_end = caml_code_segments[i].end;
  72   }
  73 }
  74
  75 /* Configuration parameters and flags */
  76
  77 static uintnat percent_free_init = Percent_free_def;
  78 static uintnat max_percent_free_init = Max_percent_free_def;
  79 static uintnat minor_heap_init = Minor_heap_def;
  80 static uintnat heap_chunk_init = Heap_chunk_def;
  81 static uintnat heap_size_init = Init_heap_def;
  82 static uintnat max_stack_init = Max_stack_def;
  83
  84 /* Parse the CAMLRUNPARAM variable */
  85 /* The option letter for each runtime option is the first letter of the
  86    last word of the ML name of the option (see [stdlib/gc.mli]).
  87    Except for l (maximum stack size) and h (initial heap size).
  88 */
  89 /* Note: option l is irrelevant to the native-code runtime. */
  90
  91 /* If you change these functions, see also their copy in byterun/startup.c */
  92
  93 static void scanmult (char *opt, uintnat *var)
  94 {
  95   char mult = ' ';
  96   int val;
  97   sscanf (opt, "=%u%c", &val, &mult);
  98   sscanf (opt, "=0x%x%c", &val, &mult);
  99   switch (mult) {
 100   case 'k':   *var = (uintnat) val * 1024; break;
 101   case 'M':   *var = (uintnat) val * 1024 * 1024; break;
 102   case 'G':   *var = (uintnat) val * 1024 * 1024 * 1024; break;
 103   default:    *var = (uintnat) val; break;
 104   }
 105 }
 106
 107 static void parse_camlrunparam(void)
 108 {
 109   char *opt = getenv ("OCAMLRUNPARAM");
 110   uintnat p;
 111
 112   if (opt == NULL) opt = getenv ("CAMLRUNPARAM");
 113
 114   if (opt != NULL){
 115     while (*opt != '\0'){
 116       switch (*opt++){
 117       case 's': scanmult (opt, &minor_heap_init); break;
 118       case 'i': scanmult (opt, &heap_chunk_init); break;
 119       case 'h': scanmult (opt, &heap_size_init); break;
 120       case 'l': scanmult (opt, &max_stack_init); break;
 121       case 'o': scanmult (opt, &percent_free_init); break;
 122       case 'O': scanmult (opt, &max_percent_free_init); break;
 123       case 'v': scanmult (opt, &caml_verb_gc); break;
 124       case 'b': caml_record_backtrace(Val_true); break;
 125       case 'p': caml_parser_trace = 1; break;
 126       case 'a': scanmult (opt, &p); caml_set_allocation_policy (p); break;
 127       }
 128     }
 129   }
 130 }
 131
 132 /* These are termination hooks used by the systhreads library */
 133 struct longjmp_buffer caml_termination_jmpbuf;
 134 void (*caml_termination_hook)(void *) = NULL;
 135
 136 extern value caml_start_program (void);
 137 extern void caml_init_ieee_floats (void);
 138 extern void caml_init_signals (void);
 139
 140 void caml_main(char **argv)
 141 {
 142   char * exe_name;
 143 #ifdef __linux__
 144   static char proc_self_exe[256];
 145 #endif
 146   value res;
 147
 148   caml_init_ieee_floats();
 149   caml_init_custom_operations();
 150 #ifdef DEBUG
 151   caml_verb_gc = 63;
 152 #endif
 153   parse_camlrunparam();
 154   caml_init_gc (minor_heap_init, heap_size_init, heap_chunk_init,
 155                 percent_free_init, max_percent_free_init);
 156   init_atoms();
 157   caml_init_signals();
 158   exe_name = argv[0];
 159   if (exe_name == NULL) exe_name = "";
 160 #ifdef __linux__
 161   if (caml_executable_name(proc_self_exe, sizeof(proc_self_exe)) == 0)
 162     exe_name = proc_self_exe;
 163   else
 164     exe_name = caml_search_exe_in_path(exe_name);
 165 #else
 166   exe_name = caml_search_exe_in_path(exe_name);
 167 #endif
 168   caml_sys_init(exe_name, argv);
 169   if (sigsetjmp(caml_termination_jmpbuf.buf, 0)) {
 170     if (caml_termination_hook != NULL) caml_termination_hook(NULL);
 171     return;
 172   }
 173   res = caml_start_program();
 174   if (Is_exception_result(res))
 175     caml_fatal_uncaught_exception(Extract_exception(res));
 176 }
 177
 178 void caml_startup(char **argv)
 179 {
 180   caml_main(argv);
 181 }