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

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 1997 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 3593 2001-07-24 08:01:25Z xleroy $ *)
  14
  15 (* Instruction selection for the Alpha processor *)
  16
  17 open Misc
  18 open Cmm
  19 open Reg
  20 open Arch
  21 open Mach
  22
  23 class selector = object (self)
  24
  25 inherit Selectgen.selector_generic as super
  26
  27 method is_immediate n = digital_asm || (n >= 0 && n <= 255)
  28
  29 method select_addressing = function
  30     (* Force an explicit lda for non-scheduling assemblers,
  31        this allows our scheduler to do a better job. *)
  32     Cconst_symbol s when digital_asm ->
  33       (Ibased(s, 0), Ctuple [])
  34   | Cop((Cadda | Caddi), [Cconst_symbol s; Cconst_int n]) when digital_asm ->
  35       (Ibased(s, n), Ctuple [])
  36   | Cop((Cadda | Caddi), [arg; Cconst_int n]) ->
  37       (Iindexed n, arg)
  38   | Cop((Cadda | Caddi), [arg1; Cop(Caddi, [arg2; Cconst_int n])]) ->
  39       (Iindexed n, Cop(Cadda, [arg1; arg2]))
  40   | arg ->
  41       (Iindexed 0, arg)
  42
  43 method select_operation op args =
  44   match (op, args) with
  45     (* Recognize shift-add operations *)
  46     ((Caddi|Cadda),
  47      [arg2; Cop(Clsl, [arg1; Cconst_int(2|3 as shift)])]) ->
  48       (Ispecific(if shift = 2 then Iadd4 else Iadd8), [arg1; arg2])
  49   | ((Caddi|Cadda),
  50      [arg2; Cop(Cmuli, [arg1; Cconst_int(4|8 as mult)])]) ->
  51       (Ispecific(if mult = 4 then Iadd4 else Iadd8), [arg1; arg2])
  52   | ((Caddi|Cadda),
  53      [arg2; Cop(Cmuli, [Cconst_int(4|8 as mult); arg1])]) ->
  54       (Ispecific(if mult = 4 then Iadd4 else Iadd8), [arg1; arg2])
  55   | (Caddi, [Cop(Clsl, [arg1; Cconst_int(2|3 as shift)]); arg2]) ->
  56       (Ispecific(if shift = 2 then Iadd4 else Iadd8), [arg1; arg2])
  57   | (Caddi, [Cop(Cmuli, [arg1; Cconst_int(4|8 as mult)]); arg2]) ->
  58       (Ispecific(if mult = 4 then Iadd4 else Iadd8), [arg1; arg2])
  59   | (Caddi, [Cop(Cmuli, [Cconst_int(4|8 as mult); arg1]); arg2]) ->
  60       (Ispecific(if mult = 4 then Iadd4 else Iadd8), [arg1; arg2])
  61   | (Csubi, [Cop(Clsl, [arg1; Cconst_int(2|3 as shift)]); arg2]) ->
  62       (Ispecific(if shift = 2 then Isub4 else Isub8), [arg1; arg2])
  63   | (Csubi, [Cop(Cmuli, [Cconst_int(4|8 as mult); arg1]); arg2]) ->
  64       (Ispecific(if mult = 4 then Isub4 else Isub8), [arg1; arg2])
  65     (* Recognize truncation/normalization of 64-bit integers to 32 bits *)
  66   | (Casr, [Cop(Clsl, [arg; Cconst_int 32]); Cconst_int 32]) ->
  67       (Ispecific Itrunc32, [arg])
  68     (* Work around various limitations of the GNU assembler *)
  69   | ((Caddi|Cadda), [arg1; Cconst_int n])
  70     when not (self#is_immediate n) && self#is_immediate (-n) ->
  71       (Iintop_imm(Isub, -n), [arg1])
  72   | (Cdivi, [arg1; Cconst_int n])
  73     when (not digital_asm) && n <> 1 lsl (Misc.log2 n) ->
  74       (Iintop Idiv, args)
  75   | (Cmodi, [arg1; Cconst_int n])
  76     when (not digital_asm) && n <> 1 lsl (Misc.log2 n) ->
  77       (Iintop Imod, args)
  78   | _ ->
  79       super#select_operation op args
  80
  81 end
  82
  83 let fundecl f = (new selector)#emit_fundecl f