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
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1998 Institut National de Recherche en Informatique et *)
(* Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* Instruction selection for the ARM processor *)
open Misc
open Cmm
open Reg
open Arch
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 signed offsets for word accesses,
8-bit signed word offsets for float accesses,
and 8-bit byte offsets for bytes and shorts.
Use lowest common denominator. *)
let is_offset n = n < 128 && n > -128
let is_intconst = function Cconst_int n -> true | _ -> false
(* Instruction selection *)
class selector = object(self)
inherit Selectgen.selector_generic as super
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
| _ -> super#select_operation op args
(* In mul rd, rm, rs, rm and rd must be different.
We deal with this by pretending that rm is also a result of the mul
operation. *)
method insert_op op rs rd =
if op = Iintop(Imul) then begin
self#insert (Iop op) rs [| rd.(0); rs.(0) |]; rd
end else
super#insert_op op rs rd
end
let fundecl f = (new selector)#emit_fundecl f
|
