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