Browse Source

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

write_dwarf
Francesco Zappa Nardelli 4 years ago
parent
commit
484b20c732
  1. 2
      DwarfSynth.mlpack
  2. 7
      DwarfSynth/Main.ml
  3. 4
      DwarfSynth/PreCBinding.ml
  4. 18
      DwarfSynth/c_bindings/Makefile
  5. 2
      DwarfSynth/c_bindings/dwarf_write.h
  6. 161
      DwarfSynth/c_bindings/dwarf_write_stubs.c
  7. 47
      DwarfSynth/c_bindings/ml_dwarf_write.ml
  8. 2
      Makefile
  9. 1
      _tags

2
DwarfSynth.mlpack

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

7
DwarfSynth/Main.ml

@ -2,4 +2,9 @@ open Std @@ -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 []

4
DwarfSynth/PreCBinding.ml

@ -20,6 +20,10 @@ type pre_c_pre_dwarf = { @@ -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` *)

18
DwarfSynth/c_bindings/Makefile

@ -1,15 +1,23 @@ @@ -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

2
DwarfSynth/c_bindings/dwarf_write.h

@ -10,7 +10,7 @@ @@ -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>

161
DwarfSynth/c_bindings/dwarf_write_stubs.c

@ -0,0 +1,161 @@ @@ -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));
}

47
DwarfSynth/c_bindings/ml_dwarf_write.ml

@ -0,0 +1,47 @@ @@ -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

2
Makefile

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

1
_tags

@ -7,3 +7,4 @@ true: bin_annot @@ -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)

Loading…
Cancel
Save