xref: /aosp_15_r20/external/capstone/bindings/ocaml/ocaml.c (revision 9a0e4156d50a75a99ec4f1653a0e9602a5d45c18)
1 /* Capstone Disassembler Engine */
2 /* By Nguyen Anh Quynh <[email protected]>, 2013> */
3 
4 #include <stdio.h>		// debug
5 #include <string.h>
6 #include <caml/mlvalues.h>
7 #include <caml/memory.h>
8 #include <caml/alloc.h>
9 #include <caml/fail.h>
10 
11 #include "capstone/capstone.h"
12 
13 #define ARR_SIZE(a) (sizeof(a)/sizeof(a[0]))
14 
15 
16 // count the number of positive members in @list
list_count(uint8_t * list,unsigned int max)17 static unsigned int list_count(uint8_t *list, unsigned int max)
18 {
19 	unsigned int i;
20 
21 	for(i = 0; i < max; i++)
22 		if (list[i] == 0)
23 			return i;
24 
25 	return max;
26 }
27 
_cs_disasm(cs_arch arch,csh handle,const uint8_t * code,size_t code_len,uint64_t addr,size_t count)28 CAMLprim value _cs_disasm(cs_arch arch, csh handle, const uint8_t * code, size_t code_len, uint64_t addr, size_t count)
29 {
30 	CAMLparam0();
31 	CAMLlocal5(list, cons, rec_insn, array, tmp);
32 	CAMLlocal4(arch_info, op_info_val, tmp2, tmp3);
33 	cs_insn *insn;
34 	size_t c;
35 
36 	list = Val_emptylist;
37 
38 	c = cs_disasm(handle, code, code_len, addr, count, &insn);
39 	if (c) {
40 		//printf("Found %lu insn, addr: %lx\n", c, addr);
41 		uint64_t j;
42 		for (j = c; j > 0; j--) {
43 			unsigned int lcount, i;
44 			cons = caml_alloc(2, 0);
45 
46 			rec_insn = caml_alloc(10, 0);
47 			Store_field(rec_insn, 0, Val_int(insn[j-1].id));
48 			Store_field(rec_insn, 1, Val_int(insn[j-1].address));
49 			Store_field(rec_insn, 2, Val_int(insn[j-1].size));
50 
51 			// copy raw bytes of instruction
52 			lcount = insn[j-1].size;
53 			if (lcount) {
54 				array = caml_alloc(lcount, 0);
55 				for (i = 0; i < lcount; i++) {
56 					Store_field(array, i, Val_int(insn[j-1].bytes[i]));
57 				}
58 			} else
59 				array = Atom(0);	// empty list
60 			Store_field(rec_insn, 3, array);
61 
62 			Store_field(rec_insn, 4, caml_copy_string(insn[j-1].mnemonic));
63 			Store_field(rec_insn, 5, caml_copy_string(insn[j-1].op_str));
64 
65 			// copy read registers
66 			if (insn[0].detail) {
67 				lcount = (insn[j-1]).detail->regs_read_count;
68 				if (lcount) {
69 					array = caml_alloc(lcount, 0);
70 					for (i = 0; i < lcount; i++) {
71 						Store_field(array, i, Val_int(insn[j-1].detail->regs_read[i]));
72 					}
73 				} else
74 					array = Atom(0);	// empty list
75 			} else
76 				array = Atom(0);	// empty list
77 			Store_field(rec_insn, 6, array);
78 
79 			if (insn[0].detail) {
80 				lcount = (insn[j-1]).detail->regs_write_count;
81 				if (lcount) {
82 					array = caml_alloc(lcount, 0);
83 					for (i = 0; i < lcount; i++) {
84 						Store_field(array, i, Val_int(insn[j-1].detail->regs_write[i]));
85 					}
86 				} else
87 					array = Atom(0);	// empty list
88 			} else
89 				array = Atom(0);	// empty list
90 			Store_field(rec_insn, 7, array);
91 
92 			if (insn[0].detail) {
93 				lcount = (insn[j-1]).detail->groups_count;
94 				if (lcount) {
95 					array = caml_alloc(lcount, 0);
96 					for (i = 0; i < lcount; i++) {
97 						Store_field(array, i, Val_int(insn[j-1].detail->groups[i]));
98 					}
99 				} else
100 					array = Atom(0);	// empty list
101 			} else
102 				array = Atom(0);	// empty list
103 			Store_field(rec_insn, 8, array);
104 
105 			if (insn[j-1].detail) {
106 				switch(arch) {
107 					case CS_ARCH_ARM:
108 						arch_info = caml_alloc(1, 0);
109 
110 						op_info_val = caml_alloc(10, 0);
111 						Store_field(op_info_val, 0, Val_bool(insn[j-1].detail->arm.usermode));
112 						Store_field(op_info_val, 1, Val_int(insn[j-1].detail->arm.vector_size));
113 						Store_field(op_info_val, 2, Val_int(insn[j-1].detail->arm.vector_data));
114 						Store_field(op_info_val, 3, Val_int(insn[j-1].detail->arm.cps_mode));
115 						Store_field(op_info_val, 4, Val_int(insn[j-1].detail->arm.cps_flag));
116 						Store_field(op_info_val, 5, Val_int(insn[j-1].detail->arm.cc));
117 						Store_field(op_info_val, 6, Val_bool(insn[j-1].detail->arm.update_flags));
118 						Store_field(op_info_val, 7, Val_bool(insn[j-1].detail->arm.writeback));
119 						Store_field(op_info_val, 8, Val_int(insn[j-1].detail->arm.mem_barrier));
120 
121 						lcount = insn[j-1].detail->arm.op_count;
122 						if (lcount > 0) {
123 							array = caml_alloc(lcount, 0);
124 							for (i = 0; i < lcount; i++) {
125 								tmp2 = caml_alloc(6, 0);
126 								switch(insn[j-1].detail->arm.operands[i].type) {
127 									case ARM_OP_REG:
128 									case ARM_OP_SYSREG:
129 										tmp = caml_alloc(1, 1);
130 										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm.operands[i].reg));
131 										break;
132 									case ARM_OP_CIMM:
133 										tmp = caml_alloc(1, 2);
134 										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm.operands[i].imm));
135 										break;
136 									case ARM_OP_PIMM:
137 										tmp = caml_alloc(1, 3);
138 										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm.operands[i].imm));
139 										break;
140 									case ARM_OP_IMM:
141 										tmp = caml_alloc(1, 4);
142 										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm.operands[i].imm));
143 										break;
144 									case ARM_OP_FP:
145 										tmp = caml_alloc(1, 5);
146 										Store_field(tmp, 0, caml_copy_double(insn[j-1].detail->arm.operands[i].fp));
147 										break;
148 									case ARM_OP_MEM:
149 										tmp = caml_alloc(1, 6);
150 										tmp3 = caml_alloc(5, 0);
151 										Store_field(tmp3, 0, Val_int(insn[j-1].detail->arm.operands[i].mem.base));
152 										Store_field(tmp3, 1, Val_int(insn[j-1].detail->arm.operands[i].mem.index));
153 										Store_field(tmp3, 2, Val_int(insn[j-1].detail->arm.operands[i].mem.scale));
154 										Store_field(tmp3, 3, Val_int(insn[j-1].detail->arm.operands[i].mem.disp));
155 										Store_field(tmp3, 4, Val_int(insn[j-1].detail->arm.operands[i].mem.lshift));
156 										Store_field(tmp, 0, tmp3);
157 										break;
158 									case ARM_OP_SETEND:
159 										tmp = caml_alloc(1, 7);
160 										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm.operands[i].setend));
161 										break;
162 									default: break;
163 								}
164 								tmp3 = caml_alloc(2, 0);
165 								Store_field(tmp3, 0, Val_int(insn[j-1].detail->arm.operands[i].shift.type));
166 								Store_field(tmp3, 1, Val_int(insn[j-1].detail->arm.operands[i].shift.value));
167 								Store_field(tmp2, 0, Val_int(insn[j-1].detail->arm.operands[i].vector_index));
168 								Store_field(tmp2, 1, tmp3);
169 								Store_field(tmp2, 2, tmp);
170 								Store_field(tmp2, 3, Val_bool(insn[j-1].detail->arm.operands[i].subtracted));
171 								Store_field(tmp2, 4, Val_int(insn[j-1].detail->arm.operands[i].access));
172 								Store_field(tmp2, 5, Val_int(insn[j-1].detail->arm.operands[i].neon_lane));
173 								Store_field(array, i, tmp2);
174 							}
175 						} else	// empty list
176 							array = Atom(0);
177 
178 						Store_field(op_info_val, 9, array);
179 
180 						// finally, insert this into arch_info
181 						Store_field(arch_info, 0, op_info_val);
182 
183 						Store_field(rec_insn, 9, arch_info);
184 
185 						break;
186 					case CS_ARCH_ARM64:
187 						arch_info = caml_alloc(1, 1);
188 
189 						op_info_val = caml_alloc(4, 0);
190 						Store_field(op_info_val, 0, Val_int(insn[j-1].detail->arm64.cc));
191 						Store_field(op_info_val, 1, Val_bool(insn[j-1].detail->arm64.update_flags));
192 						Store_field(op_info_val, 2, Val_bool(insn[j-1].detail->arm64.writeback));
193 
194 						lcount = insn[j-1].detail->arm64.op_count;
195 						if (lcount > 0) {
196 							array = caml_alloc(lcount, 0);
197 							for (i = 0; i < lcount; i++) {
198 								tmp2 = caml_alloc(6, 0);
199 								switch(insn[j-1].detail->arm64.operands[i].type) {
200 									case ARM64_OP_REG:
201 										tmp = caml_alloc(1, 1);
202 										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm64.operands[i].reg));
203 										break;
204 									case ARM64_OP_CIMM:
205 										tmp = caml_alloc(1, 2);
206 										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm64.operands[i].imm));
207 										break;
208 									case ARM64_OP_IMM:
209 										tmp = caml_alloc(1, 3);
210 										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm64.operands[i].imm));
211 										break;
212 									case ARM64_OP_FP:
213 										tmp = caml_alloc(1, 4);
214 										Store_field(tmp, 0, caml_copy_double(insn[j-1].detail->arm64.operands[i].fp));
215 										break;
216 									case ARM64_OP_MEM:
217 										tmp = caml_alloc(1, 5);
218 										tmp3 = caml_alloc(3, 0);
219 										Store_field(tmp3, 0, Val_int(insn[j-1].detail->arm64.operands[i].mem.base));
220 										Store_field(tmp3, 1, Val_int(insn[j-1].detail->arm64.operands[i].mem.index));
221 										Store_field(tmp3, 2, Val_int(insn[j-1].detail->arm64.operands[i].mem.disp));
222 										Store_field(tmp, 0, tmp3);
223 										break;
224 									case ARM64_OP_REG_MRS:
225 										tmp = caml_alloc(1, 6);
226 										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm64.operands[i].reg));
227 										break;
228 									case ARM64_OP_REG_MSR:
229 										tmp = caml_alloc(1, 7);
230 										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm64.operands[i].reg));
231 										break;
232 									case ARM64_OP_PSTATE:
233 										tmp = caml_alloc(1, 8);
234 										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm64.operands[i].pstate));
235 										break;
236 									case ARM64_OP_SYS:
237 										tmp = caml_alloc(1, 9);
238 										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm64.operands[i].sys));
239 										break;
240 									case ARM64_OP_PREFETCH:
241 										tmp = caml_alloc(1, 10);
242 										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm64.operands[i].prefetch));
243 										break;
244 									case ARM64_OP_BARRIER:
245 										tmp = caml_alloc(1, 11);
246 										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm64.operands[i].barrier));
247 										break;
248 									default: break;
249 								}
250 								tmp3 = caml_alloc(2, 0);
251 								Store_field(tmp3, 0, Val_int(insn[j-1].detail->arm64.operands[i].shift.type));
252 								Store_field(tmp3, 1, Val_int(insn[j-1].detail->arm64.operands[i].shift.value));
253 
254 								Store_field(tmp2, 0, Val_int(insn[j-1].detail->arm64.operands[i].vector_index));
255 								Store_field(tmp2, 1, Val_int(insn[j-1].detail->arm64.operands[i].vas));
256 								Store_field(tmp2, 2, Val_int(insn[j-1].detail->arm64.operands[i].vess));
257 								Store_field(tmp2, 3, tmp3);
258 								Store_field(tmp2, 4, Val_int(insn[j-1].detail->arm64.operands[i].ext));
259 								Store_field(tmp2, 5, tmp);
260 
261 								Store_field(array, i, tmp2);
262 							}
263 						} else	// empty array
264 							array = Atom(0);
265 
266 						Store_field(op_info_val, 3, array);
267 
268 						// finally, insert this into arch_info
269 						Store_field(arch_info, 0, op_info_val);
270 
271 						Store_field(rec_insn, 9, arch_info);
272 
273 						break;
274 					case CS_ARCH_MIPS:
275 						arch_info = caml_alloc(1, 2);
276 
277 						op_info_val = caml_alloc(1, 0);
278 
279 						lcount = insn[j-1].detail->mips.op_count;
280 						if (lcount > 0) {
281 							array = caml_alloc(lcount, 0);
282 							for (i = 0; i < lcount; i++) {
283 								tmp2 = caml_alloc(1, 0);
284 								switch(insn[j-1].detail->mips.operands[i].type) {
285 									case MIPS_OP_REG:
286 										tmp = caml_alloc(1, 1);
287 										Store_field(tmp, 0, Val_int(insn[j-1].detail->mips.operands[i].reg));
288 										break;
289 									case MIPS_OP_IMM:
290 										tmp = caml_alloc(1, 2);
291 										Store_field(tmp, 0, Val_int(insn[j-1].detail->mips.operands[i].imm));
292 										break;
293 									case MIPS_OP_MEM:
294 										tmp = caml_alloc(1, 3);
295 										tmp3 = caml_alloc(2, 0);
296 										Store_field(tmp3, 0, Val_int(insn[j-1].detail->mips.operands[i].mem.base));
297 										Store_field(tmp3, 1, Val_int(insn[j-1].detail->mips.operands[i].mem.disp));
298 										Store_field(tmp, 0, tmp3);
299 										break;
300 									default: break;
301 								}
302 								Store_field(tmp2, 0, tmp);
303 								Store_field(array, i, tmp2);
304 							}
305 						} else	// empty array
306 							array = Atom(0);
307 
308 						Store_field(op_info_val, 0, array);
309 
310 						// finally, insert this into arch_info
311 						Store_field(arch_info, 0, op_info_val);
312 
313 						Store_field(rec_insn, 9, arch_info);
314 
315 						break;
316 					case CS_ARCH_X86:
317 						arch_info = caml_alloc(1, 3);
318 
319 						op_info_val = caml_alloc(17, 0);
320 
321 						// fill prefix
322 						lcount = list_count(insn[j-1].detail->x86.prefix, ARR_SIZE(insn[j-1].detail->x86.prefix));
323 						if (lcount) {
324 							array = caml_alloc(lcount, 0);
325 							for (i = 0; i < lcount; i++) {
326 								Store_field(array, i, Val_int(insn[j-1].detail->x86.prefix[i]));
327 							}
328 						} else
329 							array = Atom(0);
330 						Store_field(op_info_val, 0, array);
331 
332 						// fill opcode
333 						lcount = list_count(insn[j-1].detail->x86.opcode, ARR_SIZE(insn[j-1].detail->x86.opcode));
334 						if (lcount) {
335 							array = caml_alloc(lcount, 0);
336 							for (i = 0; i < lcount; i++) {
337 								Store_field(array, i, Val_int(insn[j-1].detail->x86.opcode[i]));
338 							}
339 						} else
340 							array = Atom(0);
341 						Store_field(op_info_val, 1, array);
342 
343 						Store_field(op_info_val, 2, Val_int(insn[j-1].detail->x86.rex));
344 
345 						Store_field(op_info_val, 3, Val_int(insn[j-1].detail->x86.addr_size));
346 
347 						Store_field(op_info_val, 4, Val_int(insn[j-1].detail->x86.modrm));
348 
349 						Store_field(op_info_val, 5, Val_int(insn[j-1].detail->x86.sib));
350 
351 						Store_field(op_info_val, 6, Val_int(insn[j-1].detail->x86.disp));
352 
353 						Store_field(op_info_val, 7, Val_int(insn[j-1].detail->x86.sib_index));
354 
355 						Store_field(op_info_val, 8, Val_int(insn[j-1].detail->x86.sib_scale));
356 
357 						Store_field(op_info_val, 9, Val_int(insn[j-1].detail->x86.sib_base));
358 
359 						Store_field(op_info_val, 10, Val_int(insn[j-1].detail->x86.xop_cc));
360 						Store_field(op_info_val, 11, Val_int(insn[j-1].detail->x86.sse_cc));
361 						Store_field(op_info_val, 12, Val_int(insn[j-1].detail->x86.avx_cc));
362 						Store_field(op_info_val, 13, Val_int(insn[j-1].detail->x86.avx_sae));
363 						Store_field(op_info_val, 14, Val_int(insn[j-1].detail->x86.avx_rm));
364 						Store_field(op_info_val, 15, Val_int(insn[j-1].detail->x86.eflags));
365 
366 						lcount = insn[j-1].detail->x86.op_count;
367 						if (lcount > 0) {
368 							array = caml_alloc(lcount, 0);
369 							for (i = 0; i < lcount; i++) {
370 								switch(insn[j-1].detail->x86.operands[i].type) {
371 									case X86_OP_REG:
372 										tmp = caml_alloc(1, 1);
373 										Store_field(tmp, 0, Val_int(insn[j-1].detail->x86.operands[i].reg));
374 										break;
375 									case X86_OP_IMM:
376 										tmp = caml_alloc(1, 2);
377 										Store_field(tmp, 0, Val_int(insn[j-1].detail->x86.operands[i].imm));
378 										break;
379 									case X86_OP_MEM:
380 										tmp = caml_alloc(1, 3);
381 										tmp2 = caml_alloc(5, 0);
382 										Store_field(tmp2, 0, Val_int(insn[j-1].detail->x86.operands[i].mem.segment));
383 										Store_field(tmp2, 1, Val_int(insn[j-1].detail->x86.operands[i].mem.base));
384 										Store_field(tmp2, 2, Val_int(insn[j-1].detail->x86.operands[i].mem.index));
385 										Store_field(tmp2, 3, Val_int(insn[j-1].detail->x86.operands[i].mem.scale));
386 										Store_field(tmp2, 4, Val_int(insn[j-1].detail->x86.operands[i].mem.disp));
387 
388 										Store_field(tmp, 0, tmp2);
389 										break;
390 									default:
391 										tmp = caml_alloc(1, 0); // X86_OP_INVALID
392 										break;
393 								}
394 
395 								tmp2 = caml_alloc(5, 0);
396 								Store_field(tmp2, 0, tmp);
397 								Store_field(tmp2, 1, Val_int(insn[j-1].detail->x86.operands[i].size));
398 								Store_field(tmp2, 2, Val_int(insn[j-1].detail->x86.operands[i].access));
399 								Store_field(tmp2, 3, Val_int(insn[j-1].detail->x86.operands[i].avx_bcast));
400 								Store_field(tmp2, 4, Val_int(insn[j-1].detail->x86.operands[i].avx_zero_opmask));
401 								Store_field(array, i, tmp2);
402 							}
403 						} else	// empty array
404 							array = Atom(0);
405 						Store_field(op_info_val, 16, array);
406 
407 						// finally, insert this into arch_info
408 						Store_field(arch_info, 0, op_info_val);
409 
410 						Store_field(rec_insn, 9, arch_info);
411 						break;
412 
413 					case CS_ARCH_PPC:
414 						arch_info = caml_alloc(1, 4);
415 
416 						op_info_val = caml_alloc(4, 0);
417 
418 						Store_field(op_info_val, 0, Val_int(insn[j-1].detail->ppc.bc));
419 						Store_field(op_info_val, 1, Val_int(insn[j-1].detail->ppc.bh));
420 						Store_field(op_info_val, 2, Val_bool(insn[j-1].detail->ppc.update_cr0));
421 
422 						lcount = insn[j-1].detail->ppc.op_count;
423 						if (lcount > 0) {
424 							array = caml_alloc(lcount, 0);
425 							for (i = 0; i < lcount; i++) {
426 								tmp2 = caml_alloc(1, 0);
427 								switch(insn[j-1].detail->ppc.operands[i].type) {
428 									case PPC_OP_REG:
429 										tmp = caml_alloc(1, 1);
430 										Store_field(tmp, 0, Val_int(insn[j-1].detail->ppc.operands[i].reg));
431 										break;
432 									case PPC_OP_IMM:
433 										tmp = caml_alloc(1, 2);
434 										Store_field(tmp, 0, Val_int(insn[j-1].detail->ppc.operands[i].imm));
435 										break;
436 									case PPC_OP_MEM:
437 										tmp = caml_alloc(1, 3);
438 										tmp3 = caml_alloc(2, 0);
439 										Store_field(tmp3, 0, Val_int(insn[j-1].detail->ppc.operands[i].mem.base));
440 										Store_field(tmp3, 1, Val_int(insn[j-1].detail->ppc.operands[i].mem.disp));
441 										Store_field(tmp, 0, tmp3);
442 										break;
443 									case PPC_OP_CRX:
444 										tmp = caml_alloc(1, 4);
445 										tmp3 = caml_alloc(3, 0);
446 										Store_field(tmp3, 0, Val_int(insn[j-1].detail->ppc.operands[i].crx.scale));
447 										Store_field(tmp3, 1, Val_int(insn[j-1].detail->ppc.operands[i].crx.reg));
448 										Store_field(tmp3, 2, Val_int(insn[j-1].detail->ppc.operands[i].crx.cond));
449 										Store_field(tmp, 0, tmp3);
450 										break;
451 									default: break;
452 								}
453 								Store_field(tmp2, 0, tmp);
454 								Store_field(array, i, tmp2);
455 							}
456 						} else	// empty array
457 							array = Atom(0);
458 
459 						Store_field(op_info_val, 3, array);
460 
461 						// finally, insert this into arch_info
462 						Store_field(arch_info, 0, op_info_val);
463 
464 						Store_field(rec_insn, 9, arch_info);
465 
466 						break;
467 
468 					case CS_ARCH_SPARC:
469 						arch_info = caml_alloc(1, 5);
470 
471 						op_info_val = caml_alloc(3, 0);
472 
473 						Store_field(op_info_val, 0, Val_int(insn[j-1].detail->sparc.cc));
474 						Store_field(op_info_val, 1, Val_int(insn[j-1].detail->sparc.hint));
475 
476 						lcount = insn[j-1].detail->sparc.op_count;
477 						if (lcount > 0) {
478 							array = caml_alloc(lcount, 0);
479 							for (i = 0; i < lcount; i++) {
480 								tmp2 = caml_alloc(1, 0);
481 								switch(insn[j-1].detail->sparc.operands[i].type) {
482 									case SPARC_OP_REG:
483 										tmp = caml_alloc(1, 1);
484 										Store_field(tmp, 0, Val_int(insn[j-1].detail->sparc.operands[i].reg));
485 										break;
486 									case SPARC_OP_IMM:
487 										tmp = caml_alloc(1, 2);
488 										Store_field(tmp, 0, Val_int(insn[j-1].detail->sparc.operands[i].imm));
489 										break;
490 									case SPARC_OP_MEM:
491 										tmp = caml_alloc(1, 3);
492 										tmp3 = caml_alloc(3, 0);
493 										Store_field(tmp3, 0, Val_int(insn[j-1].detail->sparc.operands[i].mem.base));
494 										Store_field(tmp3, 1, Val_int(insn[j-1].detail->sparc.operands[i].mem.index));
495 										Store_field(tmp3, 2, Val_int(insn[j-1].detail->sparc.operands[i].mem.disp));
496 										Store_field(tmp, 0, tmp3);
497 										break;
498 									default: break;
499 								}
500 								Store_field(tmp2, 0, tmp);
501 								Store_field(array, i, tmp2);
502 							}
503 						} else	// empty array
504 							array = Atom(0);
505 
506 						Store_field(op_info_val, 2, array);
507 
508 						// finally, insert this into arch_info
509 						Store_field(arch_info, 0, op_info_val);
510 
511 						Store_field(rec_insn, 9, arch_info);
512 
513 						break;
514 
515 					case CS_ARCH_SYSZ:
516 						arch_info = caml_alloc(1, 6);
517 
518 						op_info_val = caml_alloc(2, 0);
519 
520 						Store_field(op_info_val, 0, Val_int(insn[j-1].detail->sysz.cc));
521 
522 						lcount = insn[j-1].detail->sysz.op_count;
523 						if (lcount > 0) {
524 							array = caml_alloc(lcount, 0);
525 							for (i = 0; i < lcount; i++) {
526 								tmp2 = caml_alloc(1, 0);
527 								switch(insn[j-1].detail->sysz.operands[i].type) {
528 									case SYSZ_OP_REG:
529 										tmp = caml_alloc(1, 1);
530 										Store_field(tmp, 0, Val_int(insn[j-1].detail->sysz.operands[i].reg));
531 										break;
532 									case SYSZ_OP_ACREG:
533 										tmp = caml_alloc(1, 2);
534 										Store_field(tmp, 0, Val_int(insn[j-1].detail->sysz.operands[i].reg));
535 										break;
536 									case SYSZ_OP_IMM:
537 										tmp = caml_alloc(1, 3);
538 										Store_field(tmp, 0, Val_int(insn[j-1].detail->sysz.operands[i].imm));
539 										break;
540 									case SYSZ_OP_MEM:
541 										tmp = caml_alloc(1, 4);
542 										tmp3 = caml_alloc(4, 0);
543 										Store_field(tmp3, 0, Val_int(insn[j-1].detail->sysz.operands[i].mem.base));
544 										Store_field(tmp3, 1, Val_int(insn[j-1].detail->sysz.operands[i].mem.index));
545 										Store_field(tmp3, 2, caml_copy_int64(insn[j-1].detail->sysz.operands[i].mem.length));
546 										Store_field(tmp3, 3, caml_copy_int64(insn[j-1].detail->sysz.operands[i].mem.disp));
547 										Store_field(tmp, 0, tmp3);
548 										break;
549 									default: break;
550 								}
551 								Store_field(tmp2, 0, tmp);
552 								Store_field(array, i, tmp2);
553 							}
554 						} else	// empty array
555 							array = Atom(0);
556 
557 						Store_field(op_info_val, 1, array);
558 
559 						// finally, insert this into arch_info
560 						Store_field(arch_info, 0, op_info_val);
561 
562 						Store_field(rec_insn, 9, arch_info);
563 
564 						break;
565 
566 					case CS_ARCH_XCORE:
567 						arch_info = caml_alloc(1, 7);
568 
569 						op_info_val = caml_alloc(1, 0);
570 
571 						lcount = insn[j-1].detail->xcore.op_count;
572 						if (lcount > 0) {
573 							array = caml_alloc(lcount, 0);
574 							for (i = 0; i < lcount; i++) {
575 								tmp2 = caml_alloc(1, 0);
576 								switch(insn[j-1].detail->xcore.operands[i].type) {
577 									case XCORE_OP_REG:
578 										tmp = caml_alloc(1, 1);
579 										Store_field(tmp, 0, Val_int(insn[j-1].detail->xcore.operands[i].reg));
580 										break;
581 									case XCORE_OP_IMM:
582 										tmp = caml_alloc(1, 2);
583 										Store_field(tmp, 0, Val_int(insn[j-1].detail->xcore.operands[i].imm));
584 										break;
585 									case XCORE_OP_MEM:
586 										tmp = caml_alloc(1, 3);
587 										tmp3 = caml_alloc(4, 0);
588 										Store_field(tmp3, 0, Val_int(insn[j-1].detail->xcore.operands[i].mem.base));
589 										Store_field(tmp3, 1, Val_int(insn[j-1].detail->xcore.operands[i].mem.index));
590 										Store_field(tmp3, 2, caml_copy_int64(insn[j-1].detail->xcore.operands[i].mem.disp));
591 										Store_field(tmp3, 3, caml_copy_int64(insn[j-1].detail->xcore.operands[i].mem.direct));
592 										Store_field(tmp, 0, tmp3);
593 										break;
594 									default: break;
595 								}
596 								Store_field(tmp2, 0, tmp);
597 								Store_field(array, i, tmp2);
598 							}
599 						} else	// empty array
600 							array = Atom(0);
601 
602 						Store_field(op_info_val, 0, array);
603 
604 						// finally, insert this into arch_info
605 						Store_field(arch_info, 0, op_info_val);
606 
607 						Store_field(rec_insn, 9, arch_info);
608 
609 						break;
610 
611 					case CS_ARCH_M680X:
612 						arch_info = caml_alloc(1, 8);
613 
614 						op_info_val = caml_alloc(2, 0); // struct cs_m680x
615 						Store_field(op_info_val, 0, Val_int(insn[j-1].detail->m680x.flags));
616 
617 						lcount = insn[j-1].detail->m680x.op_count;
618 						if (lcount > 0) {
619 							array = caml_alloc(lcount, 0);
620 							for (i = 0; i < lcount; i++) {
621 								tmp2 = caml_alloc(3, 0); // m680x_op
622 								switch(insn[j-1].detail->m680x.operands[i].type) {
623 									case M680X_OP_IMMEDIATE:
624 										tmp = caml_alloc(1, 1); // imm
625 										Store_field(tmp, 0, Val_int(insn[j-1].detail->m680x.operands[i].imm));
626 										break;
627 									case M680X_OP_REGISTER:
628 										tmp = caml_alloc(1, 2); // reg
629 										Store_field(tmp, 0, Val_int(insn[j-1].detail->m680x.operands[i].reg));
630 										break;
631 									case M680X_OP_INDEXED:
632 										tmp = caml_alloc(1, 3);
633 										tmp3 = caml_alloc(7, 0); // m680x_op_idx
634 										Store_field(tmp3, 0, Val_int(insn[j-1].detail->m680x.operands[i].idx.base_reg));
635 										Store_field(tmp3, 1, Val_int(insn[j-1].detail->m680x.operands[i].idx.offset_reg));
636 										Store_field(tmp3, 2, Val_int(insn[j-1].detail->m680x.operands[i].idx.offset));
637 										Store_field(tmp3, 3, Val_int(insn[j-1].detail->m680x.operands[i].idx.offset_addr));
638 										Store_field(tmp3, 4, Val_int(insn[j-1].detail->m680x.operands[i].idx.offset_bits));
639 										Store_field(tmp3, 5, Val_int(insn[j-1].detail->m680x.operands[i].idx.inc_dec));
640 										Store_field(tmp3, 6, Val_int(insn[j-1].detail->m680x.operands[i].idx.flags));
641 										Store_field(tmp, 0, tmp3);
642 										break;
643 									case M680X_OP_RELATIVE:
644 										tmp = caml_alloc(1, 4);
645 										tmp3 = caml_alloc(2, 0); // m680x_op_rel
646 										Store_field(tmp3, 0, Val_int(insn[j-1].detail->m680x.operands[i].rel.address));
647 										Store_field(tmp3, 1, Val_int(insn[j-1].detail->m680x.operands[i].rel.offset));
648 										Store_field(tmp, 0, tmp3);
649 										break;
650 									case M680X_OP_EXTENDED:
651 										tmp = caml_alloc(1, 5);
652 										tmp3 = caml_alloc(2, 0); // m680x_op_ext
653 										Store_field(tmp3, 0, Val_int(insn[j-1].detail->m680x.operands[i].ext.address));
654 										Store_field(tmp3, 1, Val_bool(insn[j-1].detail->m680x.operands[i].ext.indirect));
655 										Store_field(tmp, 0, tmp3);
656 										break;
657 									case M680X_OP_DIRECT:
658 										tmp = caml_alloc(1, 6); // direct_addr
659 										Store_field(tmp, 0, Val_int(insn[j-1].detail->m680x.operands[i].direct_addr));
660 										break;
661 									case M680X_OP_CONSTANT:
662 										tmp = caml_alloc(1, 7); // const_val
663 										Store_field(tmp, 0, Val_int(insn[j-1].detail->m680x.operands[i].const_val));
664 										break;
665 									default: break;
666 								}
667 								Store_field(tmp2, 0, tmp); // add union
668 								Store_field(tmp2, 1, Val_int(insn[j-1].detail->m680x.operands[i].size));
669 								Store_field(tmp2, 2, Val_int(insn[j-1].detail->m680x.operands[i].access));
670 								Store_field(array, i, tmp2); // add operand to operand array
671 							}
672 						} else // empty list
673 							array = Atom(0);
674 
675 						Store_field(op_info_val, 1, array);
676 
677 						// finally, insert this into arch_info
678 						Store_field(arch_info, 0, op_info_val);
679 
680 						Store_field(rec_insn, 9, arch_info);
681 
682 						break;
683 
684 					default: break;
685 				}
686 			}
687 
688 			Store_field(cons, 0, rec_insn);	// head
689 			Store_field(cons, 1, list);		// tail
690 			list = cons;
691 		}
692 		cs_free(insn, count);
693 	}
694 
695 	// do not free the handle here
696 	//cs_close(&handle);
697     CAMLreturn(list);
698 }
699 
ocaml_cs_disasm(value _arch,value _mode,value _code,value _addr,value _count)700 CAMLprim value ocaml_cs_disasm(value _arch, value _mode, value _code, value _addr, value _count)
701 {
702 	CAMLparam5(_arch, _mode, _code, _addr, _count);
703 	CAMLlocal1(head);
704 	csh handle;
705 	cs_arch arch;
706 	cs_mode mode = 0;
707 	const uint8_t *code;
708 	uint64_t addr;
709 	size_t count, code_len;
710 
711 	switch (Int_val(_arch)) {
712 		case 0:
713 			arch = CS_ARCH_ARM;
714 			break;
715 		case 1:
716 			arch = CS_ARCH_ARM64;
717 			break;
718 		case 2:
719 			arch = CS_ARCH_MIPS;
720 			break;
721 		case 3:
722 			arch = CS_ARCH_X86;
723 			break;
724 		case 4:
725 			arch = CS_ARCH_PPC;
726 			break;
727 		case 5:
728 			arch = CS_ARCH_SPARC;
729 			break;
730 		case 6:
731 			arch = CS_ARCH_SYSZ;
732 			break;
733 		case 7:
734 			arch = CS_ARCH_XCORE;
735 			break;
736 		case 8:
737 			arch = CS_ARCH_M68K;
738 			break;
739 		case 9:
740 			arch = CS_ARCH_TMS320C64X;
741 			break;
742 		case 10:
743 			arch = CS_ARCH_M680X;
744 			break;
745 		default:
746 			caml_invalid_argument("Invalid arch");
747 			return Val_emptylist;
748 	}
749 
750 	while (_mode != Val_emptylist) {
751 		head = Field(_mode, 0);  /* accessing the head */
752 		switch (Int_val(head)) {
753 			case 0:
754 				mode |= CS_MODE_LITTLE_ENDIAN;
755 				break;
756 			case 1:
757 				mode |= CS_MODE_ARM;
758 				break;
759 			case 2:
760 				mode |= CS_MODE_16;
761 				break;
762 			case 3:
763 				mode |= CS_MODE_32;
764 				break;
765 			case 4:
766 				mode |= CS_MODE_64;
767 				break;
768 			case 5:
769 				mode |= CS_MODE_THUMB;
770 				break;
771 			case 6:
772 				mode |= CS_MODE_MCLASS;
773 				break;
774 			case 7:
775 				mode |= CS_MODE_V8;
776 				break;
777 			case 8:
778 				mode |= CS_MODE_MICRO;
779 				break;
780 			case 9:
781 				mode |= CS_MODE_MIPS3;
782 				break;
783 			case 10:
784 				mode |= CS_MODE_MIPS32R6;
785 				break;
786 			case 11:
787 				mode |= CS_MODE_MIPS2;
788 				break;
789 			case 12:
790 				mode |= CS_MODE_V9;
791 				break;
792 			case 13:
793 				mode |= CS_MODE_BIG_ENDIAN;
794 				break;
795 			case 14:
796 				mode |= CS_MODE_MIPS32;
797 				break;
798 			case 15:
799 				mode |= CS_MODE_MIPS64;
800 				break;
801 			case 16:
802 				mode |= CS_MODE_QPX;
803 				break;
804 			case 17:
805 				mode |= CS_MODE_M680X_6301;
806 				break;
807 			case 18:
808 				mode |= CS_MODE_M680X_6309;
809 				break;
810 			case 19:
811 				mode |= CS_MODE_M680X_6800;
812 				break;
813 			case 20:
814 				mode |= CS_MODE_M680X_6801;
815 				break;
816 			case 21:
817 				mode |= CS_MODE_M680X_6805;
818 				break;
819 			case 22:
820 				mode |= CS_MODE_M680X_6808;
821 				break;
822 			case 23:
823 				mode |= CS_MODE_M680X_6809;
824 				break;
825 			case 24:
826 				mode |= CS_MODE_M680X_6811;
827 				break;
828 			case 25:
829 				mode |= CS_MODE_M680X_CPU12;
830 				break;
831 			case 26:
832 				mode |= CS_MODE_M680X_HCS08;
833 				break;
834 			default:
835 				caml_invalid_argument("Invalid mode");
836 				return Val_emptylist;
837 		}
838 		_mode = Field(_mode, 1);  /* point to the tail for next loop */
839 	}
840 
841 	cs_err ret = cs_open(arch, mode, &handle);
842 	if (ret != CS_ERR_OK) {
843 		return Val_emptylist;
844 	}
845 
846 	code = (uint8_t *)String_val(_code);
847 	code_len = caml_string_length(_code);
848 	addr = Int64_val(_addr);
849 	count = Int64_val(_count);
850 
851     CAMLreturn(_cs_disasm(arch, handle, code, code_len, addr, count));
852 }
853 
ocaml_cs_disasm_internal(value _arch,value _handle,value _code,value _addr,value _count)854 CAMLprim value ocaml_cs_disasm_internal(value _arch, value _handle, value _code, value _addr, value _count)
855 {
856 	CAMLparam5(_arch, _handle, _code, _addr, _count);
857 	csh handle;
858 	cs_arch arch;
859 	const uint8_t *code;
860 	uint64_t addr, count, code_len;
861 
862 	handle = Int64_val(_handle);
863 
864 	arch = Int_val(_arch);
865 	code = (uint8_t *)String_val(_code);
866 	code_len = caml_string_length(_code);
867 	addr = Int64_val(_addr);
868 	count = Int64_val(_count);
869 
870     CAMLreturn(_cs_disasm(arch, handle, code, code_len, addr, count));
871 }
872 
ocaml_open(value _arch,value _mode)873 CAMLprim value ocaml_open(value _arch, value _mode)
874 {
875 	CAMLparam2(_arch, _mode);
876 	CAMLlocal2(list, head);
877 	csh handle;
878 	cs_arch arch;
879 	cs_mode mode = 0;
880 
881 	list = Val_emptylist;
882 
883 	switch (Int_val(_arch)) {
884 		case 0:
885 			arch = CS_ARCH_ARM;
886 			break;
887 		case 1:
888 			arch = CS_ARCH_ARM64;
889 			break;
890 		case 2:
891 			arch = CS_ARCH_MIPS;
892 			break;
893 		case 3:
894 			arch = CS_ARCH_X86;
895 			break;
896 		case 4:
897 			arch = CS_ARCH_PPC;
898 			break;
899 		case 5:
900 			arch = CS_ARCH_SPARC;
901 			break;
902 		case 6:
903 			arch = CS_ARCH_SYSZ;
904 			break;
905 		case 7:
906 			arch = CS_ARCH_XCORE;
907 			break;
908 		case 8:
909 			arch = CS_ARCH_M68K;
910 			break;
911 		case 9:
912 			arch = CS_ARCH_TMS320C64X;
913 			break;
914 		case 10:
915 			arch = CS_ARCH_M680X;
916 			break;
917 		default:
918 			caml_invalid_argument("Invalid arch");
919 			return Val_emptylist;
920 	}
921 
922 
923 	while (_mode != Val_emptylist) {
924 		head = Field(_mode, 0);  /* accessing the head */
925 		switch (Int_val(head)) {
926 			case 0:
927 				mode |= CS_MODE_LITTLE_ENDIAN;
928 				break;
929 			case 1:
930 				mode |= CS_MODE_ARM;
931 				break;
932 			case 2:
933 				mode |= CS_MODE_16;
934 				break;
935 			case 3:
936 				mode |= CS_MODE_32;
937 				break;
938 			case 4:
939 				mode |= CS_MODE_64;
940 				break;
941 			case 5:
942 				mode |= CS_MODE_THUMB;
943 				break;
944 			case 6:
945 				mode |= CS_MODE_MCLASS;
946 				break;
947 			case 7:
948 				mode |= CS_MODE_V8;
949 				break;
950 			case 8:
951 				mode |= CS_MODE_MICRO;
952 				break;
953 			case 9:
954 				mode |= CS_MODE_MIPS3;
955 				break;
956 			case 10:
957 				mode |= CS_MODE_MIPS32R6;
958 				break;
959 			case 11:
960 				mode |= CS_MODE_MIPS2;
961 				break;
962 			case 12:
963 				mode |= CS_MODE_V9;
964 				break;
965 			case 13:
966 				mode |= CS_MODE_BIG_ENDIAN;
967 				break;
968 			case 14:
969 				mode |= CS_MODE_MIPS32;
970 				break;
971 			case 15:
972 				mode |= CS_MODE_MIPS64;
973 				break;
974 			case 16:
975 				mode |= CS_MODE_QPX;
976 				break;
977 			case 17:
978 				mode |= CS_MODE_M680X_6301;
979 				break;
980 			case 18:
981 				mode |= CS_MODE_M680X_6309;
982 				break;
983 			case 19:
984 				mode |= CS_MODE_M680X_6800;
985 				break;
986 			case 20:
987 				mode |= CS_MODE_M680X_6801;
988 				break;
989 			case 21:
990 				mode |= CS_MODE_M680X_6805;
991 				break;
992 			case 22:
993 				mode |= CS_MODE_M680X_6808;
994 				break;
995 			case 23:
996 				mode |= CS_MODE_M680X_6809;
997 				break;
998 			case 24:
999 				mode |= CS_MODE_M680X_6811;
1000 				break;
1001 			case 25:
1002 				mode |= CS_MODE_M680X_CPU12;
1003 				break;
1004 			case 26:
1005 				mode |= CS_MODE_M680X_HCS08;
1006 				break;
1007 			default:
1008 				caml_invalid_argument("Invalid mode");
1009 				return Val_emptylist;
1010 		}
1011 		_mode = Field(_mode, 1);  /* point to the tail for next loop */
1012 	}
1013 
1014 	if (cs_open(arch, mode, &handle) != 0)
1015 		CAMLreturn(Val_int(0));
1016 
1017 	CAMLlocal1(result);
1018 	result = caml_alloc(1, 0);
1019 	Store_field(result, 0, caml_copy_int64(handle));
1020 	CAMLreturn(result);
1021 }
1022 
ocaml_option(value _handle,value _opt,value _value)1023 CAMLprim value ocaml_option(value _handle, value _opt, value _value)
1024 {
1025 	CAMLparam3(_handle, _opt, _value);
1026 	cs_opt_type opt;
1027 	int err;
1028 
1029 	switch (Int_val(_opt)) {
1030 		case 0:
1031 			opt = CS_OPT_SYNTAX;
1032 			break;
1033 		case 1:
1034 			opt = CS_OPT_DETAIL;
1035 			break;
1036 		case 2:
1037 			opt = CS_OPT_MODE;
1038 			break;
1039 		case 3:
1040 			opt = CS_OPT_MEM;
1041 			break;
1042 		case 4:
1043 			opt = CS_OPT_SKIPDATA;
1044 			break;
1045 		case 5:
1046 			opt = CS_OPT_SKIPDATA_SETUP;
1047 			break;
1048 		default:
1049 			caml_invalid_argument("Invalid option");
1050 			CAMLreturn(Val_int(CS_ERR_OPTION));
1051 	}
1052 
1053 	err = cs_option(Int64_val(_handle), opt, Int64_val(_value));
1054 
1055 	CAMLreturn(Val_int(err));
1056 }
1057 
ocaml_register_name(value _handle,value _reg)1058 CAMLprim value ocaml_register_name(value _handle, value _reg)
1059 {
1060 	const char *name = cs_reg_name(Int64_val(_handle), Int_val(_reg));
1061 	if (!name) {
1062 		caml_invalid_argument("invalid reg_id");
1063 		name = "invalid";
1064 	}
1065 
1066 	return caml_copy_string(name);
1067 }
1068 
ocaml_instruction_name(value _handle,value _insn)1069 CAMLprim value ocaml_instruction_name(value _handle, value _insn)
1070 {
1071 	const char *name = cs_insn_name(Int64_val(_handle), Int_val(_insn));
1072 	if (!name) {
1073 		caml_invalid_argument("invalid insn_id");
1074 		name = "invalid";
1075 	}
1076 
1077 	return caml_copy_string(name);
1078 }
1079 
ocaml_group_name(value _handle,value _insn)1080 CAMLprim value ocaml_group_name(value _handle, value _insn)
1081 {
1082 	const char *name = cs_group_name(Int64_val(_handle), Int_val(_insn));
1083 	if (!name) {
1084 		caml_invalid_argument("invalid insn_id");
1085 		name = "invalid";
1086 	}
1087 
1088 	return caml_copy_string(name);
1089 }
1090 
ocaml_version(void)1091 CAMLprim value ocaml_version(void)
1092 {
1093 	int version = cs_version(NULL, NULL);
1094 	return Val_int(version);
1095 }
1096 
ocaml_close(value _handle)1097 CAMLprim value ocaml_close(value _handle)
1098 {
1099 	CAMLparam1(_handle);
1100 	csh h;
1101 
1102 	h = Int64_val(_handle);
1103 
1104 	CAMLreturn(Val_int(cs_close(&h)));
1105 }
1106