Source file insert_copy_and_fix_length.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
open Utils
open Prog
module L = Location
let is_array_copy (x:lval) (e:expr) =
match x with
| Lvar x ->
let x = L.unloc x in
begin match x.v_ty with
| Arr (xws, xn) ->
begin match e with
| Pvar y ->
let y = L.unloc y.gv in
begin match y.v_ty with
| Arr(yws, yn) ->
if arr_size yws yn < arr_size xws xn then None else
if x.v_kind = Reg(Normal, Direct) then Some (xws, xn)
else if y.v_kind = Reg(Normal, Direct) then Some (yws, arr_size xws xn / size_of_ws yws)
else None
| _ -> None
end
| _ -> None
end
| _ -> None
end
| _ -> None
let size_of_lval =
function
| Lvar x -> size_of (L.unloc x).v_ty
| Lasub (_, ws, len, _, _) -> arr_size ws len
| Lnone _ | Lmem _ | Laset _ -> assert false
let rec iac_stmt pd is = List.map (iac_instr pd) is
and iac_instr pd i = { i with i_desc = iac_instr_r pd i.i_loc i.i_desc }
and iac_instr_r pd loc ir =
match ir with
| Cassgn (x, t, _, e) ->
if !Glob_options.introduce_array_copy then
match is_array_copy x e with
| None -> ir
| Some (ws, n) ->
Typing.check_length loc n;
warning IntroduceArrayCopy
loc "an array copy is introduced";
let op = Pseudo_operator.Ocopy(ws, Conv.pos_of_int n) in
Copn([x], t, Sopn.Opseudo_op op, [e])
else ir
| Cif (b, th, el) -> Cif (b, iac_stmt pd th, iac_stmt pd el)
| Cfor (i, r, s) -> Cfor (i, r, iac_stmt pd s)
| Cwhile (a, c1, t, info, c2) -> Cwhile (a, iac_stmt pd c1, t, info, iac_stmt pd c2)
| Copn (xs,t,o,es) ->
begin match o, xs with
| Sopn.Opseudo_op(Pseudo_operator.Ospill(o,_)), _ ->
let tys = List.map (fun e -> Conv.cty_of_ty (Typing.ty_expr pd loc e)) es in
Copn(xs,t, Sopn.Opseudo_op(Pseudo_operator.Ospill(o, tys)), es)
| Sopn.Opseudo_op(Pseudo_operator.Ocopy(ws, _)), [x] ->
let xn = size_of_lval x in
let wsn = size_of_ws ws in
if xn mod wsn <> 0 then
Typing.error loc
"the destination %a has size %i: it should be a multiple of %i"
(Printer.pp_lval ~debug:false) x
xn wsn
else
let len = xn / wsn in
Typing.check_length loc len;
let op = Pseudo_operator.Ocopy (ws, Conv.pos_of_int len) in
Copn(xs,t,Sopn.Opseudo_op op, es)
| Sopn.Opseudo_op(Pseudo_operator.Oswap _), x::_ ->
let ty = Conv.cty_of_ty (Typing.ty_lval pd loc x) in
Copn(xs, t, Sopn.Opseudo_op(Pseudo_operator.Oswap ty), es)
| Sopn.Oslh (SLHprotect_ptr _), [Lvar x] ->
let xn = size_of (L.unloc x).v_ty in
Typing.check_length loc xn;
let op = Slh_ops.SLHprotect_ptr (Conv.pos_of_int xn) in
Copn(xs,t, Sopn.Oslh op, es)
| (Sopn.Opseudo_op(Pseudo_operator.Ocopy _) | Sopn.Oslh (SLHprotect_ptr _)), _ -> assert false
| _ -> ir
end
| Csyscall(xs, o, es) ->
begin match o with
| Syscall_t.RandomBytes _ ->
let ty =
match xs with
| [x] -> Typing.ty_lval pd loc x
| _ -> assert false in
let p = Conv.pos_of_int (Prog.size_of ty) in
Csyscall(xs, Syscall_t.RandomBytes p, es)
end
| Ccall _ -> ir
let iac_func pd f =
{ f with f_body = iac_stmt pd f.f_body }
let doit pd (p:(unit, 'asm) Prog.prog) : (unit, 'asm) Prog.prog =
(fst p, List.map (iac_func pd) (snd p))