@ -1014,24 +1014,19 @@ let xlate_instr :
| " llvm " :: " experimental " :: " gc " :: " statepoint " :: _ ->
| " llvm " :: " experimental " :: " gc " :: " statepoint " :: _ ->
todo " statepoints:@ %a " pp_llvalue instr ()
todo " statepoints:@ %a " pp_llvalue instr ()
| [ " __llair_throw " ] ->
| [ " __llair_throw " ] ->
let key = Exp . integer Z . zero in
let dst = Llair . Jump . mk unwind_dst args in
let tbl = Vector . empty in
terminal [] ( Llair . Term . goto ~ dst ~ loc ) []
let els = Llair . Jump . mk unwind_dst args in
terminal [] ( Llair . Term . switch ~ key ~ tbl ~ els ~ loc ) []
| [ " _Znwm " ] ->
| [ " _Znwm " ] ->
let reg = xlate_name_opt x instr in
let reg = xlate_name_opt x instr in
let num = xlate_value x ( Llvm . operand instr 0 ) in
let num = xlate_value x ( Llvm . operand instr 0 ) in
let llt = Llvm . type_of instr in
let llt = Llvm . type_of instr in
let len = Exp . integer ( Z . of_int ( size_of x llt ) ) in
let len = Exp . integer ( Z . of_int ( size_of x llt ) ) in
let key = Exp . integer Z . zero in
let tbl = Vector . empty in
let blk = Llvm . get_normal_dest instr in
let blk = Llvm . get_normal_dest instr in
let dst = label_of_block blk in
let args = jump_args x instr blk in
let args = jump_args x instr blk in
let els = Llair . Jump . mk dst args in
let dst = Llair . Jump . mk ( label_of_block blk ) args in
terminal
terminal
[ Llair . Inst . alloc ~ reg : ( Option . value_exn reg ) ~ num ~ len ~ loc ]
[ Llair . Inst . alloc ~ reg : ( Option . value_exn reg ) ~ num ~ len ~ loc ]
( Llair . Term . switch ~ key ~ tbl ~ els ~ loc )
( Llair . Term . goto ~ dst ~ loc )
[]
[]
| _ ->
| _ ->
let func = xlate_func_name x llfunc in
let func = xlate_func_name x llfunc in
@ -1054,12 +1049,8 @@ let xlate_instr :
let params = [ xlate_name instr ] in
let params = [ xlate_name instr ] in
let cmnd = Vector . empty in
let cmnd = Vector . empty in
let term =
let term =
let key = Exp . integer Z . zero in
let dst = Llair . Jump . mk ( label_of_block blk ) args in
let tbl = Vector . empty in
Llair . Term . goto ~ dst ~ loc
let dst = label_of_block blk in
let args = jump_args x instr blk in
let els = Llair . Jump . mk dst args in
Llair . Term . switch ~ key ~ tbl ~ els ~ loc
in
in
Llair . Block . mk ~ lbl ~ params ~ cmnd ~ term
Llair . Block . mk ~ lbl ~ params ~ cmnd ~ term
in
in
@ -1083,12 +1074,9 @@ let xlate_instr :
| Br -> (
| Br -> (
match Option . value_exn ( Llvm . get_branch instr ) with
match Option . value_exn ( Llvm . get_branch instr ) with
| ` Unconditional blk ->
| ` Unconditional blk ->
let key = Exp . integer Z . zero in
let tbl = Vector . empty in
let dst = label_of_block blk in
let args = jump_args x instr blk in
let args = jump_args x instr blk in
let els = Llair . Jump . mk dst args in
let dst = Llair . Jump . mk ( label_of_block blk ) args in
terminal [] ( Llair . Term . switch ~ key ~ tbl ~ els ~ loc ) []
terminal [] ( Llair . Term . goto ~ dst ~ loc ) []
| ` Conditional ( cnd , thn , els ) ->
| ` Conditional ( cnd , thn , els ) ->
let key = xlate_value x cnd in
let key = xlate_value x cnd in
let thn_lbl = label_of_block thn in
let thn_lbl = label_of_block thn in
@ -1181,10 +1169,8 @@ let xlate_instr :
Llair . Jump . mk dst args
Llair . Jump . mk dst args
in
in
let goto_unwind sel =
let goto_unwind sel =
let key = Exp . integer Z . zero in
let dst = jump_unwind sel in
let tbl = Vector . empty in
Llair . Term . goto ~ dst ~ loc
let els = jump_unwind sel in
Llair . Term . switch ~ key ~ tbl ~ els ~ loc
in
in
let term_unwind , rev_blocks =
let term_unwind , rev_blocks =
if Llvm . is_cleanup instr then ( goto_unwind ( Exp . integer Z . zero ) , [] )
if Llvm . is_cleanup instr then ( goto_unwind ( Exp . integer Z . zero ) , [] )
@ -1201,11 +1187,7 @@ let xlate_instr :
let xlate_clause i =
let xlate_clause i =
let clause = Llvm . operand instr i in
let clause = Llvm . operand instr i in
let num_tis = Llvm . num_operands clause in
let num_tis = Llvm . num_operands clause in
if num_tis = 0 then
if num_tis = 0 then Llair . Term . goto ~ dst : match_filter ~ loc
let key = Exp . integer Z . zero in
let tbl = Vector . empty in
let els = match_filter in
Llair . Term . switch ~ key ~ tbl ~ els ~ loc
else
else
match Llvm . classify_type ( Llvm . type_of clause ) with
match Llvm . classify_type ( Llvm . type_of clause ) with
| Array (* filter *) -> (
| Array (* filter *) -> (