annotate lab4/tran.ml @ 0:bfdcc3820b32

Basis
author Mike Spivey <mike@cs.ox.ac.uk>
date Thu, 05 Oct 2017 08:04:15 +0100
parents
children
rev   line source
0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
1 (* lab4/tran.ml *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
2 (* Copyright (c) 2017 J. M. Spivey *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
3
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
4 open Optree
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
5 open Target
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
6 open Regs
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
7 open Print
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
8
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
9 let debug = ref 0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
10
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
11 (* |release| -- release any register used by a value *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
12 let release =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
13 function
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
14 Register reg -> release_reg reg
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
15 | Index (reg, off) -> release_reg reg
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
16 | Index2 (r1, r2, n) -> release_reg r1; release_reg r2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
17 | _ -> ()
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
18
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
19 let fix_reg r = Register (get_reg (reg_of r))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
20
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
21 (* |gen_reg| -- emit instruction with result in a register *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
22 let gen_reg op rands =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
23 List.iter release (List.tl rands);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
24 let r' = fix_reg (List.hd rands) in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
25 emit op (r' :: List.tl rands);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
26 r'
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
27
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
28 (* |gen| -- emit an instruction *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
29 let gen op rands =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
30 List.iter release rands;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
31 emit op rands
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
32
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
33 (* |gen_move| -- move value to specific register *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
34 let gen_move dst src =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
35 if reg_of dst = R_any || reg_of dst = R_temp || dst = src then
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
36 src
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
37 else
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
38 gen_reg "mov" [dst; src]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
39
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
40
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
41 (* Tests for fitting in various immediate fields *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
42
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
43 (* |fits_offset| -- test for fitting in offset field of address *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
44 let fits_offset x = (-4096 < x && x < 4096)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
45
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
46 (* |fits_immed| -- test for fitting in immediate field *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
47 let fits_immed x =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
48 (* A conservative approximation, using shifts instead of rotates *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
49 let rec reduce r =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
50 if r land 3 <> 0 then r else reduce (r lsr 2) in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
51 x = 0 || x > 0 && reduce x < 256
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
52
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
53 (* |fits_move| -- test for fitting in immediate move *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
54 let fits_move x = fits_immed x || fits_immed (lnot x)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
55
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
56 (* |fits_add| -- test for fitting in immediate add *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
57 let fits_add x = fits_immed x || fits_immed (-x)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
58
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
59 (* |line| -- current line number *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
60 let line = ref 0
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
61
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
62 (* The main part of the code generator consists of a family of functions
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
63 e_X t, each generating code for a tree t, leaving the value in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
64 a register, or as an operand for another instruction, etc. *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
65
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
66 let anyreg = Register R_any
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
67 let anytemp = Register R_temp
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
68
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
69 (* |e_reg| -- evaluate expression with result in specified register *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
70 let rec e_reg t r =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
71 (* returns |Register| *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
72
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
73 (* Binary operation *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
74 let binary op t1 t2 =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
75 let v1 = e_reg t1 anyreg in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
76 let v2 = e_rand t2 in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
77 gen_reg op [r; v1; v2]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
78
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
79 (* Unary operation *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
80 and unary op t1 =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
81 let v1 = e_reg t1 anyreg in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
82 gen_reg op [r; v1]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
83
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
84 (* Comparison with boolean result *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
85 and compare op t1 t2 =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
86 let v1 = e_reg t1 anyreg in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
87 let v2 = e_rand t2 in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
88 release v1; release v2;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
89 let rr = fix_reg r in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
90 emit "cmp" [v1; v2];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
91 emit "mov" [rr; Const 0];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
92 emit op [rr; Const 1];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
93 rr in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
94
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
95 match t with
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
96 <CONST k> when fits_move k ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
97 gen_reg "mov" [r; Const k]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
98 | <CONST k> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
99 gen_reg "set" [r; Const k]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
100 | <LOCAL 0> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
101 gen_move r (Register R_fp)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
102 | <LOCAL n> when fits_add n ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
103 gen_reg "add" [r; Register R_fp; Const n]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
104 | <LOCAL n> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
105 emit "set" [Register R_ip; Const n];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
106 gen_reg "add" [r; Register R_fp; Register R_ip]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
107 | <GLOBAL x> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
108 gen_reg "set" [r; Global x]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
109 | <TEMP n> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
110 gen_move r (Register (Regs.use_temp n))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
111 | <(LOADW|LOADC), <REGVAR i>> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
112 let rv = List.nth stable i in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
113 reserve_reg rv; gen_move r (Register rv)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
114 | <LOADW, t1> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
115 let v1 = e_addr t1 in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
116 gen_reg "ldr" [r; v1]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
117 | <LOADC, t1> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
118 let v1 = e_addr t1 in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
119 gen_reg "ldrb" [r; v1]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
120
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
121 | <MONOP Uminus, t1> -> unary "neg" t1
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
122 | <MONOP Not, t1> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
123 let v1 = e_reg t1 anyreg in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
124 gen_reg "eor" [r; v1; Const 1]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
125 | <MONOP BitNot, t1> -> unary "mvn" t1
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
126
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
127 | <OFFSET, t1, <CONST n>> when fits_add n ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
128 (* Allow add for negative constants *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
129 let v1 = e_reg t1 anyreg in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
130 gen_reg "add" [r; v1; Const n]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
131 | <OFFSET, t1, t2> -> binary "add" t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
132
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
133 | <BINOP Plus, t1, t2> -> binary "add" t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
134 | <BINOP Minus, t1, t2> -> binary "sub" t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
135 | <BINOP And, t1, t2> -> binary "and" t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
136 | <BINOP Or, t1, t2> -> binary "orr" t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
137 | <BINOP Lsl, t1, t2> -> binary "lsl" t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
138 | <BINOP Lsr, t1, t2> -> binary "lsr" t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
139 | <BINOP Asr, t1, t2> -> binary "asr" t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
140 | <BINOP BitAnd, t1, t2> -> binary "and" t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
141 | <BINOP BitOr, t1, t2> -> binary "orr" t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
142
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
143 | <BINOP Times, t1, t2> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
144 (* The mul instruction needs both operands in registers *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
145 let v1 = e_reg t1 anyreg in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
146 let v2 = e_reg t2 anyreg in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
147 gen_reg "mul" [r; v1; v2]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
148
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
149 | <BINOP Eq, t1, t2> -> compare "moveq" t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
150 | <BINOP Neq, t1, t2> -> compare "movne" t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
151 | <BINOP Gt, t1, t2> -> compare "movgt" t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
152 | <BINOP Geq, t1, t2> -> compare "movge" t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
153 | <BINOP Lt, t1, t2> -> compare "movlt" t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
154 | <BINOP Leq, t1, t2> -> compare "movle" t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
155
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
156 | <BOUND, t1, t2> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
157 let v1 = e_reg t1 r in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
158 let v2 = e_rand t2 in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
159 release v2;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
160 emit "cmp" [v1; v2];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
161 emit "seths" [Register (R 0); Const !line];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
162 emit "blhs" [Global "check"];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
163 v1
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
164
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
165 | <NCHECK, t1> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
166 let v1 = e_reg t1 r in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
167 emit "cmp" [v1; Const 0];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
168 emit "seteq" [Register (R 0); Const !line];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
169 emit "bleq" [Global "nullcheck"];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
170 v1
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
171
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
172 | <w, @args> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
173 failwith (sprintf "eval $" [fInst w])
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
174
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
175 (* |e_rand| -- evaluate to form second operand *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
176 and e_rand =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
177 (* returns |Const| or |Register| *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
178 function
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
179 <CONST k> when fits_immed k -> Const k
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
180 | t -> e_reg t anyreg
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
181
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
182 (* |e_addr| -- evaluate to form an address for ldr or str *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
183 and e_addr =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
184 (* returns |Index| *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
185 function
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
186 <LOCAL n> when fits_offset n ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
187 Index (R_fp, n)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
188 | <OFFSET, t1, <CONST n>> when fits_offset n ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
189 let v1 = e_reg t1 anyreg in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
190 Index (reg_of v1, n)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
191 | t ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
192 let v1 = e_reg t anyreg in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
193 Index (reg_of v1, 0)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
194
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
195 (* |e_call| -- execute procedure call *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
196 let e_call =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
197 function
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
198 <GLOBAL f> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
199 gen "bl" [Global f]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
200 | t ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
201 let v1 = e_reg t anyreg in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
202 gen "blx" [v1]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
203
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
204 (* |e_stmt| -- generate code to execute a statement *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
205 let e_stmt t =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
206
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
207 (* Conditional jump *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
208 let condj op lab t1 t2 =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
209 let v1 = e_reg t1 anyreg in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
210 let v2 = e_rand t2 in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
211 gen "cmp" [v1; v2];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
212 gen op [Label lab] in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
213
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
214 (* Procedure call *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
215 let call t =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
216 spill_temps volatile; (* Spill any remaining temps *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
217 e_call t; (* Call the function *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
218 List.iter (function r -> (* Release argument registers *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
219 if not (is_free r) then release_reg r) volatile in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
220
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
221 match t with
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
222 <PCALL k, t1> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
223 call t1
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
224
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
225 | <DEFTMP n, <PCALL k, t1>> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
226 call t1;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
227 reserve_reg (R 0);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
228 Regs.def_temp n (R 0)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
229
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
230 | <DEFTMP n, t1> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
231 let v1 = e_reg t1 anytemp in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
232 Regs.def_temp n (reg_of v1)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
233
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
234 | <(STOREW|STOREC), t1, <REGVAR i>> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
235 let rv = List.nth stable i in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
236 release (e_reg t1 (Register rv))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
237 | <STOREW, t1, t2> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
238 let v1 = e_reg t1 anyreg in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
239 let v2 = e_addr t2 in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
240 gen "str" [v1; v2]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
241 | <STOREC, t1, t2> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
242 let v1 = e_reg t1 anyreg in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
243 let v2 = e_addr t2 in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
244 gen "strb" [v1; v2]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
245
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
246 | <RESULTW, t1> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
247 release (e_reg t1 (Register (R 0)))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
248
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
249 | <LABEL lab> -> emit_lab lab
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
250
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
251 | <JUMP lab> -> gen "b" [Label lab]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
252
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
253 | <JUMPC (Eq, lab), t1, t2> -> condj "beq" lab t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
254 | <JUMPC (Lt, lab), t1, t2> -> condj "blt" lab t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
255 | <JUMPC (Gt, lab), t1, t2> -> condj "bgt" lab t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
256 | <JUMPC (Leq, lab), t1, t2> -> condj "ble" lab t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
257 | <JUMPC (Geq, lab), t1, t2> -> condj "bge" lab t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
258 | <JUMPC (Neq, lab), t1, t2> -> condj "bne" lab t1 t2
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
259
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
260 | <JCASE (table, deflab), t1> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
261 (* This jump table code exploits the fact that on ARM, reading
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
262 the pc gives a value 8 bytes beyond the current instruction,
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
263 so in the ldrlo instruction below, pc points to the branch
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
264 table itself. *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
265 let v1 = e_reg t1 anyreg in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
266 emit "cmp" [v1; Const (List.length table)];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
267 gen "ldrlo" [Register R_pc; Index2 (R_pc, reg_of v1, 2)];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
268 gen "b" [Label deflab];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
269 List.iter (fun lab -> emit ".word" [Label lab]) table
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
270
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
271 | <ARG i, <TEMP k>> when i < 4 ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
272 (* Avoid annoying spill and reload if the value is a temp
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
273 already in the correct register: e.g. in f(g(x)). *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
274 let r = R i in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
275 let r1 = Regs.use_temp k in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
276 spill_temps [r];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
277 ignore (gen_move (Register r) (Register r1))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
278 | <ARG i, t1> when i < 4 ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
279 let r = R i in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
280 spill_temps [r];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
281 ignore (e_reg t1 (Register r))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
282 | <ARG i, t1> when i >= 4 ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
283 need_stack (4*i-12);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
284 let v1 = e_reg t1 anyreg in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
285 gen "str" [v1; Index (R_sp, 4*i-16)]
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
286
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
287 | <SLINK, <CONST 0>> -> ()
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
288 | <SLINK, t1> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
289 let r = R 10 in
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
290 spill_temps [r];
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
291 ignore (e_reg t1 (Register r))
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
292
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
293 | <w, @ts> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
294 failwith (sprintf "e_stmt $" [fInst w])
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
295
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
296 (* |process| -- generate code for a statement, or note a line number *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
297 let process =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
298 function
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
299 <LINE n> ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
300 if !line <> n then
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
301 emit_comment (Source.get_line n);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
302 line := n
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
303 | t ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
304 if !debug > 0 then emit_tree t;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
305 e_stmt t;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
306 if !debug > 1 then emit_comment (Regs.dump_regs ())
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
307
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
308 (* |translate| -- translate a procedure body *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
309 let translate lab nargs fsize nregv code =
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
310 Target.start_proc lab nargs fsize;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
311 Regs.get_regvars nregv;
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
312 (try List.iter process code with exc ->
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
313 (* Code generation failed, but let's see how far we got *)
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
314 Target.flush_proc (); raise exc);
Mike Spivey <mike@cs.ox.ac.uk>
parents:
diff changeset
315 Target.end_proc ()