Exemple #1
0
/* Make sure the minor heap is empty by performing a minor collection
   if needed.
*/
void caml_empty_minor_heap (void)
{
    value **r;
    uintnat prev_alloc_words;

    if (caml_young_ptr != caml_young_end) {
        if (caml_minor_gc_begin_hook != NULL) (*caml_minor_gc_begin_hook) ();
        prev_alloc_words = caml_allocated_words;
        caml_in_minor_collection = 1;
        caml_gc_message (0x02, "<", 0);
        caml_oldify_local_roots();
        for (r = caml_ref_table.base; r < caml_ref_table.ptr; r++) {
            caml_oldify_one (**r, *r);
        }
        caml_oldify_mopup ();
        for (r = caml_weak_ref_table.base; r < caml_weak_ref_table.ptr; r++) {
            if (Is_block (**r) && Is_young (**r)) {
                if (Hd_val (**r) == 0) {
                    **r = Field (**r, 0);
                } else {
                    **r = caml_weak_none;
                }
            }
        }
        if (caml_young_ptr < caml_young_start) caml_young_ptr = caml_young_start;
        caml_stat_minor_words += Wsize_bsize (caml_young_end - caml_young_ptr);
        caml_young_ptr = caml_young_end;
        caml_young_limit = caml_young_start;
        clear_table (&caml_ref_table);
        clear_table (&caml_weak_ref_table);
        caml_gc_message (0x02, ">", 0);
        caml_in_minor_collection = 0;
        caml_stat_promoted_words += caml_allocated_words - prev_alloc_words;
        ++ caml_stat_minor_collections;
        caml_final_empty_young ();
        if (caml_minor_gc_end_hook != NULL) (*caml_minor_gc_end_hook) ();
    } else {
        caml_final_empty_young ();
    }
#ifdef DEBUG
    {
        value *p;
        for (p = (value *) caml_young_start; p < (value *) caml_young_end; ++p) {
            *p = Debug_free_minor;
        }
        ++ minor_gc_counter;
    }
#endif
}
Exemple #2
0
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;

  caml_init_ieee_floats();
  caml_init_custom_operations();
#ifdef DEBUG
  caml_verb_gc = 63;
#endif
  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);
  /* Load the code */
  caml_start_code = code;
#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;
  /* Run the code */
  caml_init_exceptions();
  caml_sys_init("", argv);
  res = caml_interprete(caml_start_code, code_size);
  if (Is_exception_result(res))
    caml_fatal_uncaught_exception(Extract_exception(res));
}
Exemple #3
0
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", */
  /*       exe_name); */
  /*     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_global_data =
    caml_input_value_from_block((char *) ocamlcc_global_data,
                                OCAMLCC_GLOBAL_DATA_LENGTH);
  /* 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); */
  caml_sys_init(exe_name, argv);
#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); */
  res = ocamlcc_main();
  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);
    /*
    fprintf(stderr, "Fatal error!\n");
    exit(2);
    */
  }
}
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;
  char * exe_name;
#ifdef __linux__
  static char proc_self_exe[256];
#endif

  caml_init_ieee_floats();
#ifdef _MSC_VER
  caml_install_invalid_parameter_handler();
#endif
  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();
  exe_name = argv[0];
#ifdef __linux__
  if (caml_executable_name(proc_self_exe, sizeof(proc_self_exe)) == 0)
    exe_name = proc_self_exe;
#endif
  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;
  caml_init_code_fragments();
  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(exe_name, 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);
  }
}
Exemple #5
0
/* Make sure the minor heap is empty by performing a minor collection if
 * needed. */
