-
Notifications
You must be signed in to change notification settings - Fork 0
/
FinalTypes.ml
134 lines (125 loc) · 3.5 KB
/
FinalTypes.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
(* Final Types *)
(* Registers *)
type register = Ax | Bx | Cx | Dx | Di | Si | Bp | Sp
| Al | Ah | Bl | Bh | Cl | Ch | Dl | Dh
(* Convert register to string *)
let string_of_register = function
| Ax -> "ax"
| Bx -> "bx"
| Cx -> "cx"
| Dx -> "dx"
| Al -> "al"
| Ah -> "ah"
| Di -> "di"
| Si -> "si"
| Bp -> "bp"
| Sp -> "sp"
| Bl -> "bl"
| Bh -> "bh"
| Cl -> "cl"
| Ch -> "ch"
| Dl -> "dl"
| Dh -> "dh"
(* In calculations we can have either registers or constants *)
type action_arg =
|Action_reg of register
|Constant of int
let string_of_action_arg = function
| Action_reg reg -> string_of_register reg
| Constant num -> (string_of_int num)
(* For Mov, Lea, etc we have a memory_location *)
type mem_loc =
| Register of register (* Register *)
| Mem_loc of (string * register * int) (* string ptr [reg + int] *)
| String_addr of string (* @strx *)
| Num of string (* Constant *)
let string_of_mem_loc = function
| Register reg -> (string_of_register reg)
| Mem_loc (size, reg, offset) ->
if (offset = 0)
then
Printf.sprintf "%s ptr [%s]"
size (string_of_register reg)
else
Printf.sprintf "%s ptr [%s%+d]"
size (string_of_register reg) offset
| String_addr str ->
Printf.sprintf "byte ptr %s" str
| Num str -> str
(* Convert register to its smaller counterpart when chars are handled *)
let get_register size reg =
match (size,reg) with
| ("byte",Ax) -> Al
| ("byte",Bx) -> Bl
| ("byte",Cx) -> Cl
| ("byte",Dx) -> Dl
| _ -> reg
(* Low Level Intermediate Code - 1 Assembly Instruction/Label per Constructor *)
type final_t =
| Start of string
| End of string
| Mov of (mem_loc * mem_loc)
| Call of string
| Lea of (mem_loc * mem_loc)
| Jump of string
| Cond_jump of (string * string)
| Add of (action_arg * action_arg)
| Sub of (action_arg * action_arg)
| IMul of register
| IDiv of register
| Push of mem_loc
| Pop of register
| Cwd
| Ret
| Label of string
| Misc of string
| Cmp of (register * register)
| Proc of string
let string_of_final_t = function
| Start str -> str
| End str -> str
| Mov (m1, m2) ->
Printf.sprintf "\tmov\t%s, %s\n"
(string_of_mem_loc m1)
(string_of_mem_loc m2)
| Call str ->
Printf.sprintf "\tcall\tnear ptr %s\n" str
| Lea (m1,m2) ->
Printf.sprintf "\tlea\t%s, %s\n"
(string_of_mem_loc m1)
(string_of_mem_loc m2)
| Jump str ->
Printf.sprintf "\tjmp\t%s\n" str
| Cond_jump (c,str) ->
Printf.sprintf "\t%s\t%s\n" c str
| Add (a1, a2) ->
Printf.sprintf "\tadd\t%s, %s\n"
(string_of_action_arg a1)
(string_of_action_arg a2)
| Sub (a1, a2) ->
Printf.sprintf "\tsub\t%s, %s\n"
(string_of_action_arg a1)
(string_of_action_arg a2)
| IMul reg ->
Printf.sprintf "\timul\t%s\n"
(string_of_register reg)
| IDiv reg ->
Printf.sprintf "\tidiv\t%s\n"
(string_of_register reg)
| Push mem ->
Printf.sprintf "\tpush\t%s\n"
(string_of_mem_loc mem)
| Pop reg ->
Printf.sprintf "\tpop\t%s\n"
(string_of_register reg)
| Cwd -> "\tcwd\n"
| Ret -> "\tret\n"
| Label lab ->
Printf.sprintf "%s:\n" lab
| Misc str -> str
| Cmp (r1,r2) ->
Printf.sprintf "\tcmp\t%s,%s\n"
(string_of_register r1)
(string_of_register r2)
| Proc str ->
Printf.sprintf "%s\tproc\tnear\n" str