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
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
|
(* *********************************************************************)
(* *)
(* The Compcert verified compiler *)
(* *)
(* Xavier Leroy, INRIA Paris-Rocquencourt *)
(* *)
(* Copyright Institut National de Recherche en Informatique et en *)
(* Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU General Public License as published by *)
(* the Free Software Foundation, either version 2 of the License, or *)
(* (at your option) any later version. This file is also distributed *)
(* under the terms of the INRIA Non-Commercial License Agreement. *)
(* *)
(* *********************************************************************)
open Camlcoq
module StringMap = Map.Make(String)
(* Handling of linker sections *)
type section_name =
| Section_text
| Section_data of bool (* true = init data, false = uninit data *)
| Section_small_data of bool
| Section_const
| Section_small_const
| Section_string
| Section_literal
| Section_jumptable
| Section_user of string * bool (*writable*) * bool (*executable*)
type section_info = {
sec_name_init: section_name;
sec_name_uninit: section_name;
sec_writable: bool;
sec_executable: bool;
sec_near_access: bool
}
let default_section_info = {
sec_name_init = Section_data true;
sec_name_uninit = Section_data false;
sec_writable = true;
sec_executable = false;
sec_near_access = false
}
(* Built-in sections *)
let builtin_sections = [
"CODE",
{sec_name_init = Section_text;
sec_name_uninit = Section_text;
sec_writable = false; sec_executable = true;
sec_near_access = false};
"DATA",
{sec_name_init = Section_data true;
sec_name_uninit = Section_data false;
sec_writable = true; sec_executable = false;
sec_near_access = false};
"SDATA",
{sec_name_init = Section_small_data true;
sec_name_uninit = Section_small_data false;
sec_writable = true; sec_executable = false;
sec_near_access = true};
"CONST",
{sec_name_init = Section_const;
sec_name_uninit = Section_const;
sec_writable = false; sec_executable = false;
sec_near_access = false};
"SCONST",
{sec_name_init = Section_small_const;
sec_name_uninit = Section_small_const;
sec_writable = false; sec_executable = false;
sec_near_access = true};
"STRING",
{sec_name_init = Section_string;
sec_name_uninit = Section_string;
sec_writable = false; sec_executable = false;
sec_near_access = false};
"LITERAL",
{sec_name_init = Section_literal;
sec_name_uninit = Section_literal;
sec_writable = false; sec_executable = false;
sec_near_access = false};
"JUMPTABLE",
{sec_name_init = Section_jumptable;
sec_name_uninit = Section_jumptable;
sec_writable = false; sec_executable = false;
sec_near_access = false}
]
let default_section_table =
List.fold_right
(fun (s, i) t -> StringMap.add s i t)
builtin_sections StringMap.empty
(* The current mapping from section names to section info *)
let current_section_table : (section_info StringMap.t) ref =
ref StringMap.empty
(* The section to use for each global symbol: either explicitly
assigned using a "use_section" pragma, or inferred at definition
time. *)
let use_section_table : (AST.ident, section_info) Hashtbl.t =
Hashtbl.create 51
(* For each global symbol, the mapping sect name -> sect info
current at the time it was defined *)
let section_table_at_def : (AST.ident, section_info StringMap.t) Hashtbl.t =
Hashtbl.create 51
let initialize () =
current_section_table := default_section_table;
Hashtbl.clear use_section_table;
Hashtbl.clear section_table_at_def
(* Define or update a given section. *)
let define_section name ?iname ?uname ?writable ?executable ?near () =
let si =
try StringMap.find name !current_section_table
with Not_found -> default_section_info in
let writable =
match writable with Some b -> b | None -> si.sec_writable
and executable =
match executable with Some b -> b | None -> si.sec_executable
and near =
match near with Some b -> b | None -> si.sec_near_access in
let iname =
match iname with Some s -> Section_user(s, writable, executable)
| None -> si.sec_name_init in
let uname =
match uname with Some s -> Section_user(s, writable, executable)
| None -> si.sec_name_uninit in
let new_si =
{ sec_name_init = iname;
sec_name_uninit = uname;
sec_writable = writable;
sec_executable = executable;
sec_near_access = near } in
current_section_table := StringMap.add name new_si !current_section_table
(* Explicitly associate a section to a global symbol *)
let use_section_for id name =
try
let si = StringMap.find name !current_section_table in
Hashtbl.add use_section_table id si;
true
with Not_found ->
false
(* Default association of a section to a global symbol *)
let default_use_section id name =
Hashtbl.add section_table_at_def id !current_section_table;
if not (Hashtbl.mem use_section_table id) then begin
let ok = use_section_for id name in
assert ok
end
let define_function id =
default_use_section id "CODE"
let define_stringlit id =
default_use_section id "STRING"
let define_variable id size readonly =
default_use_section id
(if readonly
then if size <= !Clflags.option_small_const then "SCONST" else "CONST"
else if size <= !Clflags.option_small_data then "SDATA" else "DATA")
(* Determine section to use for a variable definition *)
let section_for_variable a initialized =
try
let si = Hashtbl.find use_section_table a in
if initialized then si.sec_name_init else si.sec_name_uninit
with Not_found ->
Section_data initialized
(* Determine (text, literal, jumptable) sections to use
for a function definition *)
let sections_for_function a =
let s_text =
try (Hashtbl.find use_section_table a).sec_name_init
with Not_found -> Section_text in
let s_table =
try Hashtbl.find section_table_at_def a
with Not_found -> default_section_table in
let s_literal =
try (StringMap.find "LITERAL" s_table).sec_name_init
with Not_found -> Section_literal in
let s_jumptable =
try (StringMap.find "JUMPTABLE" s_table).sec_name_init
with Not_found -> Section_jumptable in
(s_text, s_literal, s_jumptable)
(* Say if an atom is in a small data area *)
let atom_is_small_data a ofs =
try (Hashtbl.find use_section_table a).sec_near_access
with Not_found -> false
|
