Nouveau format d'executables.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@1600 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

tools/.depend

@@ -4,12 +4,10 @@ dumpapprox.cmx: ../asmcomp/clambda.cmx ../asmcomp/compilenv.cmx \
     ../utils/config.cmx 
 dumpobj.cmo: ../parsing/asttypes.cmi ../utils/config.cmi \
     ../bytecomp/emitcode.cmi ../typing/ident.cmi ../bytecomp/lambda.cmi \
-    ../bytecomp/opcodes.cmo opnames.cmo ../bytecomp/runtimedef.cmi \
-    ../utils/tbl.cmi 
+    ../bytecomp/opcodes.cmo opnames.cmo ../utils/tbl.cmi 
 dumpobj.cmx: ../parsing/asttypes.cmi ../utils/config.cmx \
     ../bytecomp/emitcode.cmx ../typing/ident.cmx ../bytecomp/lambda.cmx \
-    ../bytecomp/opcodes.cmx opnames.cmx ../bytecomp/runtimedef.cmx \
-    ../utils/tbl.cmx 
+    ../bytecomp/opcodes.cmx opnames.cmx ../utils/tbl.cmx 
 objinfo.cmo: ../utils/config.cmi ../bytecomp/emitcode.cmi 
 objinfo.cmx: ../utils/config.cmx ../bytecomp/emitcode.cmx 
 ocamldep.cmo: ../utils/misc.cmi 

tools/Makefile

@@ -76,7 +76,7 @@ beforedepend:: cvt_emit.ml
 DUMPOBJ=opnames.cmo dumpobj.cmo
 
 dumpobj: $(DUMPOBJ)
-	$(CAMLC) $(LINKFLAGS) -o dumpobj misc.cmo tbl.cmo config.cmo ident.cmo opcodes.cmo runtimedef.cmo $(DUMPOBJ)
+	$(CAMLC) $(LINKFLAGS) -o dumpobj misc.cmo tbl.cmo config.cmo ident.cmo opcodes.cmo $(DUMPOBJ)
 
 clean::
 	rm -f dumpobj

tools/Makefile.Mac

@@ -58,7 +58,7 @@ DUMPOBJ = opnames.cmo dumpobj.cmo
 
 DumpCamlObj Ä {DUMPOBJ}
     {CAMLC} {LINKFLAGS} -o DumpCamlObj misc.cmo tbl.cmo config.cmo ident.cmo ¶
-            opcodes.cmo runtimedef.cmo {DUMPOBJ}
+            opcodes.cmo {DUMPOBJ}
 
 clean ÄÄ
     delete -i DumpCamlObj

tools/Makefile.nt

@@ -85,7 +85,7 @@ beforedepend:: cvt_emit.ml
 DUMPOBJ=opnames.cmo dumpobj.cmo
 
 dumpobj: $(DUMPOBJ)
-	$(CAMLC) $(LINKFLAGS) -o dumpobj misc.cmo tbl.cmo config.cmo ident.cmo opcodes.cmo runtimedef.cmo $(DUMPOBJ)
+	$(CAMLC) $(LINKFLAGS) -o dumpobj misc.cmo tbl.cmo config.cmo ident.cmo opcodes.cmo $(DUMPOBJ)
 
 clean::
 	rm -f dumpobj

tools/dumpobj.ml

@@ -46,10 +46,11 @@ type global_table_entry =
   | Global of Ident.t
   | Constant of Obj.t
 
-let start = ref 0                             (* Position of beg. of code *)
-let reloc = ref ([] : (reloc_info * int) list)  (* Relocation table *)
+let start = ref 0                              (* Position of beg. of code *)
+let reloc = ref ([] : (reloc_info * int) list) (* Relocation table *)
 let globals = ref ([||] : global_table_entry array) (* Global map *)
-let objfile = ref false               (* true if dumping a .zo *)
+let primitives = ref ([||] : string array)     (* Table of primitives *)
+let objfile = ref false                        (* true if dumping a .zo *)
 
 (* Print a structured constant *)
 
@@ -174,9 +175,9 @@ let print_primitive ic =
   end
   else begin
     let n = inputu ic in
-    if n >= Array.length Runtimedef.builtin_primitives
+    if n >= Array.length !primitives
     then print_string(string_of_int n)
-    else print_string(Runtimedef.builtin_primitives.(n))
+    else print_string((!primitives).(n))
   end
 
 (* Disassemble one instruction *)
@@ -280,6 +281,19 @@ let dump_obj filename ic =
   seek_in ic cu.cu_pos;
   print_code ic cu.cu_codesize
 
+(* Read the primitive table from an executable *)
+
+let read_primitive_table ic len =
+  let p = String.create len in
+  really_input ic p 0 len;
+  let rec split beg cur =
+    if cur >= len then []
+    else if p.[cur] = '\000' then
+      String.sub p beg (cur - beg) :: split (cur + 1) (cur + 1)
+    else
+      split beg (cur + 1) in
+  Array.of_list(split 0 0)
+
 (* Print an executable file *)
 
 exception Not_exec
@@ -289,13 +303,15 @@ let dump_exe ic =
   if (let buff = String.create 12 in input ic buff 0 12; buff)
      <> exec_magic_number
   then raise Not_exec;
-  let trailer_pos = in_channel_length ic - 28 in
+  let trailer_pos = in_channel_length ic - 32 in
   seek_in ic trailer_pos;
   let code_size = input_binary_int ic in
+  let prim_size = input_binary_int ic in
   let data_size = input_binary_int ic in
   let symbol_size = input_binary_int ic in
   let debug_size = input_binary_int ic in
-  seek_in ic (trailer_pos - debug_size - symbol_size - data_size);
+  seek_in ic (trailer_pos - debug_size - symbol_size - data_size - prim_size);
+  primitives := read_primitive_table ic prim_size;
   let init_data = (input_value ic : Obj.t array) in
   globals := Array.create (Array.length init_data) Empty;
   for i = 0 to Array.length init_data - 1 do
@@ -305,8 +321,8 @@ let dump_exe ic =
     let (_, sym_table) = (input_value ic : int * (Ident.t, int) Tbl.t) in
     Tbl.iter (fun id pos -> !globals.(pos) <- Global id) sym_table
   end;
-  seek_in ic
-    (trailer_pos - debug_size - symbol_size - data_size - code_size);
+  seek_in ic (trailer_pos - debug_size - symbol_size -
+              data_size - prim_size - code_size);
   print_code ic code_size
 
 let main() =

tools/ocamlsize

@@ -2,8 +2,9 @@
 
 foreach $f (@ARGV) {
   open(FILE, $f) || die("Cannot open $f");
-  seek(FILE, -28, 2);
+  seek(FILE, -32, 2);
   $code_size = do read_int();
+  $prim_size = do read_int();
   $data_size = do read_int();
   $symbol_size = do read_int();
   $debug_size = do read_int();