void caml_empty_minor_heap (void)
{
  uintnat minor_allocated_bytes = caml_domain_state->young_end - caml_domain_state->young_ptr;
  unsigned rewritten = 0;
  struct caml_ref_entry *r;

  caml_save_stack_gc();

  stat_live_bytes = 0;

  if (minor_allocated_bytes != 0){
    caml_gc_log ("Minor collection starting");
    caml_do_local_roots(&caml_oldify_one, caml_domain_self());

    for (r = caml_domain_state->remembered_set->ref.base; r < caml_domain_state->remembered_set->ref.ptr; r++){
      value x;
      caml_oldify_one (Op_val(r->obj)[r->field], &x);
    }

    for (r = caml_domain_state->remembered_set->fiber_ref.base; r < caml_domain_state->remembered_set->fiber_ref.ptr; r++) {
      caml_scan_dirty_stack(&caml_oldify_one, r->obj);
    }

    caml_oldify_mopup ();

    for (r = caml_domain_state->remembered_set->ref.base; r < caml_domain_state->remembered_set->ref.ptr; r++){
      value v = Op_val(r->obj)[r->field];
      if (Is_block(v) && Is_young(v)) {
        Assert (Hp_val (v) >= caml_domain_state->young_ptr);
        value vnew;
        header_t hd = Hd_val(v);
        // FIXME: call oldify_one here?
        if (Is_promoted_hd(hd)) {
          vnew = caml_addrmap_lookup(&caml_domain_state->remembered_set->promotion, v);
        } else {
          int offset = 0;
          if (Tag_hd(hd) == Infix_tag) {
            offset = Infix_offset_hd(hd);
            v -= offset;
          }
          Assert (Hd_val (v) == 0);
          vnew = Op_val(v)[0] + offset;
        }
        Assert(Is_block(vnew) && !Is_young(vnew));
        Assert(Hd_val(vnew));
        if (Tag_hd(hd) == Infix_tag) { Assert(Tag_val(vnew) == Infix_tag); }
        rewritten += caml_atomic_cas_field(r->obj, r->field, v, vnew);
      }
    }

    caml_addrmap_iter(&caml_domain_state->remembered_set->promotion, unpin_promoted_object);

    if (caml_domain_state->young_ptr < caml_domain_state->young_start)
      caml_domain_state->young_ptr = caml_domain_state->young_start;
    caml_stat_minor_words += Wsize_bsize (minor_allocated_bytes);
    caml_domain_state->young_ptr = caml_domain_state->young_end;
    clear_table (&caml_domain_state->remembered_set->ref);
    caml_addrmap_clear(&caml_domain_state->remembered_set->promotion);
    caml_addrmap_clear(&caml_domain_state->remembered_set->promotion_rev);
    caml_gc_log ("Minor collection completed: %u of %u kb live, %u pointers rewritten",
                 (unsigned)stat_live_bytes/1024, (unsigned)minor_allocated_bytes/1024, rewritten);
  }

  for (r = caml_domain_state->remembered_set->fiber_ref.base; r < caml_domain_state->remembered_set->fiber_ref.ptr; r++) {
    caml_scan_dirty_stack(&caml_darken, r->obj);
    caml_clean_stack(r->obj);
  }
  clear_table (&caml_domain_state->remembered_set->fiber_ref);

  caml_restore_stack_gc();

#ifdef DEBUG
  {
    value *p;
    for (p = (value *) caml_domain_state->young_start;
         p < (value *) caml_domain_state->young_end; ++p){
      *p = Debug_free_minor;
    }
    ++ minor_gc_counter;
  }
#endif
}
Exemple #6
0
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;
  static char proc_self_exe[256];

  /* Machine-dependent initialization of the floating-point hardware
     so that it behaves as much as possible as specified in IEEE */
  caml_init_ieee_floats();
#ifdef _MSC_VER
  caml_install_invalid_parameter_handler();
#endif
  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 = 0x3F;
#endif
  caml_parse_ocamlrunparam();
#ifdef DEBUG
  caml_gc_message (-1, "### OCaml runtime: debug mode ###\n", 0);
#endif

  pos = 0;

  /* First, try argv[0] (when ocamlrun is called by a bytecode program) */
  exe_name = argv[0];
  fd = caml_attempt_open(&exe_name, &trail, 0);

  /* Should we really do that at all?  The current executable is ocamlrun
     itself, it's never a bytecode program. */
  if (fd < 0
      && caml_executable_name(proc_self_exe, sizeof(proc_self_exe)) == 0) {
    exe_name = proc_self_exe;
    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",
        exe_name);
      break;
    }
  }
  /* Read the table of contents (section descriptors) */
  caml_read_section_descriptors(fd, &trail);
  /* Initialize the abstract machine */
  caml_init_gc (caml_init_minor_heap_wsz, caml_init_heap_wsz,
                caml_init_heap_chunk_sz, caml_init_percent_free,
                caml_init_max_percent_free, caml_init_major_window);
  caml_init_stack (caml_init_max_stack_wsz);
  caml_init_atom_table();
  caml_init_backtrace();
  /* 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);
  caml_init_debug_info();
  /* 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_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);
  }
}