forked from Alasdair/armdecode
-
Notifications
You must be signed in to change notification settings - Fork 0
/
armdecode.ml
148 lines (134 loc) · 4.93 KB
/
armdecode.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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
open Libsail
open Ast
open Ast_defs
open Ast_util
let invalid_decode str = prerr_endline ("invalid decode " ^ str); exit 1
let string_of_arg = function
| E_aux (E_id id, _) -> "\"" ^ string_of_id id ^ "\""
| exp -> invalid_decode ("call arg " ^ string_of_exp exp)
let rec get_calls exp = match exp with
| E_aux (E_block exps, _) ->
get_calls (Util.last exps)
| E_aux (E_var (_, _, exp), _) ->
get_calls exp
| E_aux (E_app (f, args), _) ->
print_endline ("call = \"" ^ string_of_id f ^ "\"");
print_endline ("args = [" ^ Util.string_of_list ", " string_of_arg args ^ "]")
| _ -> invalid_decode ("calls " ^ string_of_exp exp)
let bits = function
| Typ_aux (Typ_app (id, [A_aux (A_nexp (Nexp_aux (Nexp_constant n, _)), _)]), _) ->
Big_int.to_int n
| typ -> invalid_decode ("bits " ^ string_of_typ typ)
let slice_info = function
| E_aux (E_app (f, [E_aux (E_id op, _); hi; lo]), _)
when string_of_id op = "op_code" && string_of_id f = "subrange_bits" ->
string_of_exp hi ^ ", " ^ string_of_exp lo
| E_aux (E_vector [E_aux (E_app (f, [E_aux (E_id op, _); bit]), _)], _)
when string_of_id op = "op_code" && string_of_id f = "bitvector_access" ->
string_of_exp bit
| exp -> invalid_decode ("slice_info " ^ string_of_exp exp)
let rec get_slice first exp = match exp with
| E_aux (E_block exps, _) ->
List.fold_left get_slice first exps
| E_aux (E_var (LE_aux (LE_typ (typ, id), _), slice, exp), _) ->
if not first then (
print_string ", "
);
print_string ("\"" ^ string_of_id id ^ "\" = [" ^ slice_info slice ^ "]");
get_slice false exp
| _ ->
first
let get_see exp = match exp with
| E_aux (E_block (E_aux (E_assign (LE_aux (LE_id id, _), number), _) :: _), _) when string_of_id id = "SEE" ->
print_endline ("see = " ^ string_of_exp number)
| _ -> invalid_decode ("SEE " ^ string_of_exp exp)
let to_hex str =
if not (String.length str mod 4 = 0) then
invalid_decode ("to_hex " ^ str)
else
let rec to_hex' n str =
if n <= String.length str - 4 then (
let digit = match String.sub str n 4 with
| "0000" -> "0"
| "0001" -> "1"
| "0010" -> "2"
| "0011" -> "3"
| "0100" -> "4"
| "0101" -> "5"
| "0110" -> "6"
| "0111" -> "7"
| "1000" -> "8"
| "1001" -> "9"
| "1010" -> "a"
| "1011" -> "b"
| "1100" -> "c"
| "1101" -> "d"
| "1110" -> "e"
| "1111" -> "f"
| _ -> failwith "invalid nibble" in
digit ^ to_hex' (n + 4) str
) else (
""
)
in
to_hex' 0 str
let rec get_mask (P_aux (aux, _) as pat) =
let get_mask_part mask (P_aux (aux, _) as pat) =
match aux with
| P_typ (typ, P_aux (P_wild, _)) ->
String.make (bits typ) '0'
| P_lit (L_aux (L_bin str, _)) ->
if mask then (
String.make (String.length str) '1'
) else (
str
)
| _ -> invalid_decode ("get_mask_part " ^ string_of_pat pat)
in
match aux with
| P_vector_concat pats ->
print_endline ("bits = \"" ^ to_hex (Util.string_of_list "" (get_mask_part false) pats) ^ "\"");
print_endline ("mask = \"" ^ to_hex (Util.string_of_list "" (get_mask_part true) pats) ^ "\"")
| P_lit _ ->
print_endline ("bits = \"" ^ to_hex (get_mask_part false pat) ^ "\"");
print_endline ("mask = \"" ^ to_hex (get_mask_part true pat) ^ "\"")
| P_as (pat, id) when string_of_id id = "op_code" ->
get_mask pat
| _ -> invalid_decode ("get_mask" ^ string_of_pat pat)
let arm_decode_info_real ast env =
print_endline (Printf.sprintf "mk_id \"__DecodeA64\": %s" (string_of_id (mk_id "__DecodeA64")));
List.iter (fun def ->
match def with
| DEF_aux (DEF_scattered (SD_aux (SD_funcl (FCL_aux (FCL_funcl (id, pexp), _)), _)), _) when Id.compare id (mk_id "__DecodeA64") = 0 ->
begin match pexp with
| (Pat_aux (Pat_when (pat, _, exp), _) | Pat_aux (Pat_exp (pat, exp), _)) ->
print_endline "[[opcode]]";
get_calls exp;
get_mask pat;
print_string "slice = { ";
let _ = get_slice true exp in
print_endline " }";
get_see exp;
print_string "\n"
end
| _ -> ()
) ast.defs;
exit 0
let arm_decode_info ast env =
print_endline (Printf.sprintf "mk_id \"__DecodeA64\": %s" (string_of_id (mk_id "__DecodeA64")));
List.iter (fun def ->
match def with
(* | DEF_aux (DEF_scattered (SD_aux (SD_funcl (FCL_aux (FCL_funcl (id, pexp), _)), _)), _) -> *)
| foo ->
Format.printf "foo: @[%s@]@." "hello";
(* print_endline (Printf.sprintf "id: %s" (string_of_id id)); *)
print_endline "got match";
()
(* | _ -> () *)
) ast.defs;
exit 0
let _ =
Target.register
~name:"arm_decode"
~pre_descatter_hook:arm_decode_info
Target.empty_action