1 | open BitVectors;; |
---|
2 | |
---|
3 | type ('a,'b) union2 = [ `U1 of 'a | `U2 of 'b ] |
---|
4 | type ('a,'b,'c) union3 = [ `U1 of 'a | `U2 of 'b | `U3 of 'c ] |
---|
5 | type ('a,'b,'c,'d,'e,'f) union6 = [ `U1 of 'a | `U2 of 'b | `U3 of 'c | `U4 of 'd | `U5 of 'e | `U6 of 'f ] |
---|
6 | |
---|
7 | type direct = [ `DIRECT of byte ] |
---|
8 | type indirect = [ `INDIRECT of bit ] |
---|
9 | type ext_indirect = [ `EXT_INDIRECT of bit ] |
---|
10 | type reg = [ `REG of bit * bit * bit ] |
---|
11 | type acc = [ `A ] |
---|
12 | type b = [ `B ] |
---|
13 | type dptr = [ `DPTR ] |
---|
14 | type data = [ `DATA of byte ] |
---|
15 | type data16 = [ `DATA16 of word ] |
---|
16 | type acc_dptr = [ `A_DPTR ] |
---|
17 | type acc_pc = [ `A_PC ] |
---|
18 | type ext_indirect_dptr = [ `EXT_IND_DPTR ] |
---|
19 | type indirect_dptr = [ `IND_DPTR ] |
---|
20 | type carry = [ `C ] |
---|
21 | type bit = [ `BIT of byte ] |
---|
22 | type nbit = [ `NBIT of byte ] |
---|
23 | type rel = [ `REL of byte ] |
---|
24 | type addr11 = [ `ADDR11 of word11 ] |
---|
25 | type addr16 = [ `ADDR16 of word ] |
---|
26 | |
---|
27 | type 'addr jump = |
---|
28 | [ `JC of 'addr |
---|
29 | | `JNC of 'addr |
---|
30 | | `JB of bit * 'addr |
---|
31 | | `JNB of bit * 'addr |
---|
32 | | `JBC of bit * 'addr |
---|
33 | | `JZ of 'addr |
---|
34 | | `JNZ of 'addr |
---|
35 | | `CJNE of (acc * [ direct | data ], [ reg | indirect ] * data) union2 * 'addr |
---|
36 | | `DJNZ of [ reg | direct ] * 'addr |
---|
37 | ] |
---|
38 | |
---|
39 | type 'addr preinstruction = |
---|
40 | (* arithmetic operations *) |
---|
41 | [ `ADD of acc * [ reg | direct | indirect | data ] |
---|
42 | | `ADDC of acc * [ reg | direct | indirect | data ] |
---|
43 | | `SUBB of acc * [ reg | direct | indirect | data ] |
---|
44 | | `INC of [ acc | reg | direct | indirect | dptr ] |
---|
45 | | `DEC of [ acc | reg | direct | indirect ] |
---|
46 | | `MUL of acc * b |
---|
47 | | `DIV of acc * b |
---|
48 | | `DA of acc |
---|
49 | |
---|
50 | (* logical operations *) |
---|
51 | | `ANL of |
---|
52 | (acc * [ reg | direct | indirect | data ], |
---|
53 | direct * [ acc | data ], |
---|
54 | carry * [ bit | nbit]) union3 |
---|
55 | | `ORL of |
---|
56 | (acc * [ reg | data | direct | indirect ], |
---|
57 | direct * [ acc | data ], |
---|
58 | carry * [ bit | nbit]) union3 |
---|
59 | | `XRL of |
---|
60 | (acc * [ data | reg | direct | indirect ], |
---|
61 | direct * [ acc | data ]) union2 |
---|
62 | | `CLR of [ acc | carry | bit ] |
---|
63 | | `CPL of [ acc | carry | bit ] |
---|
64 | | `RL of acc |
---|
65 | | `RLC of acc |
---|
66 | | `RR of acc |
---|
67 | | `RRC of acc |
---|
68 | | `SWAP of acc |
---|
69 | |
---|
70 | (* data transfer *) |
---|
71 | | `MOV of |
---|
72 | (acc * [ reg | direct | indirect | data ], |
---|
73 | [ reg | indirect ] * [ acc | direct | data ], |
---|
74 | direct * [ acc | reg | direct | indirect | data ], |
---|
75 | dptr * data16, |
---|
76 | carry * bit, |
---|
77 | bit * carry |
---|
78 | ) union6 |
---|
79 | | `MOVC of acc * [ acc_dptr | acc_pc ] |
---|
80 | | `MOVX of (acc * [ ext_indirect | ext_indirect_dptr ], |
---|
81 | [ ext_indirect | ext_indirect_dptr ] * acc) union2 |
---|
82 | | `SETB of [ carry | bit ] |
---|
83 | | `PUSH of direct |
---|
84 | | `POP of direct |
---|
85 | | `XCH of acc * [ reg | direct | indirect ] |
---|
86 | | `XCHD of acc * indirect |
---|
87 | |
---|
88 | (* program branching *) |
---|
89 | | 'addr jump |
---|
90 | | `ACALL of addr11 |
---|
91 | | `LCALL of addr16 |
---|
92 | | `RET |
---|
93 | | `RETI |
---|
94 | | `AJMP of addr11 |
---|
95 | | `LJMP of addr16 |
---|
96 | | `SJMP of rel |
---|
97 | | `JMP of indirect_dptr |
---|
98 | | `NOP ] |
---|
99 | |
---|
100 | type instruction = rel preinstruction |
---|
101 | |
---|
102 | type labelled_instruction = |
---|
103 | [ instruction |
---|
104 | | `Cost of string |
---|
105 | | `Label of string |
---|
106 | | `Jmp of string |
---|
107 | | `Call of string |
---|
108 | | `Mov of dptr * string |
---|
109 | | `WithLabel of [`Label of string] jump |
---|
110 | ] |
---|
111 | |
---|
112 | (* pairs <datalabel,size> *) |
---|
113 | type preamble = (string * int) list |
---|
114 | |
---|
115 | type program = |
---|
116 | { preamble : preamble ; |
---|
117 | exit_label : Label.t ; |
---|
118 | code : labelled_instruction list ; |
---|
119 | has_main : bool } |
---|