Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'trunk' of https://github.com/bvaugon/ocaml into bvaugon-trunk

master
alainfrisch 2015-12-04 16:31:59 +01:00
parent 89d116c514 e9bb7e117b
commit 1ff6db10bf
17 changed files with 258 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Changes
View File

@ -365,6 +365,8 @@ Bug fixes:
(Marc Lasson, review by Alain Frisch)
- GPR#313: Prevent quadratic cases in CSE
(Pierre Chambart, review by Xavier Leroy)
- GPR#330: Fix weak hash of serialised closures
(Benoît Vaugon, review by Alain Frish)
Features wishes:
- PR#4518, GPR#29: change location format for reporting errors in ocamldoc

22
asmrun/natdynlink.c
View File

@ -79,7 +79,7 @@ CAMLprim value caml_natdynlink_run(void *handle, value symbol) {
CAMLparam1 (symbol);
CAMLlocal1 (result);
void *sym,*sym2;
struct code_fragment * cf;
struct code_fragment * cf = NULL;
#define optsym(n) getsym(handle,unit,n)
char *unit;
@ -93,11 +93,6 @@ CAMLprim value caml_natdynlink_run(void *handle, value symbol) {
sym = optsym("__gc_roots");
if (NULL != sym) caml_register_dyn_global(sym);
sym = optsym("__data_begin");
sym2 = optsym("__data_end");
if (NULL != sym && NULL != sym2)
caml_page_table_add(In_static_data, sym, sym2);
sym = optsym("__code_begin");
sym2 = optsym("__code_end");
if (NULL != sym && NULL != sym2) {
@ -105,10 +100,23 @@ CAMLprim value caml_natdynlink_run(void *handle, value symbol) {
cf = caml_stat_alloc(sizeof(struct code_fragment));
cf->code_start = (char *) sym;
cf->code_end = (char *) sym2;
cf->data_start = NULL;
cf->data_end = NULL;
cf->digest_computed = 0;
caml_ext_table_add(&caml_code_fragments_table, cf);
}
sym = optsym("__data_begin");
sym2 = optsym("__data_end");
if (NULL != sym && NULL != sym2) {
caml_page_table_add(In_static_data, sym, sym2);
if (cf != NULL) {
cf->data_start = (char *) sym;
cf->data_end = (char *) sym2;
}
}
if (cf != NULL) caml_ext_table_add(&caml_code_fragments_table, cf);
entrypoint = optsym("__entry");
if (NULL != entrypoint) result = caml_callback((value)(&entrypoint), 0);
else result = Val_unit;

17
asmrun/startup.c
View File

@ -52,6 +52,22 @@ static void init_static(void)
caml_init_atom_table ();
/* Register the data in the table of code fragments */
cf = caml_stat_alloc(sizeof(struct code_fragment));
if (caml_data_segments[0].begin != 0) {
cf->data_start = caml_data_segments[0].begin;
cf->data_end = caml_data_segments[0].end;
for (i = 1; caml_data_segments[i].begin != 0; i ++) {
if (caml_data_segments[i].begin < cf->data_start)
cf->data_start = caml_data_segments[i].begin;
if (caml_data_segments[i].end > cf->data_end)
cf->data_end = caml_data_segments[i].end;
}
} else {
cf->data_start = NULL;
cf->data_end = NULL;
}
for (i = 0; caml_data_segments[i].begin != 0; i++) {
/* 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. */
@ -70,7 +86,6 @@ static void init_static(void)
caml_code_area_end = caml_code_segments[i].end;
}
/* Register the code in the table of code fragments */
cf = caml_stat_alloc(sizeof(struct code_fragment));
cf->code_start = caml_code_area_start;
cf->code_end = caml_code_area_end;
cf->digest_computed = 0;

2
byterun/caml/fix_code.h
View File

@ -21,6 +21,8 @@
#include "misc.h"
#include "mlvalues.h"
extern char *caml_data;
extern asize_t caml_data_size;
extern code_t caml_start_code;
extern asize_t caml_code_size;
extern unsigned char * caml_saved_code;

6
byterun/caml/intext.h
View File

@ -177,12 +177,18 @@ CAMLextern void caml_deserialize_error(char * msg);
struct code_fragment {
char * code_start;
char * code_end;
char * data_start;
char * data_end;
unsigned char digest[16];
char digest_computed;
};
struct ext_table caml_code_fragments_table;
/* Defined in misc.c */
CAMLextern void caml_update_code_fragment_digest(struct code_fragment *cf);
/* </private> */
#ifdef __cplusplus

6
byterun/extern.c
View File

@ -22,7 +22,6 @@
#include "caml/gc.h"
#include "caml/intext.h"
#include "caml/io.h"
#include "caml/md5.h"
#include "caml/memory.h"
#include "caml/misc.h"
#include "caml/mlvalues.h"
@ -895,10 +894,7 @@ static struct code_fragment * extern_find_code(char *addr)
int i;
for (i = caml_code_fragments_table.size - 1; i >= 0; i--) {
struct code_fragment * cf = caml_code_fragments_table.contents[i];
if (! cf->digest_computed) {
caml_md5_block(cf->digest, cf->code_start, cf->code_end - cf->code_start);
cf->digest_computed = 1;
}
if (! cf->digest_computed) caml_update_code_fragment_digest(cf);
if (cf->code_start <= addr && addr < cf->code_end) return cf;
}
return NULL;

8
byterun/fix_code.c
View File

@ -23,12 +23,13 @@
#include "caml/fix_code.h"
#include "caml/instruct.h"
#include "caml/intext.h"
#include "caml/md5.h"
#include "caml/memory.h"
#include "caml/misc.h"
#include "caml/mlvalues.h"
#include "caml/reverse.h"
char *caml_data;
asize_t caml_data_size;
code_t caml_start_code;
asize_t caml_code_size;
unsigned char * caml_saved_code;
@ -41,8 +42,9 @@ void caml_init_code_fragments(void) {
cf = caml_stat_alloc(sizeof(struct code_fragment));
cf->code_start = (char *) caml_start_code;
cf->code_end = (char *) caml_start_code + caml_code_size;
caml_md5_block(cf->digest, caml_start_code, caml_code_size);
cf->digest_computed = 1;
cf->data_start = (char *) caml_data;
cf->data_end = (char *) caml_data + caml_data_size;
caml_update_code_fragment_digest(cf);
caml_ext_table_init(&caml_code_fragments_table, 8);
caml_ext_table_add(&caml_code_fragments_table, cf);
}

6
byterun/intern.c
View File

@ -24,7 +24,6 @@
#include "caml/gc.h"
#include "caml/intext.h"
#include "caml/io.h"
#include "caml/md5.h"
#include "caml/memory.h"
#include "caml/mlvalues.h"
#include "caml/misc.h"
@ -855,10 +854,7 @@ static char * intern_resolve_code_pointer(unsigned char digest[16],
int i;
for (i = caml_code_fragments_table.size - 1; i >= 0; i--) {
struct code_fragment * cf = caml_code_fragments_table.contents[i];
if (! cf->digest_computed) {
caml_md5_block(cf->digest, cf->code_start, cf->code_end - cf->code_start);
cf->digest_computed = 1;
}
if (! cf->digest_computed) caml_update_code_fragment_digest(cf);
if (memcmp(digest, cf->digest, 16) == 0) {
if (cf->code_start + offset < cf->code_end)
return cf->code_start + offset;

2
byterun/meta.c
View File

@ -52,6 +52,8 @@ CAMLprim value caml_reify_bytecode(value prog, value len)
cf->code_start = (char *) prog;
cf->code_end = (char *) prog + Long_val(len);
cf->data_start = NULL;
cf->data_end = NULL;
cf->digest_computed = 0;
caml_ext_table_add(&caml_code_fragments_table, cf);

13
byterun/misc.c
View File

@ -15,8 +15,10 @@
#include <string.h>
#include <stdarg.h>
#include "caml/config.h"
#include "caml/intext.h"
#include "caml/misc.h"
#include "caml/memory.h"
#include "caml/md5.h"
caml_timing_hook caml_major_slice_begin_hook = NULL;
caml_timing_hook caml_major_slice_end_hook = NULL;
@ -144,6 +146,17 @@ void caml_ext_table_free(struct ext_table * tbl, int free_entries)
caml_stat_free(tbl->contents);
}
void caml_update_code_fragment_digest(struct code_fragment *cf) {
int i;
unsigned char code_digest[16];
unsigned char data_digest[16];
caml_md5_block(code_digest, cf->code_start, cf->code_end - cf->code_start);
caml_md5_block(data_digest, cf->data_start, cf->data_end - cf->data_start);
for (i = 0 ; i < 16 ; i ++)
cf->digest[i] = code_digest[i] ^ data_digest[i];
cf->digest_computed = 1;
}
CAMLexport char * caml_strdup(const char * s)
{
size_t slen = strlen(s);

14
byterun/startup.c
View File

@ -270,7 +270,6 @@ 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;
@ -334,6 +333,10 @@ CAMLexport void caml_main(char **argv)
caml_interprete(NULL, 0);
/* Initialize the debugger, if needed */
caml_debugger_init();
/* Load the globals */
caml_data_size = caml_seek_section(fd, &trail, "DATA");
caml_data = read_section(fd, &trail, "DATA");
caml_global_data = caml_input_value_from_block(caml_data, caml_data_size);
/* Load the code */
caml_code_size = caml_seek_section(fd, &trail, "CODE");
caml_load_code(fd, caml_code_size);
@ -347,11 +350,8 @@ CAMLexport void caml_main(char **argv)
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 */
/* Close */
close(fd);
caml_stat_free(trail.section);
/* Ensure that the globals are in the major heap. */
caml_oldify_one (caml_global_data, &caml_global_data);
@ -421,6 +421,8 @@ CAMLexport void caml_startup_code(
/* Load the code */
caml_start_code = code;
caml_code_size = code_size;
caml_data = data;
caml_data_size = data_size;
caml_init_code_fragments();
caml_init_debug_info();
if (caml_debugger_in_use) {

2
testsuite/tests/lib-marshal-closure/.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
*.err
data

61
testsuite/tests/lib-marshal-closure/Makefile Normal file
View File

@ -0,0 +1,61 @@
#########################################################################
# #
# OCaml #
# #
# Benoit Vaugon, ENSTA #
# #
# Copyright 2014 Institut National de Recherche en Informatique et #
# en Automatique. All rights reserved. This file is distributed #
# under the terms of the Q Public License version 1.0. #
# #
#########################################################################
BINARIES := write32.byte write32.native read32.byte read32.native \
write64.byte write64.native read64.byte read64.native
BASEDIR=../..
.PHONY: default
default:
@$(MAKE) compile
@$(MAKE) run
.PHONY: compile
compile: $(BINARIES)
.PHONY: run
run:
@for arch in 32 64; do \
for kind in byte native; do \
echo -n " ... testing 'arch-$$arch/$$kind'"; \
rm -f data; \
./write$$arch.$$kind \
> write$$arch$$kind.out 2> write$$arch$$kind.err \
|| exit 1; \
./read$$arch.$$kind \
> read$$arch$$kind.out 2> read$$arch$$kind.err \
&& ( echo " => passed" ) \
|| ( echo " => failed" ) \
done; \
done
###
.PHONY: promote
promote: defaultpromote
.PHONY: clean
clean: defaultclean
@rm -f data *.byte *.native *.out *.err
###
%.byte: %.ml
@$(OCAMLC) $< -o $@
%.native: %.ml
@$(OCAMLOPT) $< -o $@
###
include $(BASEDIR)/makefiles/Makefile.common

31
testsuite/tests/lib-marshal-closure/read32.ml Normal file
View File

@ -0,0 +1,31 @@
(***********************************************************************)
(* *)
(* OCaml *)
(* *)
(* Benoit Vaugon, ENSTA *)
(* *)
(* Copyright 2014 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
let fname = "data";;
let f () = [ 1; 2; 3; 4 ];;
try
let ic = open_in fname in
let g : unit -> float list = Marshal.from_channel ic in
close_in ic;
Printf.printf "%f\n" (List.nth (g ()) 0);
with
| Sys_error _ ->
Printf.printf "Do not import %S, ok\n" fname;
| Failure msg when String.sub msg 0 32 = "input_value: unknown code module" ->
Printf.printf "Incompatible closure, ok\n";
;;
let oc = open_out fname in
Marshal.to_channel oc f [ Marshal.Closures ];
close_out oc;;

31
testsuite/tests/lib-marshal-closure/read64.ml Normal file
View File

@ -0,0 +1,31 @@
(***********************************************************************)
(* *)
(* OCaml *)
(* *)
(* Benoit Vaugon, ENSTA *)
(* *)
(* Copyright 2014 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
let fname = "data";;
let f () = [ 1; 2; 3; 4; 5 ];;
try
let ic = open_in fname in
let g : unit -> float list = Marshal.from_channel ic in
close_in ic;
Printf.printf "%f\n" (List.nth (g ()) 0);
with
| Sys_error _ ->
Printf.printf "Do not import %S, ok\n" fname;
| Failure msg when String.sub msg 0 32 = "input_value: unknown code module" ->
Printf.printf "Incompatible closure, ok\n";
;;
let oc = open_out fname in
Marshal.to_channel oc f [ Marshal.Closures ];
close_out oc;;

31
testsuite/tests/lib-marshal-closure/write32.ml Normal file
View File

@ -0,0 +1,31 @@
(***********************************************************************)
(* *)
(* OCaml *)
(* *)
(* Benoit Vaugon, ENSTA *)
(* *)
(* Copyright 2014 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
let fname = "data";;
let f () = [ 3.14; 6.28 ];;
try
let ic = open_in fname in
let g : unit -> float list = Marshal.from_channel ic in
close_in ic;
Printf.printf "%f\n" (List.nth (g ()) 0);
with
| Sys_error _ ->
Printf.printf "Do not import %S, ok\n" fname;
| Failure msg when String.sub msg 0 32 = "input_value: unknown code module" ->
Printf.printf "Incompatible closure, ok\n";
;;
let oc = open_out fname in
Marshal.to_channel oc f [ Marshal.Closures ];
close_out oc;;

31
testsuite/tests/lib-marshal-closure/write64.ml Normal file
View File

@ -0,0 +1,31 @@
(***********************************************************************)
(* *)
(* OCaml *)
(* *)
(* Benoit Vaugon, ENSTA *)
(* *)
(* Copyright 2014 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
let fname = "data";;
let f () = [ 3.14; 6.28; 9.42 ];;
try
let ic = open_in fname in
let g : unit -> float list = Marshal.from_channel ic in
close_in ic;
Printf.printf "%f\n" (List.nth (g ()) 0);
with
| Sys_error _ ->
Printf.printf "Do not import %S, ok\n" fname;
| Failure msg when String.sub msg 0 32 = "input_value: unknown code module" ->
Printf.printf "Incompatible closure, ok\n";
;;
let oc = open_out fname in
Marshal.to_channel oc f [ Marshal.Closures ];
close_out oc;;