1997-07-24 04:49:12 -07:00
|
|
|
(***********************************************************************)
|
|
|
|
(* *)
|
|
|
|
(* Objective Caml *)
|
|
|
|
(* *)
|
|
|
|
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
|
|
|
|
(* *)
|
|
|
|
(* Copyright 1997 Institut National de Recherche en Informatique et *)
|
1999-11-17 10:59:06 -08:00
|
|
|
(* en Automatique. All rights reserved. This file is distributed *)
|
|
|
|
(* under the terms of the Q Public License version 1.0. *)
|
1997-07-24 04:49:12 -07:00
|
|
|
(* *)
|
|
|
|
(***********************************************************************)
|
|
|
|
|
|
|
|
(* $Id$ *)
|
|
|
|
|
|
|
|
(* Instruction selection for the Alpha processor *)
|
|
|
|
|
|
|
|
open Misc
|
|
|
|
open Cmm
|
|
|
|
open Reg
|
|
|
|
open Arch
|
|
|
|
open Mach
|
|
|
|
|
1998-06-25 06:14:07 -07:00
|
|
|
class selector = object (self)
|
1997-07-24 04:49:12 -07:00
|
|
|
|
1998-06-24 12:22:26 -07:00
|
|
|
inherit Selectgen.selector_generic as super
|
1997-07-24 04:49:12 -07:00
|
|
|
|
1997-07-27 08:08:39 -07:00
|
|
|
method is_immediate n = digital_asm || (n >= 0 && n <= 255)
|
1997-07-24 04:49:12 -07:00
|
|
|
|
|
|
|
method select_addressing = function
|
1997-07-27 08:08:39 -07:00
|
|
|
(* Force an explicit lda for non-scheduling assemblers,
|
1997-07-29 18:12:19 -07:00
|
|
|
this allows our scheduler to do a better job. *)
|
1997-07-27 08:08:39 -07:00
|
|
|
Cconst_symbol s when digital_asm ->
|
1997-07-24 04:49:12 -07:00
|
|
|
(Ibased(s, 0), Ctuple [])
|
1997-07-29 18:12:19 -07:00
|
|
|
| Cop(Cadda, [Cconst_symbol s; Cconst_int n]) when digital_asm ->
|
1997-07-24 04:49:12 -07:00
|
|
|
(Ibased(s, n), Ctuple [])
|
|
|
|
| Cop(Cadda, [arg; Cconst_int n]) ->
|
|
|
|
(Iindexed n, arg)
|
|
|
|
| Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) ->
|
|
|
|
(Iindexed n, Cop(Cadda, [arg1; arg2]))
|
|
|
|
| arg ->
|
|
|
|
(Iindexed 0, arg)
|
|
|
|
|
|
|
|
method select_operation op args =
|
|
|
|
match (op, args) with
|
1997-10-15 02:20:44 -07:00
|
|
|
(* Recognize shift-add operations *)
|
1997-07-24 04:49:12 -07:00
|
|
|
((Caddi|Cadda),
|
|
|
|
[arg2; Cop(Clsl, [arg1; Cconst_int(2|3 as shift)])]) ->
|
|
|
|
(Ispecific(if shift = 2 then Iadd4 else Iadd8), [arg1; arg2])
|
|
|
|
| ((Caddi|Cadda),
|
|
|
|
[arg2; Cop(Cmuli, [arg1; Cconst_int(4|8 as mult)])]) ->
|
|
|
|
(Ispecific(if mult = 4 then Iadd4 else Iadd8), [arg1; arg2])
|
|
|
|
| ((Caddi|Cadda),
|
|
|
|
[arg2; Cop(Cmuli, [Cconst_int(4|8 as mult); arg1])]) ->
|
|
|
|
(Ispecific(if mult = 4 then Iadd4 else Iadd8), [arg1; arg2])
|
|
|
|
| (Caddi, [Cop(Clsl, [arg1; Cconst_int(2|3 as shift)]); arg2]) ->
|
|
|
|
(Ispecific(if shift = 2 then Iadd4 else Iadd8), [arg1; arg2])
|
|
|
|
| (Caddi, [Cop(Cmuli, [arg1; Cconst_int(4|8 as mult)]); arg2]) ->
|
|
|
|
(Ispecific(if mult = 4 then Iadd4 else Iadd8), [arg1; arg2])
|
|
|
|
| (Caddi, [Cop(Cmuli, [Cconst_int(4|8 as mult); arg1]); arg2]) ->
|
|
|
|
(Ispecific(if mult = 4 then Iadd4 else Iadd8), [arg1; arg2])
|
|
|
|
| (Csubi, [Cop(Clsl, [arg1; Cconst_int(2|3 as shift)]); arg2]) ->
|
|
|
|
(Ispecific(if shift = 2 then Isub4 else Isub8), [arg1; arg2])
|
|
|
|
| (Csubi, [Cop(Cmuli, [Cconst_int(4|8 as mult); arg1]); arg2]) ->
|
|
|
|
(Ispecific(if mult = 4 then Isub4 else Isub8), [arg1; arg2])
|
2000-02-04 07:08:29 -08:00
|
|
|
(* Recognize truncation/normalization of 64-bit integers to 32 bits *)
|
|
|
|
| (Casr, [Cop(Clsl, [arg; Cconst_int 32]); Cconst_int 32]) ->
|
|
|
|
(Ispecific Itrunc32, [arg])
|
1997-10-15 02:20:44 -07:00
|
|
|
(* Work around various limitations of the GNU assembler *)
|
2000-01-05 05:07:18 -08:00
|
|
|
| ((Caddi|Cadda), [arg1; Cconst_int n])
|
|
|
|
when not (self#is_immediate n) && self#is_immediate (-n) ->
|
1997-07-30 20:50:32 -07:00
|
|
|
(Iintop_imm(Isub, -n), [arg1])
|
1997-07-27 12:26:13 -07:00
|
|
|
| (Cdivi, [arg1; Cconst_int n])
|
|
|
|
when (not digital_asm) && n <> 1 lsl (Misc.log2 n) ->
|
|
|
|
(Iintop Idiv, args)
|
|
|
|
| (Cmodi, [arg1; Cconst_int n])
|
|
|
|
when (not digital_asm) && n <> 1 lsl (Misc.log2 n) ->
|
|
|
|
(Iintop Imod, args)
|
1997-07-24 04:49:12 -07:00
|
|
|
| _ ->
|
|
|
|
super#select_operation op args
|
|
|
|
|
|
|
|
end
|
|
|
|
|
1998-06-24 12:22:26 -07:00
|
|
|
let fundecl f = (new selector)#emit_fundecl f
|