forked from colinbenner/ocaml-llvm
/
arch.ml
113 lines (94 loc) · 4.24 KB
/
arch.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
(***********************************************************************)
(* *)
(* OCaml *)
(* *)
(* 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. *)
(* *)
(***********************************************************************)
(* 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
(* Behavior of division *)
let division_crashes_on_overflow = true
(* 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))