l4/pkg/ocaml/ocaml/contrib/asmcomp/amd64/arch.ml

   1 (***********************************************************************)
   2 (*                                                                     *)
   3 (*                           Objective Caml                            *)
   4 (*                                                                     *)
   5 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
   6 (*                                                                     *)
   7 (*  Copyright 2000 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: arch.ml 7784 2007-01-01 13:07:35Z xleroy $ *)
  14
  15 (* Machine-specific command-line options *)
  16
  17 let pic_code = ref true
  18
  19 let command_line_options =
  20   [ "-fPIC", Arg.Set pic_code,
  21       " Generate position-independent machine code (default)";
  22     "-fno-PIC", Arg.Clear pic_code,
  23       " Generate position-dependent machine code" ]
  24
  25 (* Specific operations for the AMD64 processor *)
  26
  27 open Format
  28
  29 type addressing_mode =
  30     Ibased of string * int              (* symbol + displ *)
  31   | Iindexed of int                     (* reg + displ *)
  32   | Iindexed2 of int                    (* reg + reg + displ *)
  33   | Iscaled of int * int                (* reg * scale + displ *)
  34   | Iindexed2scaled of int * int        (* reg + reg * scale + displ *)
  35
  36 type specific_operation =
  37     Ilea of addressing_mode             (* "lea" gives scaled adds *)
  38   | Istore_int of nativeint * addressing_mode (* Store an integer constant *)
  39   | Istore_symbol of string * addressing_mode (* Store a symbol *)
  40   | Ioffset_loc of int * addressing_mode (* Add a constant to a location *)
  41   | Ifloatarithmem of float_operation * addressing_mode
  42                                        (* Float arith operation with memory *)
  43 and float_operation =
  44     Ifloatadd | Ifloatsub | Ifloatmul | Ifloatdiv
  45
  46 (* Sizes, endianness *)
  47
  48 let big_endian = false
  49
  50 let size_addr = 8
  51 let size_int = 8
  52 let size_float = 8
  53
  54 (* Operations on addressing modes *)
  55
  56 let identity_addressing = Iindexed 0
  57
  58 let offset_addressing addr delta =
  59   match addr with
  60     Ibased(s, n) -> Ibased(s, n + delta)
  61   | Iindexed n -> Iindexed(n + delta)
  62   | Iindexed2 n -> Iindexed2(n + delta)
  63   | Iscaled(scale, n) -> Iscaled(scale, n + delta)
  64   | Iindexed2scaled(scale, n) -> Iindexed2scaled(scale, n + delta)
  65
  66 let num_args_addressing = function
  67     Ibased(s, n) -> 0
  68   | Iindexed n -> 1
  69   | Iindexed2 n -> 2
  70   | Iscaled(scale, n) -> 1
  71   | Iindexed2scaled(scale, n) -> 2
  72
  73 (* Printing operations and addressing modes *)
  74
  75 let print_addressing printreg addr ppf arg =
  76   match addr with
  77   | Ibased(s, 0) ->
  78       fprintf ppf "\"%s\"" s
  79   | Ibased(s, n) ->
  80       fprintf ppf "\"%s\" + %i" s n
  81   | Iindexed n ->
  82       let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
  83       fprintf ppf "%a%s" printreg arg.(0) idx
  84   | Iindexed2 n ->
  85       let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
  86       fprintf ppf "%a + %a%s" printreg arg.(0) printreg arg.(1) idx
  87   | Iscaled(scale, n) ->
  88       let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
  89       fprintf ppf "%a  * %i%s" printreg arg.(0) scale idx
  90   | Iindexed2scaled(scale, n) ->
  91       let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
  92       fprintf ppf "%a + %a * %i%s" printreg arg.(0) printreg arg.(1) scale idx
  93
  94 let print_specific_operation printreg op ppf arg =
  95   match op with
  96   | Ilea addr -> print_addressing printreg addr ppf arg
  97   | Istore_int(n, addr) ->
  98       fprintf ppf "[%a] := %nd" (print_addressing printreg addr) arg n
  99   | Istore_symbol(lbl, addr) ->
 100       fprintf ppf "[%a] := \"%s\"" (print_addressing printreg addr) arg lbl
 101   | Ioffset_loc(n, addr) ->
 102       fprintf ppf "[%a] +:= %i" (print_addressing printreg addr) arg n
 103   | Ifloatarithmem(op, addr) ->
 104       let op_name = function
 105       | Ifloatadd -> "+f"
 106       | Ifloatsub -> "-f"
 107       | Ifloatmul -> "*f"
 108       | Ifloatdiv -> "/f" in
 109       fprintf ppf "%a %s float64[%a]" printreg arg.(0) (op_name op)
 110                    (print_addressing printreg addr)
 111                    (Array.sub arg 1 (Array.length arg - 1))