New branch binary-annot by Fabrice Le Fessant from r10789

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/binary-annot@10790 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 111 insertions, 0 deletions

diff --git a/ocaml-binary-annot/asmcomp/amd64/arch.ml b/ocaml-binary-annot/asmcomp/amd64/arch.ml
new file mode 100644
index 0000000000..3e8f4b1113
--- /dev/null
+++ b/ocaml-binary-annot/asmcomp/amd64/arch.ml
@@ -0,0 +1,111 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
+(*                                                                     *)
+(*  Copyright 2000 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(* Machine-specific command-line options *)
+
+let pic_code = ref true
+
+let command_line_options =
+  [ "-fPIC", Arg.Set pic_code,
+      " Generate position-independent machine code (default)";
+    "-fno-PIC", Arg.Clear pic_code,
+      " Generate position-dependent machine code" ]
+
+(* Specific operations for the AMD64 processor *)
+
+open Format
+
+type addressing_mode =
+    Ibased of string * int              (* symbol + displ *)
+  | Iindexed of int                     (* reg + displ *)
+  | Iindexed2 of int                    (* reg + reg + displ *)
+  | Iscaled of int * int                (* reg * scale + displ *)
+  | Iindexed2scaled of int * int        (* reg + reg * scale + displ *)
+
+type specific_operation =
+    Ilea of addressing_mode             (* "lea" gives scaled adds *)
+  | Istore_int of nativeint * addressing_mode (* Store an integer constant *)
+  | Istore_symbol of string * addressing_mode (* Store a symbol *)
+  | Ioffset_loc of int * addressing_mode (* Add a constant to a location *)
+  | Ifloatarithmem of float_operation * addressing_mode
+                                       (* Float arith operation with memory *)
+and float_operation =
+    Ifloatadd | Ifloatsub | Ifloatmul | Ifloatdiv
+
+(* Sizes, endianness *)
+
+let big_endian = false
+
+let size_addr = 8
+let size_int = 8
+let size_float = 8
+
+(* Operations on addressing modes *)
+
+let identity_addressing = Iindexed 0
+
+let offset_addressing addr delta =
+  match addr with
+    Ibased(s, n) -> Ibased(s, n + delta)
+  | Iindexed n -> Iindexed(n + delta)
+  | Iindexed2 n -> Iindexed2(n + delta)
+  | Iscaled(scale, n) -> Iscaled(scale, n + delta)
+  | Iindexed2scaled(scale, n) -> Iindexed2scaled(scale, n + delta)
+
+let num_args_addressing = function
+    Ibased(s, n) -> 0
+  | Iindexed n -> 1
+  | Iindexed2 n -> 2
+  | Iscaled(scale, n) -> 1
+  | Iindexed2scaled(scale, n) -> 2
+
+(* Printing operations and addressing modes *)
+
+let print_addressing printreg addr ppf arg =
+  match addr with
+  | Ibased(s, 0) ->
+      fprintf ppf "\"%s\"" s
+  | Ibased(s, n) ->
+      fprintf ppf "\"%s\" + %i" s n
+  | Iindexed n ->
+      let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
+      fprintf ppf "%a%s" printreg arg.(0) idx
+  | Iindexed2 n ->
+      let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
+      fprintf ppf "%a + %a%s" printreg arg.(0) printreg arg.(1) idx
+  | Iscaled(scale, n) ->
+      let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
+      fprintf ppf "%a  * %i%s" printreg arg.(0) scale idx
+  | Iindexed2scaled(scale, n) ->
+      let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
+      fprintf ppf "%a + %a * %i%s" printreg arg.(0) printreg arg.(1) scale idx
+
+let print_specific_operation printreg op ppf arg =
+  match op with
+  | Ilea addr -> print_addressing printreg addr ppf arg
+  | Istore_int(n, addr) ->
+      fprintf ppf "[%a] := %nd" (print_addressing printreg addr) arg n
+  | Istore_symbol(lbl, addr) ->
+      fprintf ppf "[%a] := \"%s\"" (print_addressing printreg addr) arg lbl
+  | Ioffset_loc(n, addr) ->
+      fprintf ppf "[%a] +:= %i" (print_addressing printreg addr) arg n
+  | Ifloatarithmem(op, addr) ->
+      let op_name = function
+      | Ifloatadd -> "+f"
+      | Ifloatsub -> "-f"
+      | Ifloatmul -> "*f"
+      | Ifloatdiv -> "/f" in
+      fprintf ppf "%a %s float64[%a]" printreg arg.(0) (op_name op)
+                   (print_addressing printreg addr)
+                   (Array.sub arg 1 (Array.length arg - 1))