initial commit of ocaml->c wrappers. as bap linking is already complicated, two independent binaries communicate via a tmp.marshall file for now.

DwarfSynth.mlpack

@@ -5,3 +5,5 @@ Regs
 OnlyUnwind
 Simplest
 Frontend
+PreCBinding
+

DwarfSynth/Main.ml

@@ -2,4 +2,9 @@ open Std
 
 let main outfile proj =
   let pre_dwarf = Simplest.of_proj proj in
-  Format.printf "%a" Frontend.pp_pre_dwarf_readelf pre_dwarf
+  Format.printf "%a" Frontend.pp_pre_dwarf_readelf pre_dwarf;
+  let pre_c_dwarf = PreCBinding.convert_pre_c pre_dwarf in 
+  let fd = open_out_bin "tmp.marshal" in
+  Marshal.to_channel fd pre_c_dwarf []
+    
+                    

DwarfSynth/PreCBinding.ml

@@ -20,6 +20,10 @@ type pre_c_pre_dwarf = {
   fdes: pre_c_pre_dwarf_fde array
 }
 
+(* OCAML -> C conversion *)
+
+(* external write_dwarf : string -> pre_c_pre_dwarf -> int = "caml__write_dwarf"   *)
+                     
 (* ========================================================================= *)
 
 (** Empty default value for `pre_c_pre_dwarf_entry` *)

DwarfSynth/c_bindings/Makefile

@@ -1,15 +1,23 @@
 CDEFINE =
-CFLAGS = -Wall -Wextra -std=c11 -O2 -g $(CDEFINE)
+CFLAGS = -Wall -Wextra -std=c11 -O2 -g $(CDEFINE) -I/home/zappa/.opam/bap/lib/ocaml
 LIBDWARFW_DIR=../../libdwarfw/build
-CLIBS = -L$(LIBDWARFW_DIR) -Wl,-rpath,$(LIBDWARFW_DIR) -lelf -ldwarf -ldwarfw
+CLIBS = -L$(LIBDWARFW_DIR) -Wl,-rpath,$(LIBDWARFW_DIR) -lz -lelf -ldwarf -ldwarfw
+OCAMLCLIBS = -ccopt -L$(LIBDWARFW_DIR) -ccopt -Wl,-rpath,$(LIBDWARFW_DIR) -cclib -lz -cclib -lelf -cclib -ldwarf -cclib -ldwarfw
 
-all: test_dw.bin
+
+all: test_dw.bin ml_dwarf_write.bin
 
 test_%.bin: test_%.o dwarf_write.o
-	gcc $(CFLAGS) $(CLIBS) $^ -o $@
+	gcc $(CFLAGS) $^ /usr/lib/x86_64-linux-gnu/libelf.a $(CLIBS) -o $@
 
 %.o: %.c
 	gcc $(CFLAGS) -c $< -o $@
 
+ml_dwarf_write.bin: ml_dwarf_write.ml dwarf_write_stubs.c dwarf_write.o
+	ocamlopt -c dwarf_write_stubs.c
+	ocamlopt -o ml_dwarf_write.bin ml_dwarf_write.ml dwarf_write_stubs.o dwarf_write.o $(OCAMLCLIBS)
+
 clean:
-	rm -f *.o test_*.bin
+	rm -f *.o *.bin
+
+.PRECIOUS: %.o 

DwarfSynth/c_bindings/dwarf_write.h

@@ -10,7 +10,7 @@
 
 #include "../../libdwarfw/include/dwarfw.h"
 
-#include <dwarf.h>
+#include <libdwarf/dwarf.h>
 #include <gelf.h>
 #include <string.h>
 #include <stdint.h>

DwarfSynth/c_bindings/dwarf_write_stubs.c

