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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
(***********************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 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 fast_math = ref false
let command_line_options =
[ "-ffast-math", Arg.Set fast_math,
" Inline trigonometric and exponential functions" ]
(* Specific operations for the Intel 386 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 *)
| Ipush (* Push regs on stack *)
| Ipush_int of nativeint (* Push an integer constant *)
| Ipush_symbol of string (* Push a symbol *)
| Ipush_load of addressing_mode (* Load a scalar and push *)
| Ipush_load_float of addressing_mode (* Load a float and push *)
| Isubfrev | Idivfrev (* Reversed float sub and div *)
| Ifloatarithmem of bool * float_operation * addressing_mode
(* Float arith operation with memory *)
(* bool: true=64 bits, false=32 *)
| Ifloatspecial of string
and float_operation =
Ifloatadd | Ifloatsub | Ifloatsubrev | Ifloatmul | Ifloatdiv | Ifloatdivrev
(* Sizes, endianness *)
let big_endian = false
let size_addr = 4
let size_int = 4
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] := %s" (print_addressing printreg addr) arg
(Nativeint.to_string 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
| Ipush ->
fprintf ppf "push ";
for i = 0 to Array.length arg - 1 do
if i > 0 then fprintf ppf ", ";
printreg ppf arg.(i)
done
| Ipush_int n ->
fprintf ppf "push %s" (Nativeint.to_string n)
| Ipush_symbol s ->
fprintf ppf "push \"%s\"" s
| Ipush_load addr ->
fprintf ppf "push [%a]" (print_addressing printreg addr) arg
| Ipush_load_float addr ->
fprintf ppf "pushfloat [%a]" (print_addressing printreg addr) arg
| Isubfrev ->
fprintf ppf "%a -f(rev) %a" printreg arg.(0) printreg arg.(1)
| Idivfrev ->
fprintf ppf "%a /f(rev) %a" printreg arg.(0) printreg arg.(1)
| Ifloatarithmem(double, op, addr) ->
let op_name = function
| Ifloatadd -> "+f"
| Ifloatsub -> "-f"
| Ifloatsubrev -> "-f(rev)"
| Ifloatmul -> "*f"
| Ifloatdiv -> "/f"
| Ifloatdivrev -> "/f(rev)" in
let long = if double then "float64" else "float32" in
fprintf ppf "%a %s %s[%a]" printreg arg.(0) (op_name op) long
(print_addressing printreg addr) (Array.sub arg 1 (Array.length arg - 1))
| Ifloatspecial name ->
fprintf ppf "%s " name;
for i = 0 to Array.length arg - 1 do
if i > 0 then fprintf ppf ", ";
printreg ppf arg.(i)
done
(* Stack alignment constraints *)
let stack_alignment =
match Config.system with
| "macosx" -> 16
| _ -> 4
|
