blob: 4d53d64a192a151e3d9d2c462a935b4c68155647 (
plain)
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
|
(***********************************************************************)
(* *)
(* 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. *)
(* *)
(***********************************************************************)
open Config
open Clflags
open Compenv
let process_interface_file ppf name =
Optcompile.interface ppf name (output_prefix name)
let process_implementation_file ppf name =
let opref = output_prefix name in
Optcompile.implementation ppf name opref;
objfiles := (opref ^ ".cmx") :: !objfiles
let cmxa_present = ref false;;
let process_file ppf name =
if Filename.check_suffix name ".ml"
|| Filename.check_suffix name ".mlt" then
process_implementation_file ppf name
else if Filename.check_suffix name !Config.interface_suffix then begin
let opref = output_prefix name in
Optcompile.interface ppf name opref;
if !make_package then objfiles := (opref ^ ".cmi") :: !objfiles
end
else if Filename.check_suffix name ".cmx" then
objfiles := name :: !objfiles
else if Filename.check_suffix name ".cmxa" then begin
cmxa_present := true;
objfiles := name :: !objfiles
end else if Filename.check_suffix name ".cmi" && !make_package then
objfiles := name :: !objfiles
else if Filename.check_suffix name ext_obj
|| Filename.check_suffix name ext_lib then
ccobjs := name :: !ccobjs
else if Filename.check_suffix name ".c" then begin
Optcompile.c_file name;
ccobjs := (Filename.chop_suffix (Filename.basename name) ".c" ^ ext_obj)
:: !ccobjs
end
else
raise(Arg.Bad("don't know what to do with " ^ name))
let usage = "Usage: jocamlopt <options> <files>\nOptions are:"
let ppf = Format.err_formatter
(* Error messages to standard error formatter *)
let anonymous filename =
readenv ppf Before_compile; process_file ppf filename;;
let impl filename =
readenv ppf Before_compile; process_implementation_file ppf filename;;
let intf filename =
readenv ppf Before_compile; process_interface_file ppf filename;;
let show_config () =
Config.print_config stdout;
exit 0;
;;
module Options = Main_args.Make_optcomp_options (struct
let set r () = r := true
let clear r () = r := false
let _a = set make_archive
let _absname = set Location.absname
let _annot = set annotations
let _binannot = set binary_annotations
let _c = set compile_only
let _cc s = c_compiler := Some s
let _cclib s = ccobjs := Misc.rev_split_words s @ !ccobjs
let _ccopt s = first_ccopts := s :: !first_ccopts
let _compact = clear optimize_for_speed
let _config () = show_config ()
let _for_pack s = for_package := Some s
let _g = set debug
let _i () = print_types := true; compile_only := true
let _I dir = include_dirs := dir :: !include_dirs
let _impl = impl
let _inline n = inline_threshold := n * 8
let _intf = intf
let _intf_suffix s = Config.interface_suffix := s
let _labels = clear classic
let _linkall = set link_everything
let _no_app_funct = clear applicative_functors
let _noassert = set noassert
let _noautolink = set no_auto_link
let _nodynlink = clear dlcode
let _nojoin = set nojoin
let _nolabels = set classic
let _nostdlib = set no_std_include
let _o s = output_name := Some s
let _output_obj = set output_c_object
let _p = set gprofile
let _pack = set make_package
let _pp s = preprocessor := Some s
let _ppx s = first_ppx := s :: !first_ppx
let _principal = set principal
let _rectypes = set recursive_types
let _runtime_variant s = runtime_variant := s
let _short_paths = clear real_paths
let _strict_sequence = set strict_sequence
let _shared () = shared := true; dlcode := true
let _S = set keep_asm_file
let _thread = set use_threads
let _unsafe = set fast
let _v () = print_version_and_library "native-code compiler"
let _version () = print_version_string ()
let _vnum () = print_version_string ()
let _verbose = set verbose
let _w s = Warnings.parse_options false s
let _warn_error s = Warnings.parse_options true s
let _warn_help = Warnings.help_warnings
let _where () = print_standard_library ()
let _nopervasives = set nopervasives
let _dsource = set dump_source
let _dparsetree = set dump_parsetree
let _dtypedtree = set dump_typedtree
let _drawlambda = set dump_rawlambda
let _dlambda = set dump_lambda
let _dclambda = set dump_clambda
let _dcmm = set dump_cmm
let _dsel = set dump_selection
let _dcombine = set dump_combine
let _dlive () = dump_live := true; Printmach.print_live := true
let _dspill = set dump_spill
let _dsplit = set dump_split
let _dinterf = set dump_interf
let _dprefer = set dump_prefer
let _dalloc = set dump_regalloc
let _dreload = set dump_reload
let _dscheduling = set dump_scheduling
let _dlinear = set dump_linear
let _dstartup = set keep_startup_file
let anonymous = anonymous
end);;
let main () =
native_code := true;
let ppf = Format.err_formatter in
try
readenv ppf Before_args;
Arg.parse (Arch.command_line_options @ Options.list) anonymous usage;
readenv ppf Before_link;
if
List.length (List.filter (fun x -> !x)
[make_package; make_archive; shared;
compile_only; output_c_object]) > 1
then
fatal "Please specify at most one of -pack, -a, -shared, -c, -output-obj";
if !make_archive then begin
if !cmxa_present then
fatal "Option -a cannot be used with .cmxa input files.";
Compmisc.init_path true;
let target = extract_output !output_name in
Asmlibrarian.create_archive (get_objfiles ()) target;
Warnings.check_fatal ();
end
else if !make_package then begin
Compmisc.init_path true;
let target = extract_output !output_name in
Asmpackager.package_files ppf (get_objfiles ()) target;
Warnings.check_fatal ();
end
else if !shared then begin
Compmisc.init_path true;
let target = extract_output !output_name in
Asmlink.link_shared ppf (get_objfiles ()) target;
Warnings.check_fatal ();
end
else if not !compile_only && !objfiles <> [] then begin
let target =
if !output_c_object then
let s = extract_output !output_name in
if (Filename.check_suffix s Config.ext_obj
|| Filename.check_suffix s Config.ext_dll)
then s
else
fatal
(Printf.sprintf
"The extension of the output file must be %s or %s"
Config.ext_obj Config.ext_dll
)
else
default_output !output_name
in
Compmisc.init_path true;
Asmlink.link ppf (get_objfiles ()) target;
Warnings.check_fatal ();
end;
exit 0
with x ->
Opterrors.report_error ppf x;
exit 2
let _ = main ()
|
