initial commit of ocaml->c wrappers. as bap linking is already complicated, two independent binaries communicate via a tmp.marshall file for now.
This commit is contained in:
parent
828abdf495
commit
484b20c732
|
@ -5,3 +5,5 @@ Regs
|
||||||
OnlyUnwind
|
OnlyUnwind
|
||||||
Simplest
|
Simplest
|
||||||
Frontend
|
Frontend
|
||||||
|
PreCBinding
|
||||||
|
|
||||||
|
|
|
@ -2,4 +2,9 @@ open Std
|
||||||
|
|
||||||
let main outfile proj =
|
let main outfile proj =
|
||||||
let pre_dwarf = Simplest.of_proj proj in
|
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 []
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -20,6 +20,10 @@ type pre_c_pre_dwarf = {
|
||||||
fdes: pre_c_pre_dwarf_fde array
|
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` *)
|
(** Empty default value for `pre_c_pre_dwarf_entry` *)
|
||||||
|
|
|
@ -1,15 +1,23 @@
|
||||||
CDEFINE =
|
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
|
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
|
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
|
%.o: %.c
|
||||||
gcc $(CFLAGS) -c $< -o $@
|
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:
|
clean:
|
||||||
rm -f *.o test_*.bin
|
rm -f *.o *.bin
|
||||||
|
|
||||||
|
.PRECIOUS: %.o
|
||||||
|
|
|
@ -10,7 +10,7 @@
|
||||||
|
|
||||||
#include "../../libdwarfw/include/dwarfw.h"
|
#include "../../libdwarfw/include/dwarfw.h"
|
||||||
|
|
||||||
#include <dwarf.h>
|
#include <libdwarf/dwarf.h>
|
||||||
#include <gelf.h>
|
#include <gelf.h>
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
#include <stdint.h>
|
#include <stdint.h>
|
||||||
|
|
|
@ -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));
|
||||||
|
}
|
|
@ -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
2
Makefile
|
@ -1,4 +1,4 @@
|
||||||
OCAMLBUILD=bapbuild
|
OCAMLBUILD=bapbuild -no-hygiene
|
||||||
BAPBUNDLE=bapbundle
|
BAPBUNDLE=bapbundle
|
||||||
ROOT_MODULE=dwarfsynth
|
ROOT_MODULE=dwarfsynth
|
||||||
|
|
||||||
|
|
1
_tags
1
_tags
|
@ -7,3 +7,4 @@ true: bin_annot
|
||||||
<DwarfSynth/OnlyUnwind.cmx>: for-pack(DwarfSynth)
|
<DwarfSynth/OnlyUnwind.cmx>: for-pack(DwarfSynth)
|
||||||
<DwarfSynth/Simplest.cmx>: for-pack(DwarfSynth)
|
<DwarfSynth/Simplest.cmx>: for-pack(DwarfSynth)
|
||||||
<DwarfSynth/Frontend.cmx>: for-pack(DwarfSynth)
|
<DwarfSynth/Frontend.cmx>: for-pack(DwarfSynth)
|
||||||
|
<DwarfSynth/PreCBinding.cmx>: for-pack(DwarfSynth)
|
||||||
|
|
Loading…
Reference in New Issue