l4/pkg/ocaml/ocaml/contrib/asmcomp/arm/selection.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 1998 Institut National de Recherche en Informatique et   *)
   8 (*  en Automatique.  All rights reserved.  This file is distributed    *)
   9 (*  under the terms of the Q Public License version 1.0.               *)
  10 (*                                                                     *)
  11 (***********************************************************************)
  12
  13 (* $Id: selection.ml 8768 2008-01-11 16:13:18Z doligez $ *)
  14
  15 (* Instruction selection for the ARM processor *)
  16
  17 open Misc
  18 open Cmm
  19 open Reg
  20 open Arch
  21 open Mach
  22
  23 (* Immediate operands are 8-bit immediate values, zero-extended, and rotated
  24    right by 0, 2, 4, ... 30 bits.
  25    To avoid problems with Caml's 31-bit arithmetic,
  26    we check only with 8-bit values shifted left 0 to 22 bits. *)
  27
  28 let rec is_immed n shift =
  29   if shift > 22 then false
  30   else if n land (0xFF lsl shift) = n then true
  31   else is_immed n (shift + 2)
  32
  33 (* We have 12-bit + sign byte offsets for word accesses,
  34    8-bit + sign word offsets for float accesses,
  35    and 8-bit + sign byte offsets for bytes and shorts.
  36    Use lowest common denominator. *)
  37
  38 let is_offset n = n < 256 && n > -256
  39
  40 let is_intconst = function Cconst_int n -> true | _ -> false
  41
  42 (* Instruction selection *)
  43 class selector = object(self)
  44
  45 inherit Selectgen.selector_generic as super
  46
  47 method is_immediate n =
  48   n land 0xFF = n || is_immed n 2
  49
  50 method select_addressing = function
  51     Cop(Cadda, [arg; Cconst_int n]) when is_offset n ->
  52       (Iindexed n, arg)
  53   | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) when is_offset n ->
  54       (Iindexed n, Cop(Cadda, [arg1; arg2]))
  55   | arg ->
  56       (Iindexed 0, arg)
  57
  58 method select_shift_arith op shiftop shiftrevop args =
  59   match args with
  60     [arg1; Cop(Clsl, [arg2; Cconst_int n])]
  61     when n > 0 && n < 32 && not(is_intconst arg2) ->
  62       (Ispecific(Ishiftarith(shiftop, n)), [arg1; arg2])
  63   | [arg1; Cop(Casr, [arg2; Cconst_int n])]
  64     when n > 0 && n < 32 && not(is_intconst arg2) ->
  65       (Ispecific(Ishiftarith(shiftop, -n)), [arg1; arg2])
  66   | [Cop(Clsl, [arg1; Cconst_int n]); arg2]
  67     when n > 0 && n < 32 && not(is_intconst arg1) ->
  68       (Ispecific(Ishiftarith(shiftrevop, n)), [arg2; arg1])
  69   | [Cop(Casr, [arg1; Cconst_int n]); arg2]
  70     when n > 0 && n < 32 && not(is_intconst arg1) ->
  71       (Ispecific(Ishiftarith(shiftrevop, -n)), [arg2; arg1])
  72   | _ ->
  73       super#select_operation op args
  74
  75 method select_operation op args =
  76   match op with
  77     Cadda | Caddi ->
  78       begin match args with
  79         [arg1; Cconst_int n] when n < 0 && self#is_immediate (-n) ->
  80           (Iintop_imm(Isub, -n), [arg1])
  81       | _ ->
  82           self#select_shift_arith op Ishiftadd Ishiftadd args
  83       end
  84   | Csuba | Csubi ->
  85       begin match args with
  86         [arg1; Cconst_int n] when n < 0 && self#is_immediate (-n) ->
  87           (Iintop_imm(Iadd, -n), [arg1])
  88       | [Cconst_int n; arg2] when self#is_immediate n ->
  89           (Ispecific(Irevsubimm n), [arg2])
  90       | _ ->
  91           self#select_shift_arith op Ishiftsub Ishiftsubrev args
  92       end
  93   | Cmuli ->                    (* no multiply immediate *)
  94       (Iintop Imul, args)
  95   | Cdivi ->
  96       begin match args with
  97         [arg1; Cconst_int n] when n = 1 lsl (Misc.log2 n) ->
  98           (Iintop_imm(Idiv, n), [arg1])
  99       | _ ->
 100           (Iextcall("__divsi3", false), args)
 101       end
 102   | Cmodi ->
 103       begin match args with
 104         [arg1; Cconst_int n] when n = 1 lsl (Misc.log2 n) ->
 105           (Iintop_imm(Imod, n), [arg1])
 106       | _ ->
 107           (Iextcall("__modsi3", false), args)
 108       end
 109   | Ccheckbound _ ->
 110       begin match args with
 111         [Cop(Clsr, [arg1; Cconst_int n]); arg2]
 112         when n > 0 && n < 32 && not(is_intconst arg2) ->
 113           (Ispecific(Ishiftcheckbound n), [arg1; arg2])
 114       | _ ->
 115         super#select_operation op args
 116       end
 117   | _ -> super#select_operation op args
 118
 119 (* In mul rd, rm, rs,  the registers rm and rd must be different.
 120    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
 128
 129 end
 130
 131 let fundecl f = (new selector)#emit_fundecl f
 132