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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1998 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id: selection.ml 10507 2010-06-04 19:16:58Z maranget $ *)
(* Instruction selection for the ARM processor *)
open Misc
open Cmm
open Reg
open Arch
open Proc
open Mach
(* Immediate operands are 8-bit immediate values, zero-extended, and rotated
right by 0, 2, 4, ... 30 bits.
To avoid problems with Caml's 31-bit arithmetic,
we check only with 8-bit values shifted left 0 to 22 bits. *)
let rec is_immed n shift =
if shift > 22 then false
else if n land (0xFF lsl shift) = n then true
else is_immed n (shift + 2)
(* We have 12-bit + sign byte offsets for word accesses,
8-bit + sign word offsets for float accesses,
and 8-bit + sign byte offsets for bytes and shorts.
Use lowest common denominator. *)
let is_offset n = n < 256 && n > -256
let is_intconst = function Cconst_int n -> true | _ -> false
(* Soft emulation of float comparisons *)
let float_comparison_function = function
| Ceq -> "__eqdf2"
| Cne -> "__nedf2"
| Clt -> "__ltdf2"
| Cle -> "__ledf2"
| Cgt -> "__gtdf2"
| Cge -> "__gedf2"
(* Instruction selection *)
class selector = object(self)
inherit Selectgen.selector_generic as super
method! regs_for tyv =
(* Expand floats into pairs of integer registers *)
let nty = Array.length tyv in
let rec expand i =
if i >= nty then [] else begin
match tyv.(i) with
| Float -> Int :: Int :: expand (i+1)
| ty -> ty :: expand (i+1)
end in
Reg.createv (Array.of_list (expand 0))
method is_immediate n =
n land 0xFF = n || is_immed n 2
method select_addressing = function
Cop(Cadda, [arg; Cconst_int n]) when is_offset n ->
(Iindexed n, arg)
| Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) when is_offset n ->
(Iindexed n, Cop(Cadda, [arg1; arg2]))
| arg ->
(Iindexed 0, arg)
method select_shift_arith op shiftop shiftrevop args =
match args with
[arg1; Cop(Clsl, [arg2; Cconst_int n])]
when n > 0 && n < 32 && not(is_intconst arg2) ->
(Ispecific(Ishiftarith(shiftop, n)), [arg1; arg2])
| [arg1; Cop(Casr, [arg2; Cconst_int n])]
when n > 0 && n < 32 && not(is_intconst arg2) ->
(Ispecific(Ishiftarith(shiftop, -n)), [arg1; arg2])
| [Cop(Clsl, [arg1; Cconst_int n]); arg2]
when n > 0 && n < 32 && not(is_intconst arg1) ->
(Ispecific(Ishiftarith(shiftrevop, n)), [arg2; arg1])
| [Cop(Casr, [arg1; Cconst_int n]); arg2]
when n > 0 && n < 32 && not(is_intconst arg1) ->
(Ispecific(Ishiftarith(shiftrevop, -n)), [arg2; arg1])
| _ ->
super#select_operation op args
method! select_operation op args =
match op with
Cadda | Caddi ->
begin match args with
[arg1; Cconst_int n] when n < 0 && self#is_immediate (-n) ->
(Iintop_imm(Isub, -n), [arg1])
| _ ->
self#select_shift_arith op Ishiftadd Ishiftadd args
end
| Csuba | Csubi ->
begin match args with
[arg1; Cconst_int n] when n < 0 && self#is_immediate (-n) ->
(Iintop_imm(Iadd, -n), [arg1])
| [Cconst_int n; arg2] when self#is_immediate n ->
(Ispecific(Irevsubimm n), [arg2])
| _ ->
self#select_shift_arith op Ishiftsub Ishiftsubrev args
end
| Cmuli -> (* no multiply immediate *)
(Iintop Imul, args)
| Cdivi ->
begin match args with
[arg1; Cconst_int n] when n = 1 lsl (Misc.log2 n) ->
(Iintop_imm(Idiv, n), [arg1])
| _ ->
(Iextcall("__divsi3", false), args)
end
| Cmodi ->
begin match args with
[arg1; Cconst_int n] when n = 1 lsl (Misc.log2 n) ->
(Iintop_imm(Imod, n), [arg1])
| _ ->
(Iextcall("__modsi3", false), args)
end
| Ccheckbound _ ->
begin match args with
[Cop(Clsr, [arg1; Cconst_int n]); arg2]
when n > 0 && n < 32 && not(is_intconst arg2) ->
(Ispecific(Ishiftcheckbound n), [arg1; arg2])
| _ ->
super#select_operation op args
end
(* Turn floating-point operations into library function calls *)
| Caddf -> (Iextcall("__adddf3", false), args)
| Csubf -> (Iextcall("__subdf3", false), args)
| Cmulf -> (Iextcall("__muldf3", false), args)
| Cdivf -> (Iextcall("__divdf3", false), args)
| Cfloatofint -> (Iextcall("__floatsidf", false), args)
| Cintoffloat -> (Iextcall("__fixdfsi", false), args)
| Ccmpf comp ->
(Iintop_imm(Icomp(Isigned comp), 0),
[Cop(Cextcall(float_comparison_function comp,
typ_int, false, Debuginfo.none),
args)])
(* Add coercions around loads and stores of 32-bit floats *)
| Cload Single ->
(Iextcall("__extendsfdf2", false), [Cop(Cload Word, args)])
| Cstore Single ->
begin match args with
| [arg1; arg2] ->
let arg2' =
Cop(Cextcall("__truncdfsf2", typ_int, false, Debuginfo.none),
[arg2]) in
self#select_operation (Cstore Word) [arg1; arg2']
| _ -> assert false
end
(* Other operations are regular *)
| _ -> super#select_operation op args
method! select_condition = function
| Cop(Ccmpf cmp, args) ->
(Iinttest_imm(Isigned cmp, 0),
Cop(Cextcall(float_comparison_function cmp,
typ_int, false, Debuginfo.none),
args))
| expr ->
super#select_condition expr
(* Deal with some register irregularities:
1- In mul rd, rm, rs, the registers rm and rd must be different.
We deal with this by pretending that rm is also a result of the mul
operation.
2- For Inegf and Iabsf, force arguments and results in (r0, r1);
this simplifies code generation later.
*)
method! insert_op_debug op dbg rs rd =
match op with
| Iintop(Imul) ->
self#insert_debug (Iop op) dbg rs [| rd.(0); rs.(0) |]; rd
| Iabsf | Inegf ->
let r = [| phys_reg 0; phys_reg 1 |] in
self#insert_moves rs r;
self#insert_debug (Iop op) dbg r r;
self#insert_moves r rd;
rd
| _ ->
super#insert_op_debug op dbg rs rd
end
let fundecl f = (new selector)#emit_fundecl f
|
