]>
Commit | Line | Data |
---|---|---|
ac524af5 MM |
1 | diff --exclude=*CVS* -urN ocaml/asmcomp/linearize.ml ocaml+powerpcfix/asmcomp/linearize.ml |
2 | --- ocaml/asmcomp/linearize.ml Mon Feb 5 09:49:10 2001 | |
3 | +++ ocaml+powerpcfix/asmcomp/linearize.ml Tue Feb 19 18:06:40 2002 | |
4 | @@ -10,7 +10,7 @@ | |
5 | (* *) | |
6 | (***********************************************************************) | |
7 | ||
8 | -(* $Id$ *) | |
9 | +(* $Id$ *) | |
10 | ||
11 | (* Transformation of Mach code into a list of pseudo-instructions. *) | |
12 | ||
13 | @@ -25,7 +25,7 @@ | |
14 | ||
15 | type instruction = | |
16 | { mutable desc: instruction_desc; | |
17 | - next: instruction; | |
18 | + mutable next: instruction; | |
19 | arg: Reg.t array; | |
20 | res: Reg.t array; | |
21 | live: Reg.Set.t } | |
22 | diff --exclude=*CVS* -urN ocaml/asmcomp/linearize.mli ocaml+powerpcfix/asmcomp/linearize.mli | |
23 | --- ocaml/asmcomp/linearize.mli Mon Feb 5 09:49:10 2001 | |
24 | +++ ocaml+powerpcfix/asmcomp/linearize.mli Tue Feb 19 18:06:40 2002 | |
25 | @@ -10,7 +10,7 @@ | |
26 | (* *) | |
27 | (***********************************************************************) | |
28 | ||
29 | -(* $Id$ *) | |
30 | +(* $Id$ *) | |
31 | ||
32 | (* Transformation of Mach code into a list of pseudo-instructions. *) | |
33 | ||
34 | @@ -19,7 +19,7 @@ | |
35 | ||
36 | type instruction = | |
37 | { mutable desc: instruction_desc; | |
38 | - next: instruction; | |
39 | + mutable next: instruction; | |
40 | arg: Reg.t array; | |
41 | res: Reg.t array; | |
42 | live: Reg.Set.t } | |
43 | @@ -43,6 +43,7 @@ | |
44 | val end_instr: instruction | |
45 | val instr_cons: | |
46 | instruction_desc -> Reg.t array -> Reg.t array -> instruction -> instruction | |
47 | +val invert_test: Mach.test -> Mach.test | |
48 | ||
49 | type fundecl = | |
50 | { fun_name: string; | |
51 | diff --exclude=*CVS* -urN ocaml/asmcomp/power/arch.ml ocaml+powerpcfix/asmcomp/power/arch.ml | |
52 | --- ocaml/asmcomp/power/arch.ml Fri Apr 21 10:11:10 2000 | |
53 | +++ ocaml+powerpcfix/asmcomp/power/arch.ml Tue Feb 19 18:06:42 2002 | |
54 | @@ -10,7 +10,7 @@ | |
55 | (* *) | |
56 | (***********************************************************************) | |
57 | ||
58 | -(* $Id$ *) | |
59 | +(* $Id$ *) | |
60 | ||
61 | (* Specific operations for the PowerPC processor *) | |
62 | ||
63 | @@ -19,6 +19,7 @@ | |
64 | type specific_operation = | |
65 | Imultaddf (* multiply and add *) | |
66 | | Imultsubf (* multiply and subtract *) | |
67 | + | Ialloc_far of int (* allocation in large functions *) | |
68 | ||
69 | (* Addressing modes *) | |
70 | ||
71 | @@ -71,6 +72,8 @@ | |
72 | | Imultsubf -> | |
73 | fprintf ppf "%a *f %a -f %a" | |
74 | printreg arg.(0) printreg arg.(1) printreg arg.(2) | |
75 | + | Ialloc_far n -> | |
76 | + fprintf ppf "alloc_far %d" n | |
77 | ||
78 | (* Distinguish between the PowerPC and the Power/RS6000 submodels *) | |
79 | ||
80 | diff --exclude=*CVS* -urN ocaml/asmcomp/power/emit.mlp ocaml+powerpcfix/asmcomp/power/emit.mlp | |
81 | --- ocaml/asmcomp/power/emit.mlp Fri Mar 10 15:31:06 2000 | |
82 | +++ ocaml+powerpcfix/asmcomp/power/emit.mlp Tue Feb 19 18:06:42 2002 | |
83 | @@ -10,7 +10,7 @@ | |
84 | (* *) | |
85 | (***********************************************************************) | |
86 | ||
87 | -(* $Id$ *) | |
88 | +(* $Id$ *) | |
89 | ||
90 | (* Emission of PowerPC assembly code *) | |
91 | ||
92 | @@ -349,6 +349,7 @@ | |
93 | let name_for_specific = function | |
94 | Imultaddf -> "fmadd" | |
95 | | Imultsubf -> "fmsub" | |
96 | + | _ -> Misc.fatal_error "Emit.Ispecific" | |
97 | ||
98 | (* Name of current function *) | |
99 | let function_name = ref "" | |
100 | @@ -365,6 +366,132 @@ | |
101 | (* Number of jumptable entries *) | |
102 | let num_jumptbl_entries = ref 0 | |
103 | ||
104 | +(* Fixup conditional branches that exceed hardware allowed range *) | |
105 | + | |
106 | +let load_store_size = function | |
107 | + Ibased(s, d) -> 2 | |
108 | + | Iindexed ofs -> if is_immediate ofs then 1 else 3 | |
109 | + | Iindexed2 -> 1 | |
110 | + | |
111 | +let instr_size = function | |
112 | + Lend -> 0 | |
113 | + | Lop(Imove | Ispill | Ireload) -> 1 | |
114 | + | Lop(Iconst_int n) -> if is_native_immediate n then 1 else 2 | |
115 | + | Lop(Iconst_float s) -> if toc then 1 else 2 | |
116 | + | Lop(Iconst_symbol s) -> if toc then 1 else 2 | |
117 | + | Lop(Icall_ind) -> if toc then 6 else 2 | |
118 | + | Lop(Icall_imm s) -> | |
119 | + if toc && not (StringSet.mem s !defined_functions) then 2 else 1 | |
120 | + | Lop(Itailcall_ind) -> if toc then 7 else 5 | |
121 | + | Lop(Itailcall_imm s) -> | |
122 | + if s = !function_name then 1 | |
123 | + else if not toc || StringSet.mem s !defined_functions then 4 | |
124 | + else 8 | |
125 | + | Lop(Iextcall(s, true)) -> if toc then 2 else 3 | |
126 | + | Lop(Iextcall(s, false)) -> if pic_externals then 4 else 1 | |
127 | + | Lop(Istackoffset n) -> 1 | |
128 | + | Lop(Iload(chunk, addr)) -> | |
129 | + if chunk = Byte_signed | |
130 | + then load_store_size addr + 1 | |
131 | + else load_store_size addr | |
132 | + | Lop(Istore(chunk, addr)) -> load_store_size addr | |
133 | + | Lop(Ialloc n) -> 4 | |
134 | + | Lop(Ispecific(Ialloc_far n)) -> 5 | |
135 | + | Lop(Iintop Imod) -> if powerpc then 3 else 2 | |
136 | + | Lop(Iintop(Icomp cmp)) -> 4 | |
137 | + | Lop(Iintop op) -> 1 | |
138 | + | Lop(Iintop_imm(Idiv, n)) -> 2 | |
139 | + | Lop(Iintop_imm(Imod, n)) -> 4 | |
140 | + | Lop(Iintop_imm(Icomp cmp, n)) -> 4 | |
141 | + | Lop(Iintop_imm(op, n)) -> 1 | |
142 | + | Lop(Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf) -> 1 | |
143 | + | Lop(Ifloatofint) -> 9 | |
144 | + | Lop(Iintoffloat) -> 4 | |
145 | + | Lop(Ispecific sop) -> 1 | |
146 | + | Lreloadretaddr -> 2 | |
147 | + | Lreturn -> 2 | |
148 | + | Llabel lbl -> 0 | |
149 | + | Lbranch lbl -> 1 | |
150 | + | Lcondbranch(tst, lbl) -> 2 | |
151 | + | Lcondbranch3(lbl0, lbl1, lbl2) -> | |
152 | + 1 + (if lbl0 = None then 0 else 1) | |
153 | + + (if lbl1 = None then 0 else 1) | |
154 | + + (if lbl2 = None then 0 else 1) | |
155 | + | Lswitch jumptbl -> 8 | |
156 | + | Lsetuptrap lbl -> 1 | |
157 | + | Lpushtrap -> if toc then 5 else 4 | |
158 | + | Lpoptrap -> 2 | |
159 | + | Lraise -> if toc then 7 else 6 | |
160 | + | |
161 | +let label_map code = | |
162 | + let map = Hashtbl.create 37 in | |
163 | + let rec fill_map pc instr = | |
164 | + match instr.desc with | |
165 | + Lend -> (pc, map) | |
166 | + | Llabel lbl -> Hashtbl.add map lbl pc; fill_map pc instr.next | |
167 | + | op -> fill_map (pc + instr_size op) instr.next | |
168 | + in fill_map 0 code | |
169 | + | |
170 | +let max_branch_offset = 8180 | |
171 | +(* 14-bit signed offset in words. Remember to cut some slack | |
172 | + for multi-word instructions where the branch can be anywhere in | |
173 | + the middle. 12 words of slack is plenty. *) | |
174 | + | |
175 | +let branch_overflows map pc_branch lbl_dest = | |
176 | + let pc_dest = Hashtbl.find map lbl_dest in | |
177 | + let delta = pc_dest - (pc_branch + 1) in | |
178 | + delta <= -max_branch_offset || delta >= max_branch_offset | |
179 | + | |
180 | +let opt_branch_overflows map pc_branch opt_lbl_dest = | |
181 | + match opt_lbl_dest with | |
182 | + None -> false | |
183 | + | Some lbl_dest -> branch_overflows map pc_branch lbl_dest | |
184 | + | |
185 | +let fixup_branches codesize map code = | |
186 | + let expand_optbranch lbl n arg next = | |
187 | + match lbl with | |
188 | + None -> next | |
189 | + | Some l -> | |
190 | + instr_cons (Lcondbranch(Iinttest_imm(Isigned Ceq, n), l)) | |
191 | + arg [||] next in | |
192 | + let rec fixup did_fix pc instr = | |
193 | + match instr.desc with | |
194 | + Lend -> did_fix | |
195 | + | Lcondbranch(test, lbl) when branch_overflows map pc lbl -> | |
196 | + let lbl2 = new_label() in | |
197 | + let cont = | |
198 | + instr_cons (Lbranch lbl) [||] [||] | |
199 | + (instr_cons (Llabel lbl2) [||] [||] instr.next) in | |
200 | + instr.desc <- Lcondbranch(invert_test test, lbl2); | |
201 | + instr.next <- cont; | |
202 | + fixup true (pc + 2) instr.next | |
203 | + | Lcondbranch3(lbl0, lbl1, lbl2) | |
204 | + when opt_branch_overflows map pc lbl0 | |
205 | + || opt_branch_overflows map pc lbl1 | |
206 | + || opt_branch_overflows map pc lbl2 -> | |
207 | + let cont = | |
208 | + expand_optbranch lbl0 0 instr.arg | |
209 | + (expand_optbranch lbl1 1 instr.arg | |
210 | + (expand_optbranch lbl2 2 instr.arg instr.next)) in | |
211 | + instr.desc <- cont.desc; | |
212 | + instr.next <- cont.next; | |
213 | + fixup true pc instr | |
214 | + | Lop(Ialloc n) when codesize - pc >= max_branch_offset -> | |
215 | + instr.desc <- Lop(Ispecific(Ialloc_far n)); | |
216 | + fixup true (pc + 4) instr.next | |
217 | + | op -> | |
218 | + fixup did_fix (pc + instr_size op) instr.next | |
219 | + in fixup false 0 code | |
220 | + | |
221 | +(* Iterate branch expansion till all conditional branches are OK *) | |
222 | + | |
223 | +let rec branch_normalization code = | |
224 | + let (codesize, map) = label_map code in | |
225 | + if codesize >= max_branch_offset && fixup_branches codesize map code | |
226 | + then branch_normalization code | |
227 | + else () | |
228 | + | |
229 | + | |
230 | (* Output the assembly code for an instruction *) | |
231 | ||
232 | let rec emit_instr i dslot = | |
233 | @@ -551,6 +678,15 @@ | |
234 | ` addi {emit_reg i.res.(0)}, {emit_gpr 31}, 4\n`; | |
235 | record_frame i.live; | |
236 | ` bltl {emit_label !call_gc_label}\n` | |
237 | + | Lop(Ispecific(Ialloc_far n)) -> | |
238 | + if !call_gc_label = 0 then call_gc_label := new_label(); | |
239 | + let lbl = new_label() in | |
240 | + ` addi {emit_gpr 31}, {emit_gpr 31}, {emit_int(-n)}\n`; | |
241 | + ` cmplw {emit_gpr 31}, {emit_gpr 30}\n`; | |
242 | + ` bge {emit_label lbl}\n`; | |
243 | + record_frame i.live; | |
244 | + ` bl {emit_label !call_gc_label}\n`; | |
245 | + `{emit_label lbl}: addi {emit_reg i.res.(0)}, {emit_gpr 31}, 4\n` | |
246 | | Lop(Iintop Isub) -> (* subf has swapped arguments *) | |
247 | (* Use subfc instead of subf for RS6000 compatibility. *) | |
248 | ` subfc {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n` | |
249 | @@ -749,7 +885,7 @@ | |
250 | ` lwz {emit_gpr 29}, 4({emit_gpr 1})\n`; | |
251 | if toc then | |
252 | ` lwz {emit_gpr 2}, 20({emit_gpr 1})\n`; | |
253 | - ` addi {emit_gpr 1}, {emit_gpr 1}, {emit_int trap_frame_size}\n\n`; | |
254 | + ` addi {emit_gpr 1}, {emit_gpr 1}, {emit_int trap_frame_size}\n`; | |
255 | ` blr\n` | |
256 | ||
257 | and emit_delay = function | |
258 | @@ -831,6 +967,7 @@ | |
259 | ` addi {emit_gpr 1}, {emit_gpr 1}, {emit_int(-n)}\n` | |
260 | end; | |
261 | `{emit_label !tailrec_entry_point}:\n`; | |
262 | + branch_normalization fundecl.fun_body; | |
263 | emit_all fundecl.fun_body; | |
264 | (* Emit the glue code to call the GC *) | |
265 | if !call_gc_label > 0 then begin |