@@ -0,0 +1,161 @@
+#include "dwarf_write.h"
+
+#include <stdlib.h>
+
+#include <caml/mlvalues.h>
+#include <caml/memory.h>
+#include <caml/alloc.h>
+#include <caml/custom.h>
+
+/* dump functions */
+
+void dump_pre_dwarf_entry(struct pre_dwarf_entry e) {
+  printf("    %lx  %d + %lld\n", e.location, e.cfa_offset_reg, e.cfa_offset);
+}
+
+void dump_pre_dwarf_fde(struct pre_dwarf_fde f) {
+  printf("%ld\n", f.num); 
+  printf("%lx  %lx\n", f.initial_location, f.end_location);
+  for (int i=0; i < f.num; i++)
+    dump_pre_dwarf_entry(f.entries[i]);
+}
+  
+void dump_pre_dwarf (struct pre_dwarf p) {
+  printf("num_fde: %ld \n", p.num_fde);
+  for (int i=0; i < p.num_fde; i++) {
+    dump_pre_dwarf_fde(p.fdes[i]);
+  }
+}
+
+void margin (int n)
+  { while (n-- > 0) printf(".");  return; }
+
+void print_block (value v,int m) 
+{
+  int size, i;
+  margin(m);
+  if (Is_long(v)) 
+    { printf("immediate value (%ld)\n", Long_val(v));  return; };
+  printf ("memory block: size=%d  -  ", size=Wosize_val(v));
+  switch (Tag_val(v))
+   {
+    case Closure_tag : 
+        printf("closure with %d free variables\n", size-1);
+        margin(m+4); printf("code pointer: %p\n",Code_val(v)) ;
+        for (i=1;i<size;i++)  print_block(Field(v,i), m+4);
+        break;
+    case String_tag :
+        printf("string: %s (%s)\n", String_val(v),(char *) v);  
+        break;
+    case Double_tag:  
+        printf("float: %g\n", Double_val(v));
+        break;
+    case Double_array_tag : 
+        printf ("float array: "); 
+        for (i=0;i<size/Double_wosize;i++)  printf("  %g", Double_field(v,i));
+        printf("\n");
+        break;
+    case Abstract_tag : printf("abstract type\n"); break;
+      //    case Final_tag : printf("abstract finalized type\n"); break;
+    default:  
+        if (Tag_val(v)>=No_scan_tag) { printf("unknown tag"); break; }; 
+        printf("structured block (tag=%d):\n",Tag_val(v));
+        for (i=0;i<size;i++)  print_block(Field(v,i),m+4);
+   }
+  return ;
+}
+
+value inspect_block (value v)  
+  { print_block(v,4); fflush(stdout); return v; }
+
+
+/* conversion functions */
+
+long int64_of_value(value v) {
+  union { int i[2]; long j; } buffer;
+  buffer.i[0] = ((int *) Data_custom_val(v))[0];
+  buffer.i[1] = ((int *) Data_custom_val(v))[1];
+  return buffer.j;
+}
+
+addr_t convert_addr_t(value addr) {
+  CAMLparam1(addr);
+  return (addr_t) int64_of_value(addr);
+} 
+
+
+reg_t convert_reg_t(value reg) {
+  CAMLparam1(reg);
+  return (reg_t) Int_val(reg);
+}
+
+offset_t convert_offset_t(value offset) {
+  CAMLparam1(offset);
+  return (offset_t) int64_of_value(offset);
+}
+
+struct pre_dwarf_entry * convert_pre_dwarf_entry(value oc_pde) {
+
+  struct pre_dwarf_entry *pde = malloc(sizeof(struct pre_dwarf_entry));
+
+  CAMLparam1(oc_pde);
+
+  pde->location = convert_addr_t(Field(oc_pde, 0));
+  pde->cfa_offset = convert_offset_t(Field(oc_pde, 1));
+  pde->cfa_offset_reg = convert_reg_t(Field(oc_pde, 2));
+
+  return pde;
+}
+
+struct pre_dwarf_fde convert_pre_dwarf_fde(value oc_pre_dwarf_fde) {
+  
+  struct pre_dwarf_fde * pre_dwarf_fde = malloc(sizeof(struct pre_dwarf_fde));
+
+  CAMLparam1(oc_pre_dwarf_fde);
+
+  pre_dwarf_fde->num = Int_val(Field(oc_pre_dwarf_fde,0));
+  pre_dwarf_fde->initial_location = int64_of_value (Field(oc_pre_dwarf_fde,1));
+  pre_dwarf_fde->end_location = int64_of_value(Field(oc_pre_dwarf_fde,2));
+  
+  // FZ: is num the correct size?  we can also read the size from the array.
+  
+  pre_dwarf_fde->entries = malloc(sizeof(struct pre_dwarf_entry) * pre_dwarf_fde->num);
+
+  for (unsigned int i=0; i < pre_dwarf_fde->num; i++)
+    pre_dwarf_fde->entries[i] = *convert_pre_dwarf_entry(Field(Field(oc_pre_dwarf_fde,4),i));
+  
+  return *pre_dwarf_fde;
+}
+
+struct pre_dwarf * convert_pre_dwarf(value oc_pre_dwarf) {
+  struct pre_dwarf * pre_dwarf = malloc(sizeof(struct pre_dwarf));
+
+  pre_dwarf->num_fde = (size_t) Int_val(Field(oc_pre_dwarf,0));
+
+  //array
+  
+  pre_dwarf->fdes = malloc(sizeof(struct pre_dwarf_fde) * pre_dwarf->num_fde);
+  for (unsigned int i=0; i < pre_dwarf->num_fde; i++) {
+    pre_dwarf->fdes[i] = convert_pre_dwarf_fde(Field(Field(oc_pre_dwarf,1),i));
+  }
+  return pre_dwarf;
+}
+
+// OCaml type: string -> pre_c_dwarf -> int
+value caml_write_dwarf (value oc_obj_path, value oc_pre_dwarf) {
+
+  char *obj_path;
+  struct pre_dwarf *pre_dwarf;
+
+  CAMLparam2(oc_obj_path, oc_pre_dwarf);
+
+  //  inspect_block(oc_pre_dwarf);
+
+  obj_path = String_val(oc_obj_path);
+
+  pre_dwarf = convert_pre_dwarf(oc_pre_dwarf);
+
+  dump_pre_dwarf(*pre_dwarf);
+  
+  CAMLreturn(write_dwarf(obj_path, pre_dwarf));
+}

