← Back to branch summary

~ubuntu-branches/debian/sid/ocaml/sid

« back to all changes in this revision

Viewing changes to asmcomp/arm/selection.ml

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu
  • Date: 2011-04-21 21:35:08 UTC
  • mfrom: (1.1.11 upstream) (12.1.14 sid)
  • Revision ID: james.westby@ubuntu.com-20110421213508-kg34453aqmb0moha
* Fixes related to -output-obj with g++ (in debian/patches):
  - add Declare-primitive-name-table-as-const-char
  - add Avoid-multiple-declarations-in-generated-.c-files-in
  - fix Embed-bytecode-in-C-object-when-using-custom: the closing
    brace for extern "C" { ... } was missing in some cases

Show diffs side-by-side

added added

removed removed

Lines of Context:
asmcomp/arm/selection.ml
10
10
(*                                                                     *)
11
11
(***********************************************************************)
12
12
 
13
 
(* $Id: selection.ml 8768 2008-01-11 16:13:18Z doligez $ *)
 
13
(* $Id: selection.ml 10295 2010-04-22 12:39:40Z xleroy $ *)
14
14
 
15
15
(* Instruction selection for the ARM processor *)
16
16
 
18
18
open Cmm
19
19
open Reg
20
20
open Arch
 
21
open Proc
21
22
open Mach
22
23
 
23
24
(* Immediate operands are 8-bit immediate values, zero-extended, and rotated
39
40
 
40
41
let is_intconst = function Cconst_int n -> true | _ -> false
41
42
 
 
43
(* Soft emulation of float comparisons *)
 
44
 
 
45
let float_comparison_function = function
 
46
  | Ceq -> "__eqdf2"
 
47
  | Cne -> "__nedf2"
 
48
  | Clt -> "__ltdf2"
 
49
  | Cle -> "__ledf2"
 
50
  | Cgt -> "__gtdf2"
 
51
  | Cge -> "__gedf2"
 
52
 
42
53
(* Instruction selection *)
43
54
class selector = object(self)
44
55
 
45
56
inherit Selectgen.selector_generic as super
46
57
 
 
58
method! regs_for tyv =
 
59
  (* Expand floats into pairs of integer registers *)
 
60
  let nty = Array.length tyv in
 
61
  let rec expand i =
 
62
    if i >= nty then [] else begin
 
63
      match tyv.(i) with
 
64
      | Float -> Int :: Int :: expand (i+1)
 
65
      | ty -> ty :: expand (i+1)
 
66
    end in
 
67
  Reg.createv (Array.of_list (expand 0))
 
68
 
47
69
method is_immediate n =
48
70
  n land 0xFF = n || is_immed n 2
49
71
 
72
94
  | _ ->
73
95
      super#select_operation op args
74
96
 
75
 
method select_operation op args =
 
97
method! select_operation op args =
76
98
  match op with
77
99
    Cadda | Caddi ->
78
100
      begin match args with
114
136
      | _ ->
115
137
        super#select_operation op args
116
138
      end
 
139
  (* Turn floating-point operations into library function calls *)
 
140
  | Caddf -> (Iextcall("__adddf3", false), args)
 
141
  | Csubf -> (Iextcall("__subdf3", false), args)
 
142
  | Cmulf -> (Iextcall("__muldf3", false), args)
 
143
  | Cdivf -> (Iextcall("__divdf3", false), args)
 
144
  | Cfloatofint -> (Iextcall("__floatsidf", false), args)
 
145
  | Cintoffloat -> (Iextcall("__fixdfsi", false), args)
 
146
  | Ccmpf comp ->
 
147
      (Iintop_imm(Icomp(Isigned comp), 0),
 
148
       [Cop(Cextcall(float_comparison_function comp,
 
149
                     typ_int, false, Debuginfo.none),
 
150
            args)])
 
151
  (* Add coercions around loads and stores of 32-bit floats *)
 
152
  | Cload Single ->
 
153
      (Iextcall("__extendsfdf2", false), [Cop(Cload Word, args)])
 
154
  | Cstore Single ->
 
155
      begin match args with
 
156
      | [arg1; arg2] ->
 
157
          let arg2' =
 
158
            Cop(Cextcall("__truncdfsf2", typ_int, false, Debuginfo.none),
 
159
                [arg2]) in
 
160
          self#select_operation (Cstore Word) [arg1; arg2']
 
161
      | _ -> assert false
 
162
      end
 
163
  (* Other operations are regular *)
117
164
  | _ -> super#select_operation op args
118
165
 
119
 
(* In mul rd, rm, rs,  the registers rm and rd must be different.
 
166
method! select_condition = function
 
167
  | Cop(Ccmpf cmp, args) ->
 
168
      (Iinttest_imm(Isigned cmp, 0),
 
169
       Cop(Cextcall(float_comparison_function cmp,
 
170
                    typ_int, false, Debuginfo.none),
 
171
           args))
 
172
  | expr ->
 
173
      super#select_condition expr
 
174
 
 
175
(* Deal with some register irregularities:
 
176
 
 
177
1- In mul rd, rm, rs,  the registers rm and rd must be different.
120
178
   We deal with this by pretending that rm is also a result of the mul
121
 
   operation. *)
122
 
 
123
 
method insert_op_debug op dbg rs rd =
124
 
  if op = Iintop(Imul) then begin
125
 
    self#insert_debug (Iop op) dbg rs [| rd.(0); rs.(0) |]; rd
126
 
  end else
127
 
    super#insert_op_debug op dbg rs rd
 
179
   operation.
 
180
 
 
181
2- For Inegf and Iabsf, force arguments and results in (r0, r1);
 
182
   this simplifies code generation later.
 
183
*)
 
184
 
 
185
method! insert_op_debug op dbg rs rd =
 
186
  match op with
 
187
  | Iintop(Imul) ->
 
188
      self#insert_debug (Iop op) dbg rs [| rd.(0); rs.(0) |]; rd
 
189
  | Iabsf | Inegf ->
 
190
      let r = [| phys_reg 0; phys_reg 1 |] in
 
191
      self#insert_moves rs r;
 
192
      self#insert_debug (Iop op) dbg r r;
 
193
      self#insert_moves r rd;
 
194
      rd
 
195
  | _ ->
 
196
      super#insert_op_debug op dbg rs rd
128
197
 
129
198
end
130
199
 
131
200
let fundecl f = (new selector)#emit_fundecl f
132