diff --git a/configure b/configure index 0c4ad34..39a8182 100755 --- a/configure +++ b/configure @@ -69,7 +69,7 @@ done echo "\ VERSION = $VERSION -OCAMLBUILD = $OCAMLBUILD -cflags -w,Ae,-warn-error,A -lflags -w,Ae,-warn-error,A -no-links -classic-display +OCAMLBUILD = $OCAMLBUILD -use-ocamlfind -no-links -classic-display BINDIR = $BINDIR MAN1DIR = $MANDIR/man1 diff --git a/src/Makefile b/src/Makefile index 726cc0a..1a342d4 100644 --- a/src/Makefile +++ b/src/Makefile @@ -18,7 +18,7 @@ TARGS = $(BIN)/ocamlpp all: $(TARGS) $(BIN)/%: $(SRCS) config.ml - $(OCAMLBUILD) -cflag -g -lflag -g $*.native + $(OCAMLBUILD) $*.native cp _build/$*.native $@ config.ml: ../etc/config.ml diff --git a/src/_tags b/src/_tags new file mode 100644 index 0000000..cb313f5 --- /dev/null +++ b/src/_tags @@ -0,0 +1,2 @@ +true: debug, bin_annot, warn(Ae), warn_error(A) +true: package(bytes) diff --git a/src/cmoparser.ml b/src/cmoparser.ml index 869a992..8548b0e 100644 --- a/src/cmoparser.ml +++ b/src/cmoparser.ml @@ -16,9 +16,9 @@ let cmo_magic_number = "Caml1999O007";; let parse file_name = let ic = open_in_bin file_name in try - let buffer = String.create (String.length cmo_magic_number) in - really_input ic buffer 0 (String.length cmo_magic_number); - if buffer = cmo_magic_number then begin + let read_magic = + Util.really_input_string ic (String.length cmo_magic_number) in + if read_magic = cmo_magic_number then begin let compunit_pos = input_binary_int ic in (* Go to descriptor *) seek_in ic compunit_pos; let compunit = (input_value ic : Cmo.compilation_unit) in diff --git a/src/code.ml b/src/code.ml index cfa3f6b..8f8650f 100644 --- a/src/code.ml +++ b/src/code.ml @@ -91,14 +91,16 @@ let parse_segment ic offset length = let cpt = ref 0 in let nb_bc = length lsr 2 in let read = - let buf4 = String.create 4 in + let buf4 = Bytes.create 4 in fun () -> incr cpt; if !cpt > nb_bc then raise End_of_file; really_input ic buf4 0 4; let res = - (int_of_char buf4.[0]) lor (int_of_char buf4.[1] lsl 8) lor - (int_of_char buf4.[2] lsl 16) lor (int_of_char buf4.[3] lsl 24) + (int_of_char (Bytes.get buf4 0)) + lor (int_of_char (Bytes.get buf4 1) lsl 8) + lor (int_of_char (Bytes.get buf4 2) lsl 16) + lor (int_of_char (Bytes.get buf4 3) lsl 24) in match Sys.word_size with | 32 -> res diff --git a/src/data.ml b/src/data.ml index fd0adcf..7cff420 100644 --- a/src/data.ml +++ b/src/data.ml @@ -79,7 +79,7 @@ let string_of_elem e = let parse ic index = let (offset, _) = try Index.find_section index Index.Data - with Not_found -> failwith "code section not found" + with Not_found -> failwith "data section not found" in seek_in ic offset; let (tbl : Obj.t array) = input_value ic in diff --git a/src/index.ml b/src/index.ml index 53f9291..32b0eee 100644 --- a/src/index.ml +++ b/src/index.ml @@ -14,21 +14,19 @@ exception Not_a_byte type section_name = Code | Dlpt | Dlls | Prim | Data | Symb | Crcs | Dbug type t = (section_name * int * int) list - + let parse ic = let magic_str = "Caml1999X008" in let magic_size = String.length magic_str in let file_length = in_channel_length ic in - let buf_magic = String.create magic_size in - let buf4 = String.create 4 in let read_int offset = seek_in ic offset; input_binary_int ic in let read_name offset = seek_in ic offset; - really_input ic buf4 0 4; - match buf4 with + let name = Util.really_input_string ic 4 in + match name with | "CODE" -> Code | "DLPT" -> Dlpt | "DLLS" -> Dlls @@ -37,11 +35,11 @@ let parse ic = | "SYMB" -> Symb | "CRCS" -> Crcs | "DBUG" -> Dbug - | _ -> failwith (Printf.sprintf "invalid section name: `%s'" buf4) + | _ -> failwith (Printf.sprintf "invalid section name: `%s'" name) in seek_in ic (file_length - magic_size); - really_input ic buf_magic 0 magic_size; - if buf_magic <> magic_str then raise Not_a_byte; + let read_magic = Util.really_input_string ic magic_size in + if read_magic <> magic_str then raise Not_a_byte; let size = read_int (file_length - magic_size - 4) in let rec f ind next_offset rem = if ind <> -1 then diff --git a/src/util.ml b/src/util.ml new file mode 100644 index 0000000..ca51817 --- /dev/null +++ b/src/util.ml @@ -0,0 +1,6 @@ +let really_input_string ic len = + let s = Bytes.create len in + really_input ic s 0 len; + (* s is local and does not escape: + it will never be written again and we can transfer ownership *) + Bytes.unsafe_to_string s diff --git a/src/util.mli b/src/util.mli new file mode 100644 index 0000000..6470916 --- /dev/null +++ b/src/util.mli @@ -0,0 +1,4 @@ +val really_input_string : in_channel -> int -> string +(** This utility is provided in recent OCaml version (4.02), but not + in older versions so we included it here (it is trivial to implement) + for backward compatibility. *)