DwarfSynth/c_bindings/ml_dwarf_write.ml

@@ -0,0 +1,47 @@
+(* copy here as quick hack / restructure the file directory *)
+
+type pre_c_pre_dwarf_entry = {
+  location: int64;
+  cfa_offset: int64;
+  cfa_offset_reg: int
+}
+
+type pre_c_pre_dwarf_fde = {
+  num: int;
+  initial_location: int64;
+  end_location: int64;
+  name: string;
+  entries: pre_c_pre_dwarf_entry array
+}
+
+type pre_c_pre_dwarf = {
+  num_fde: int;
+  fdes: pre_c_pre_dwarf_fde array
+}
+
+let dump_pre_c_pre_dwarf_entry e =
+  Printf.printf "  %8Lx  %d+%Ld \n" e.location e.cfa_offset_reg e.cfa_offset
+  
+let dump_pre_c_pre_dwarf_fde f =
+  Printf.printf "%s  %Lx  %Lx\n" f.name f.initial_location f.end_location;
+  for i = 0 to Array.length f.entries - 1 do
+    dump_pre_c_pre_dwarf_entry f.entries.(i)
+  done
+      
+  
+let dump_pre_c_pre_dwarf p =
+  for i = 0 to Array.length p.fdes - 1 do
+    dump_pre_c_pre_dwarf_fde p.fdes.(i)
+  done
+
+                     
+external write_dwarf : string -> pre_c_pre_dwarf -> int = "caml_write_dwarf" 
+
+(* use: ml_dwarf_write <marshalled_data> <executable> *)
+                                                        
+let _ =
+  let fd = open_in_bin Sys.argv.(1) in
+  let pre_c_dwarf = ((Marshal.from_channel fd): pre_c_pre_dwarf) in
+  dump_pre_c_pre_dwarf pre_c_dwarf;
+  write_dwarf Sys.argv.(2) pre_c_dwarf
+

Makefile

@@ -1,4 +1,4 @@
-OCAMLBUILD=bapbuild
+OCAMLBUILD=bapbuild -no-hygiene
 BAPBUNDLE=bapbundle
 ROOT_MODULE=dwarfsynth
 

_tags

@@ -7,3 +7,4 @@ true: bin_annot
 <DwarfSynth/OnlyUnwind.cmx>: for-pack(DwarfSynth)
 <DwarfSynth/Simplest.cmx>: for-pack(DwarfSynth)
 <DwarfSynth/Frontend.cmx>: for-pack(DwarfSynth)
+<DwarfSynth/PreCBinding.cmx>: for-pack(DwarfSynth)