1/* Capstone Disassembler Engine */
2/* By Nguyen Anh Quynh <aquynh@gmail.com>, 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 "../../include/capstone.h"
12
13#define ARR_SIZE(a) (sizeof(a)/sizeof(a[0]))
14
15
16// count the number of positive members in @list
17static 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
28CAMLprim 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(4, 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(4, 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(tmp, 0, tmp3);
156										break;
157									case ARM_OP_SETEND:
158										tmp = caml_alloc(1, 7);
159										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm.operands[i].setend));
160										break;
161									default: break;
162								}
163								tmp3 = caml_alloc(2, 0);
164								Store_field(tmp3, 0, Val_int(insn[j-1].detail->arm.operands[i].shift.type));
165								Store_field(tmp3, 1, Val_int(insn[j-1].detail->arm.operands[i].shift.value));
166								Store_field(tmp2, 0, Val_int(insn[j-1].detail->arm.operands[i].vector_index));
167								Store_field(tmp2, 1, tmp3);
168								Store_field(tmp2, 2, tmp);
169								Store_field(tmp2, 3, Val_bool(insn[j-1].detail->arm.operands[i].subtracted));
170								Store_field(array, i, tmp2);
171							}
172						} else	// empty list
173							array = Atom(0);
174
175						Store_field(op_info_val, 9, array);
176
177						// finally, insert this into arch_info
178						Store_field(arch_info, 0, op_info_val);
179
180						Store_field(rec_insn, 9, arch_info);
181
182						break;
183					case CS_ARCH_ARM64:
184						arch_info = caml_alloc(1, 1);
185
186						op_info_val = caml_alloc(4, 0);
187						Store_field(op_info_val, 0, Val_int(insn[j-1].detail->arm64.cc));
188						Store_field(op_info_val, 1, Val_bool(insn[j-1].detail->arm64.update_flags));
189						Store_field(op_info_val, 2, Val_bool(insn[j-1].detail->arm64.writeback));
190
191						lcount = insn[j-1].detail->arm64.op_count;
192						if (lcount > 0) {
193							array = caml_alloc(lcount, 0);
194							for (i = 0; i < lcount; i++) {
195								tmp2 = caml_alloc(6, 0);
196								switch(insn[j-1].detail->arm64.operands[i].type) {
197									case ARM64_OP_REG:
198										tmp = caml_alloc(1, 1);
199										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm64.operands[i].reg));
200										break;
201									case ARM64_OP_CIMM:
202										tmp = caml_alloc(1, 2);
203										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm64.operands[i].imm));
204										break;
205									case ARM64_OP_IMM:
206										tmp = caml_alloc(1, 3);
207										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm64.operands[i].imm));
208										break;
209									case ARM64_OP_FP:
210										tmp = caml_alloc(1, 4);
211										Store_field(tmp, 0, caml_copy_double(insn[j-1].detail->arm64.operands[i].fp));
212										break;
213									case ARM64_OP_MEM:
214										tmp = caml_alloc(1, 5);
215										tmp3 = caml_alloc(3, 0);
216										Store_field(tmp3, 0, Val_int(insn[j-1].detail->arm64.operands[i].mem.base));
217										Store_field(tmp3, 1, Val_int(insn[j-1].detail->arm64.operands[i].mem.index));
218										Store_field(tmp3, 2, Val_int(insn[j-1].detail->arm64.operands[i].mem.disp));
219										Store_field(tmp, 0, tmp3);
220										break;
221									case ARM64_OP_REG_MRS:
222										tmp = caml_alloc(1, 6);
223										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm64.operands[i].reg));
224										break;
225									case ARM64_OP_REG_MSR:
226										tmp = caml_alloc(1, 7);
227										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm64.operands[i].reg));
228										break;
229									case ARM64_OP_PSTATE:
230										tmp = caml_alloc(1, 8);
231										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm64.operands[i].pstate));
232										break;
233									case ARM64_OP_SYS:
234										tmp = caml_alloc(1, 9);
235										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm64.operands[i].sys));
236										break;
237									case ARM64_OP_PREFETCH:
238										tmp = caml_alloc(1, 10);
239										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm64.operands[i].prefetch));
240										break;
241									case ARM64_OP_BARRIER:
242										tmp = caml_alloc(1, 11);
243										Store_field(tmp, 0, Val_int(insn[j-1].detail->arm64.operands[i].barrier));
244										break;
245									default: break;
246								}
247								tmp3 = caml_alloc(2, 0);
248								Store_field(tmp3, 0, Val_int(insn[j-1].detail->arm64.operands[i].shift.type));
249								Store_field(tmp3, 1, Val_int(insn[j-1].detail->arm64.operands[i].shift.value));
250
251								Store_field(tmp2, 0, Val_int(insn[j-1].detail->arm64.operands[i].vector_index));
252								Store_field(tmp2, 1, Val_int(insn[j-1].detail->arm64.operands[i].vas));
253								Store_field(tmp2, 2, Val_int(insn[j-1].detail->arm64.operands[i].vess));
254								Store_field(tmp2, 3, tmp3);
255								Store_field(tmp2, 4, Val_int(insn[j-1].detail->arm64.operands[i].ext));
256								Store_field(tmp2, 5, tmp);
257
258								Store_field(array, i, tmp2);
259							}
260						} else	// empty array
261							array = Atom(0);
262
263						Store_field(op_info_val, 3, array);
264
265						// finally, insert this into arch_info
266						Store_field(arch_info, 0, op_info_val);
267
268						Store_field(rec_insn, 9, arch_info);
269
270						break;
271					case CS_ARCH_MIPS:
272						arch_info = caml_alloc(1, 2);
273
274						op_info_val = caml_alloc(1, 0);
275
276						lcount = insn[j-1].detail->mips.op_count;
277						if (lcount > 0) {
278							array = caml_alloc(lcount, 0);
279							for (i = 0; i < lcount; i++) {
280								tmp2 = caml_alloc(1, 0);
281								switch(insn[j-1].detail->mips.operands[i].type) {
282									case MIPS_OP_REG:
283										tmp = caml_alloc(1, 1);
284										Store_field(tmp, 0, Val_int(insn[j-1].detail->mips.operands[i].reg));
285										break;
286									case MIPS_OP_IMM:
287										tmp = caml_alloc(1, 2);
288										Store_field(tmp, 0, Val_int(insn[j-1].detail->mips.operands[i].imm));
289										break;
290									case MIPS_OP_MEM:
291										tmp = caml_alloc(1, 3);
292										tmp3 = caml_alloc(2, 0);
293										Store_field(tmp3, 0, Val_int(insn[j-1].detail->mips.operands[i].mem.base));
294										Store_field(tmp3, 1, Val_int(insn[j-1].detail->mips.operands[i].mem.disp));
295										Store_field(tmp, 0, tmp3);
296										break;
297									default: break;
298								}
299								Store_field(tmp2, 0, tmp);
300								Store_field(array, i, tmp2);
301							}
302						} else	// empty array
303							array = Atom(0);
304
305						Store_field(op_info_val, 0, array);
306
307						// finally, insert this into arch_info
308						Store_field(arch_info, 0, op_info_val);
309
310						Store_field(rec_insn, 9, arch_info);
311
312						break;
313					case CS_ARCH_X86:
314						arch_info = caml_alloc(1, 3);
315
316						op_info_val = caml_alloc(15, 0);
317
318						// fill prefix
319						lcount = list_count(insn[j-1].detail->x86.prefix, ARR_SIZE(insn[j-1].detail->x86.prefix));
320						if (lcount) {
321							array = caml_alloc(lcount, 0);
322							for (i = 0; i < lcount; i++) {
323								Store_field(array, i, Val_int(insn[j-1].detail->x86.prefix[i]));
324							}
325						} else
326							array = Atom(0);
327						Store_field(op_info_val, 0, array);
328
329						// fill opcode
330						lcount = list_count(insn[j-1].detail->x86.opcode, ARR_SIZE(insn[j-1].detail->x86.opcode));
331						if (lcount) {
332							array = caml_alloc(lcount, 0);
333							for (i = 0; i < lcount; i++) {
334								Store_field(array, i, Val_int(insn[j-1].detail->x86.opcode[i]));
335							}
336						} else
337							array = Atom(0);
338						Store_field(op_info_val, 1, array);
339
340						Store_field(op_info_val, 2, Val_int(insn[j-1].detail->x86.rex));
341
342						Store_field(op_info_val, 3, Val_int(insn[j-1].detail->x86.addr_size));
343
344						Store_field(op_info_val, 4, Val_int(insn[j-1].detail->x86.modrm));
345
346						Store_field(op_info_val, 5, Val_int(insn[j-1].detail->x86.sib));
347
348						Store_field(op_info_val, 6, Val_int(insn[j-1].detail->x86.disp));
349
350						Store_field(op_info_val, 7, Val_int(insn[j-1].detail->x86.sib_index));
351
352						Store_field(op_info_val, 8, Val_int(insn[j-1].detail->x86.sib_scale));
353
354						Store_field(op_info_val, 9, Val_int(insn[j-1].detail->x86.sib_base));
355
356						Store_field(op_info_val, 10, Val_int(insn[j-1].detail->x86.sse_cc));
357						Store_field(op_info_val, 11, Val_int(insn[j-1].detail->x86.avx_cc));
358						Store_field(op_info_val, 12, Val_int(insn[j-1].detail->x86.avx_sae));
359						Store_field(op_info_val, 13, Val_int(insn[j-1].detail->x86.avx_rm));
360
361						lcount = insn[j-1].detail->x86.op_count;
362						if (lcount > 0) {
363							array = caml_alloc(lcount, 0);
364							for (i = 0; i < lcount; i++) {
365								switch(insn[j-1].detail->x86.operands[i].type) {
366									case X86_OP_REG:
367										tmp = caml_alloc(4, 1);
368										Store_field(tmp, 0, Val_int(insn[j-1].detail->x86.operands[i].reg));
369										break;
370									case X86_OP_IMM:
371										tmp = caml_alloc(4, 2);
372										Store_field(tmp, 0, Val_int(insn[j-1].detail->x86.operands[i].imm));
373										break;
374									case X86_OP_FP:
375										tmp = caml_alloc(4, 3);
376										Store_field(tmp, 0, caml_copy_double(insn[j-1].detail->x86.operands[i].fp));
377										break;
378									case X86_OP_MEM:
379										tmp = caml_alloc(4, 4);
380										tmp2 = caml_alloc(5, 0);
381										Store_field(tmp2, 0, Val_int(insn[j-1].detail->x86.operands[i].mem.segment));
382										Store_field(tmp2, 1, Val_int(insn[j-1].detail->x86.operands[i].mem.base));
383										Store_field(tmp2, 2, Val_int(insn[j-1].detail->x86.operands[i].mem.index));
384										Store_field(tmp2, 3, Val_int(insn[j-1].detail->x86.operands[i].mem.scale));
385										Store_field(tmp2, 4, Val_int(insn[j-1].detail->x86.operands[i].mem.disp));
386
387										Store_field(tmp, 0, tmp2);
388										break;
389									default:
390										break;
391								}
392								Store_field(tmp, 1, Val_int(insn[j-1].detail->x86.operands[i].size));
393								Store_field(tmp, 2, Val_int(insn[j-1].detail->x86.operands[i].avx_bcast));
394								Store_field(tmp, 3, Val_int(insn[j-1].detail->x86.operands[i].avx_zero_opmask));
395								tmp2 = caml_alloc(1, 0);
396								Store_field(tmp2, 0, tmp);
397								Store_field(array, i, tmp2);
398							}
399						} else	// empty array
400							array = Atom(0);
401						Store_field(op_info_val, 14, array);
402
403						// finally, insert this into arch_info
404						Store_field(arch_info, 0, op_info_val);
405
406						Store_field(rec_insn, 9, arch_info);
407						break;
408
409					case CS_ARCH_PPC:
410						arch_info = caml_alloc(1, 4);
411
412						op_info_val = caml_alloc(4, 0);
413
414						Store_field(op_info_val, 0, Val_int(insn[j-1].detail->ppc.bc));
415						Store_field(op_info_val, 1, Val_int(insn[j-1].detail->ppc.bh));
416						Store_field(op_info_val, 2, Val_bool(insn[j-1].detail->ppc.update_cr0));
417
418						lcount = insn[j-1].detail->ppc.op_count;
419						if (lcount > 0) {
420							array = caml_alloc(lcount, 0);
421							for (i = 0; i < lcount; i++) {
422								tmp2 = caml_alloc(1, 0);
423								switch(insn[j-1].detail->ppc.operands[i].type) {
424									case PPC_OP_REG:
425										tmp = caml_alloc(1, 1);
426										Store_field(tmp, 0, Val_int(insn[j-1].detail->ppc.operands[i].reg));
427										break;
428									case PPC_OP_IMM:
429										tmp = caml_alloc(1, 2);
430										Store_field(tmp, 0, Val_int(insn[j-1].detail->ppc.operands[i].imm));
431										break;
432									case PPC_OP_MEM:
433										tmp = caml_alloc(1, 3);
434										tmp3 = caml_alloc(2, 0);
435										Store_field(tmp3, 0, Val_int(insn[j-1].detail->ppc.operands[i].mem.base));
436										Store_field(tmp3, 1, Val_int(insn[j-1].detail->ppc.operands[i].mem.disp));
437										Store_field(tmp, 0, tmp3);
438										break;
439									case PPC_OP_CRX:
440										tmp = caml_alloc(1, 4);
441										tmp3 = caml_alloc(3, 0);
442										Store_field(tmp3, 0, Val_int(insn[j-1].detail->ppc.operands[i].crx.scale));
443										Store_field(tmp3, 1, Val_int(insn[j-1].detail->ppc.operands[i].crx.reg));
444										Store_field(tmp3, 2, Val_int(insn[j-1].detail->ppc.operands[i].crx.cond));
445										Store_field(tmp, 0, tmp3);
446										break;
447									default: break;
448								}
449								Store_field(tmp2, 0, tmp);
450								Store_field(array, i, tmp2);
451							}
452						} else	// empty array
453							array = Atom(0);
454
455						Store_field(op_info_val, 3, array);
456
457						// finally, insert this into arch_info
458						Store_field(arch_info, 0, op_info_val);
459
460						Store_field(rec_insn, 9, arch_info);
461
462						break;
463
464					case CS_ARCH_SPARC:
465						arch_info = caml_alloc(1, 5);
466
467						op_info_val = caml_alloc(3, 0);
468
469						Store_field(op_info_val, 0, Val_int(insn[j-1].detail->sparc.cc));
470						Store_field(op_info_val, 1, Val_int(insn[j-1].detail->sparc.hint));
471
472						lcount = insn[j-1].detail->sparc.op_count;
473						if (lcount > 0) {
474							array = caml_alloc(lcount, 0);
475							for (i = 0; i < lcount; i++) {
476								tmp2 = caml_alloc(1, 0);
477								switch(insn[j-1].detail->sparc.operands[i].type) {
478									case SPARC_OP_REG:
479										tmp = caml_alloc(1, 1);
480										Store_field(tmp, 0, Val_int(insn[j-1].detail->sparc.operands[i].reg));
481										break;
482									case SPARC_OP_IMM:
483										tmp = caml_alloc(1, 2);
484										Store_field(tmp, 0, Val_int(insn[j-1].detail->sparc.operands[i].imm));
485										break;
486									case SPARC_OP_MEM:
487										tmp = caml_alloc(1, 3);
488										tmp3 = caml_alloc(3, 0);
489										Store_field(tmp3, 0, Val_int(insn[j-1].detail->sparc.operands[i].mem.base));
490										Store_field(tmp3, 1, Val_int(insn[j-1].detail->sparc.operands[i].mem.index));
491										Store_field(tmp3, 2, Val_int(insn[j-1].detail->sparc.operands[i].mem.disp));
492										Store_field(tmp, 0, tmp3);
493										break;
494									default: break;
495								}
496								Store_field(tmp2, 0, tmp);
497								Store_field(array, i, tmp2);
498							}
499						} else	// empty array
500							array = Atom(0);
501
502						Store_field(op_info_val, 2, array);
503
504						// finally, insert this into arch_info
505						Store_field(arch_info, 0, op_info_val);
506
507						Store_field(rec_insn, 9, arch_info);
508
509						break;
510
511					case CS_ARCH_SYSZ:
512						arch_info = caml_alloc(1, 6);
513
514						op_info_val = caml_alloc(2, 0);
515
516						Store_field(op_info_val, 0, Val_int(insn[j-1].detail->sysz.cc));
517
518						lcount = insn[j-1].detail->sysz.op_count;
519						if (lcount > 0) {
520							array = caml_alloc(lcount, 0);
521							for (i = 0; i < lcount; i++) {
522								tmp2 = caml_alloc(1, 0);
523								switch(insn[j-1].detail->sysz.operands[i].type) {
524									case SYSZ_OP_REG:
525										tmp = caml_alloc(1, 1);
526										Store_field(tmp, 0, Val_int(insn[j-1].detail->sysz.operands[i].reg));
527										break;
528									case SYSZ_OP_ACREG:
529										tmp = caml_alloc(1, 2);
530										Store_field(tmp, 0, Val_int(insn[j-1].detail->sysz.operands[i].reg));
531										break;
532									case SYSZ_OP_IMM:
533										tmp = caml_alloc(1, 3);
534										Store_field(tmp, 0, Val_int(insn[j-1].detail->sysz.operands[i].imm));
535										break;
536									case SYSZ_OP_MEM:
537										tmp = caml_alloc(1, 4);
538										tmp3 = caml_alloc(4, 0);
539										Store_field(tmp3, 0, Val_int(insn[j-1].detail->sysz.operands[i].mem.base));
540										Store_field(tmp3, 1, Val_int(insn[j-1].detail->sysz.operands[i].mem.index));
541										Store_field(tmp3, 2, caml_copy_int64(insn[j-1].detail->sysz.operands[i].mem.length));
542										Store_field(tmp3, 3, caml_copy_int64(insn[j-1].detail->sysz.operands[i].mem.disp));
543										Store_field(tmp, 0, tmp3);
544										break;
545									default: break;
546								}
547								Store_field(tmp2, 0, tmp);
548								Store_field(array, i, tmp2);
549							}
550						} else	// empty array
551							array = Atom(0);
552
553						Store_field(op_info_val, 1, array);
554
555						// finally, insert this into arch_info
556						Store_field(arch_info, 0, op_info_val);
557
558						Store_field(rec_insn, 9, arch_info);
559
560						break;
561
562					case CS_ARCH_XCORE:
563						arch_info = caml_alloc(1, 7);
564
565						op_info_val = caml_alloc(1, 0);
566
567						lcount = insn[j-1].detail->xcore.op_count;
568						if (lcount > 0) {
569							array = caml_alloc(lcount, 0);
570							for (i = 0; i < lcount; i++) {
571								tmp2 = caml_alloc(1, 0);
572								switch(insn[j-1].detail->xcore.operands[i].type) {
573									case XCORE_OP_REG:
574										tmp = caml_alloc(1, 1);
575										Store_field(tmp, 0, Val_int(insn[j-1].detail->xcore.operands[i].reg));
576										break;
577									case XCORE_OP_IMM:
578										tmp = caml_alloc(1, 2);
579										Store_field(tmp, 0, Val_int(insn[j-1].detail->xcore.operands[i].imm));
580										break;
581									case XCORE_OP_MEM:
582										tmp = caml_alloc(1, 3);
583										tmp3 = caml_alloc(4, 0);
584										Store_field(tmp3, 0, Val_int(insn[j-1].detail->xcore.operands[i].mem.base));
585										Store_field(tmp3, 1, Val_int(insn[j-1].detail->xcore.operands[i].mem.index));
586										Store_field(tmp3, 2, caml_copy_int64(insn[j-1].detail->xcore.operands[i].mem.disp));
587										Store_field(tmp3, 3, caml_copy_int64(insn[j-1].detail->xcore.operands[i].mem.direct));
588										Store_field(tmp, 0, tmp3);
589										break;
590									default: break;
591								}
592								Store_field(tmp2, 0, tmp);
593								Store_field(array, i, tmp2);
594							}
595						} else	// empty array
596							array = Atom(0);
597
598						Store_field(op_info_val, 0, array);
599
600						// finally, insert this into arch_info
601						Store_field(arch_info, 0, op_info_val);
602
603						Store_field(rec_insn, 9, arch_info);
604
605						break;
606
607					default: break;
608				}
609			}
610
611			Store_field(cons, 0, rec_insn);	// head
612			Store_field(cons, 1, list);		// tail
613			list = cons;
614		}
615		cs_free(insn, count);
616	}
617
618	// do not free the handle here
619	//cs_close(&handle);
620    CAMLreturn(list);
621}
622
623CAMLprim value ocaml_cs_disasm(value _arch, value _mode, value _code, value _addr, value _count)
624{
625	CAMLparam5(_arch, _mode, _code, _addr, _count);
626	CAMLlocal1(head);
627	csh handle;
628	cs_arch arch;
629	cs_mode mode = 0;
630	const uint8_t *code;
631	uint64_t addr;
632	size_t count, code_len;
633
634	switch (Int_val(_arch)) {
635		case 0:
636			arch = CS_ARCH_ARM;
637			break;
638		case 1:
639			arch = CS_ARCH_ARM64;
640			break;
641		case 2:
642			arch = CS_ARCH_MIPS;
643			break;
644		case 3:
645			arch = CS_ARCH_X86;
646			break;
647		case 4:
648			arch = CS_ARCH_PPC;
649			break;
650		case 5:
651			arch = CS_ARCH_SPARC;
652			break;
653		case 6:
654			arch = CS_ARCH_SYSZ;
655			break;
656		case 7:
657			arch = CS_ARCH_XCORE;
658			break;
659		default:
660			caml_invalid_argument("Invalid arch");
661			return Val_emptylist;
662	}
663
664	while (_mode != Val_emptylist) {
665		head = Field(_mode, 0);  /* accessing the head */
666		switch (Int_val(head)) {
667			case 0:
668				mode |= CS_MODE_LITTLE_ENDIAN;
669				break;
670			case 1:
671				mode |= CS_MODE_ARM;
672				break;
673			case 2:
674				mode |= CS_MODE_16;
675				break;
676			case 3:
677				mode |= CS_MODE_32;
678				break;
679			case 4:
680				mode |= CS_MODE_64;
681				break;
682			case 5:
683				mode |= CS_MODE_THUMB;
684				break;
685			case 6:
686				mode |= CS_MODE_MCLASS;
687				break;
688			case 7:
689				mode |= CS_MODE_V8;
690				break;
691			case 8:
692				mode |= CS_MODE_MICRO;
693				break;
694			case 9:
695				mode |= CS_MODE_MIPS3;
696				break;
697			case 10:
698				mode |= CS_MODE_MIPS32R6;
699				break;
700			case 11:
701				mode |= CS_MODE_MIPSGP64;
702				break;
703			case 12:
704				mode |= CS_MODE_V9;
705				break;
706			case 13:
707				mode |= CS_MODE_BIG_ENDIAN;
708				break;
709			case 14:
710				mode |= CS_MODE_MIPS32;
711				break;
712			case 15:
713				mode |= CS_MODE_MIPS64;
714				break;
715			default:
716				caml_invalid_argument("Invalid mode");
717				return Val_emptylist;
718		}
719		_mode = Field(_mode, 1);  /* point to the tail for next loop */
720	}
721
722	cs_err ret = cs_open(arch, mode, &handle);
723	if (ret != CS_ERR_OK) {
724		return Val_emptylist;
725	}
726
727	code = (uint8_t *)String_val(_code);
728	code_len = caml_string_length(_code);
729	addr = Int64_val(_addr);
730	count = Int64_val(_count);
731
732    CAMLreturn(_cs_disasm(arch, handle, code, code_len, addr, count));
733}
734
735CAMLprim value ocaml_cs_disasm_internal(value _arch, value _handle, value _code, value _addr, value _count)
736{
737	CAMLparam5(_arch, _handle, _code, _addr, _count);
738	csh handle;
739	cs_arch arch;
740	const uint8_t *code;
741	uint64_t addr, count, code_len;
742
743	handle = Int64_val(_handle);
744
745	arch = Int_val(_arch);
746	code = (uint8_t *)String_val(_code);
747	code_len = caml_string_length(_code);
748	addr = Int64_val(_addr);
749	count = Int64_val(_count);
750
751    CAMLreturn(_cs_disasm(arch, handle, code, code_len, addr, count));
752}
753
754CAMLprim value ocaml_open(value _arch, value _mode)
755{
756	CAMLparam2(_arch, _mode);
757	CAMLlocal2(list, head);
758	csh handle;
759	cs_arch arch;
760	cs_mode mode = 0;
761
762	list = Val_emptylist;
763
764	switch (Int_val(_arch)) {
765		case 0:
766			arch = CS_ARCH_ARM;
767			break;
768		case 1:
769			arch = CS_ARCH_ARM64;
770			break;
771		case 2:
772			arch = CS_ARCH_MIPS;
773			break;
774		case 3:
775			arch = CS_ARCH_X86;
776			break;
777		case 4:
778			arch = CS_ARCH_PPC;
779			break;
780		case 5:
781			arch = CS_ARCH_SPARC;
782			break;
783		case 6:
784			arch = CS_ARCH_SYSZ;
785			break;
786		case 7:
787			arch = CS_ARCH_XCORE;
788			break;
789		default:
790			caml_invalid_argument("Invalid arch");
791			return Val_emptylist;
792	}
793
794
795	while (_mode != Val_emptylist) {
796		head = Field(_mode, 0);  /* accessing the head */
797		switch (Int_val(head)) {
798			case 0:
799				mode |= CS_MODE_LITTLE_ENDIAN;
800				break;
801			case 1:
802				mode |= CS_MODE_ARM;
803				break;
804			case 2:
805				mode |= CS_MODE_16;
806				break;
807			case 3:
808				mode |= CS_MODE_32;
809				break;
810			case 4:
811				mode |= CS_MODE_64;
812				break;
813			case 5:
814				mode |= CS_MODE_THUMB;
815				break;
816			case 6:
817				mode |= CS_MODE_MCLASS;
818				break;
819			case 7:
820				mode |= CS_MODE_V8;
821				break;
822			case 8:
823				mode |= CS_MODE_MICRO;
824				break;
825			case 9:
826				mode |= CS_MODE_MIPS3;
827				break;
828			case 10:
829				mode |= CS_MODE_MIPS32R6;
830				break;
831			case 11:
832				mode |= CS_MODE_MIPSGP64;
833				break;
834			case 12:
835				mode |= CS_MODE_V9;
836				break;
837			case 13:
838				mode |= CS_MODE_BIG_ENDIAN;
839				break;
840			case 14:
841				mode |= CS_MODE_MIPS32;
842				break;
843			case 15:
844				mode |= CS_MODE_MIPS64;
845				break;
846			default:
847				caml_invalid_argument("Invalid mode");
848				return Val_emptylist;
849		}
850		_mode = Field(_mode, 1);  /* point to the tail for next loop */
851	}
852
853	if (cs_open(arch, mode, &handle) != 0)
854		CAMLreturn(Val_int(0));
855
856	CAMLlocal1(result);
857	result = caml_alloc(1, 0);
858	Store_field(result, 0, caml_copy_int64(handle));
859	CAMLreturn(result);
860}
861
862CAMLprim value ocaml_option(value _handle, value _opt, value _value)
863{
864	CAMLparam3(_handle, _opt, _value);
865	cs_opt_type opt;
866	int err;
867
868	switch (Int_val(_opt)) {
869		case 0:
870			opt = CS_OPT_SYNTAX;
871			break;
872		case 1:
873			opt = CS_OPT_DETAIL;
874			break;
875		case 2:
876			opt = CS_OPT_MODE;
877			break;
878		case 3:
879			opt = CS_OPT_MEM;
880			break;
881		case 4:
882			opt = CS_OPT_SKIPDATA;
883			break;
884		case 5:
885			opt = CS_OPT_SKIPDATA_SETUP;
886			break;
887		default:
888			caml_invalid_argument("Invalid option");
889			CAMLreturn(Val_int(CS_ERR_OPTION));
890	}
891
892	err = cs_option(Int64_val(_handle), opt, Int64_val(_value));
893
894	CAMLreturn(Val_int(err));
895}
896
897CAMLprim value ocaml_register_name(value _handle, value _reg)
898{
899	const char *name = cs_reg_name(Int64_val(_handle), Int_val(_reg));
900	if (!name) {
901		caml_invalid_argument("invalid reg_id");
902		name = "invalid";
903	}
904
905	return caml_copy_string(name);
906}
907
908CAMLprim value ocaml_instruction_name(value _handle, value _insn)
909{
910	const char *name = cs_insn_name(Int64_val(_handle), Int_val(_insn));
911	if (!name) {
912		caml_invalid_argument("invalid insn_id");
913		name = "invalid";
914	}
915
916	return caml_copy_string(name);
917}
918
919CAMLprim value ocaml_group_name(value _handle, value _insn)
920{
921	const char *name = cs_group_name(Int64_val(_handle), Int_val(_insn));
922	if (!name) {
923		caml_invalid_argument("invalid insn_id");
924		name = "invalid";
925	}
926
927	return caml_copy_string(name);
928}
929
930CAMLprim value ocaml_version(void)
931{
932	int version = cs_version(NULL, NULL);
933	return Val_int(version);
934}
935
936CAMLprim value ocaml_close(value _handle)
937{
938	CAMLparam1(_handle);
939	csh h;
940
941	h = Int64_val(_handle);
942
943	CAMLreturn(Val_int(cs_close(&h)));
944}
945