~ubuntu-branches/ubuntu/trusty/erlang/trusty

« back to all changes in this revision

Viewing changes to lib/dialyzer/test/options1_tests_SUITE_data/src/compiler/compile.erl

  • Committer: Bazaar Package Importer
  • Author(s): Clint Byrum
  • Date: 2011-05-05 15:48:43 UTC
  • mfrom: (3.5.13 sid)
  • Revision ID: james.westby@ubuntu.com-20110505154843-0om6ekzg6m7ugj27
Tags: 1:14.b.2-dfsg-3ubuntu1
* Merge from debian unstable.  Remaining changes:
  - Drop libwxgtk2.8-dev build dependency. Wx isn't in main, and not
    supposed to.
  - Drop erlang-wx binary.
  - Drop erlang-wx dependency from -megaco, -common-test, and -reltool, they
    do not really need wx. Also drop it from -debugger; the GUI needs wx,
    but it apparently has CLI bits as well, and is also needed by -megaco,
    so let's keep the package for now.
  - debian/patches/series: Do what I meant, and enable build-options.patch
    instead.
* Additional changes:
  - Drop erlang-wx from -et
* Dropped Changes:
  - patches/pcre-crash.patch: CVE-2008-2371: outer level option with
    alternatives caused crash. (Applied Upstream)
  - fix for ssl certificate verification in newSSL: 
    ssl_cacertfile_fix.patch (Applied Upstream)
  - debian/patches/series: Enable native.patch again, to get stripped beam
    files and reduce the package size again. (build-options is what
    actually accomplished this)
  - Remove build-options.patch on advice from upstream and because it caused
    odd build failures.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
%% ``The contents of this file are subject to the Erlang Public License,
 
2
%% Version 1.1, (the "License"); you may not use this file except in
 
3
%% compliance with the License. You should have received a copy of the
 
4
%% Erlang Public License along with this software. If not, it can be
 
5
%% retrieved via the world wide web at http://www.erlang.org/.
 
6
%% 
 
7
%% Software distributed under the License is distributed on an "AS IS"
 
8
%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
 
9
%% the License for the specific language governing rights and limitations
 
10
%% under the License.
 
11
%% 
 
12
%% The Initial Developer of the Original Code is Ericsson Utvecklings AB.
 
13
%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings
 
14
%% AB. All Rights Reserved.''
 
15
%% 
 
16
%%     $Id: compile.erl,v 1.1 2008/12/17 09:53:42 mikpe Exp $
 
17
%%
 
18
%% Purpose: Run the Erlang compiler.
 
19
 
 
20
-module(compile).
 
21
-include("erl_compile.hrl").
 
22
-include("core_parse.hrl").
 
23
 
 
24
%% High-level interface.
 
25
-export([file/1,file/2,format_error/1,iofile/1]).
 
26
-export([forms/1,forms/2]).
 
27
-export([output_generated/1]).
 
28
-export([options/0]).
 
29
 
 
30
%% Erlc interface.
 
31
-export([compile/3,compile_beam/3,compile_asm/3,compile_core/3]).
 
32
 
 
33
 
 
34
-import(lists, [member/2,reverse/1,keysearch/3,last/1,
 
35
                map/2,flatmap/2,foreach/2,foldr/3,any/2,filter/2]).
 
36
 
 
37
%% file(FileName)
 
38
%% file(FileName, Options)
 
39
%%  Compile the module in file FileName.
 
40
 
 
41
-define(DEFAULT_OPTIONS, [verbose,report_errors,report_warnings]).
 
42
 
 
43
-define(pass(P), {P,fun P/1}).
 
44
 
 
45
file(File) -> file(File, ?DEFAULT_OPTIONS).
 
46
 
 
47
file(File, Opts) when list(Opts) ->
 
48
    do_compile({file,File}, Opts++env_default_opts());
 
49
file(File, Opt) ->
 
50
    file(File, [Opt|?DEFAULT_OPTIONS]).
 
51
 
 
52
forms(File) -> forms(File, ?DEFAULT_OPTIONS).
 
53
 
 
54
forms(Forms, Opts) when list(Opts) ->
 
55
    do_compile({forms,Forms}, [binary|Opts++env_default_opts()]);
 
56
forms(Forms, Opts) when atom(Opts) ->
 
57
    forms(Forms, [Opts|?DEFAULT_OPTIONS]).
 
58
 
 
59
env_default_opts() ->
 
60
    Key = "ERL_COMPILER_OPTIONS",
 
61
    case os:getenv(Key) of
 
62
        false -> [];
 
63
        Str when list(Str) ->
 
64
            case erl_scan:string(Str) of
 
65
                {ok,Tokens,_} ->
 
66
                    case erl_parse:parse_term(Tokens ++ [{dot, 1}]) of
 
67
                        {ok,List} when list(List) -> List;
 
68
                        {ok,Term} -> [Term];
 
69
                        {error,_Reason} ->
 
70
                            io:format("Ignoring bad term in ~s\n", [Key]),
 
71
                            []
 
72
                    end;
 
73
                {error, {_,_,_Reason}, _} ->
 
74
                    io:format("Ignoring bad term in ~s\n", [Key]),
 
75
                    []
 
76
            end
 
77
    end.
 
78
            
 
79
do_compile(Input, Opts0) ->
 
80
    Opts = expand_opts(Opts0),
 
81
    Self = self(),
 
82
    Serv = spawn_link(fun() -> internal(Self, Input, Opts) end),
 
83
    receive
 
84
        {Serv,Rep} -> Rep
 
85
    end.
 
86
 
 
87
%% Given a list of compilation options, returns true if compile:file/2
 
88
%% would have generated a Beam file, false otherwise (if only a binary or a
 
89
%% listing file would have been generated).
 
90
 
 
91
output_generated(Opts) ->
 
92
    any(fun ({save_binary,_F}) -> true;
 
93
            (_Other) -> false
 
94
        end, passes(file, expand_opts(Opts))).
 
95
 
 
96
expand_opts(Opts) ->
 
97
    foldr(fun expand_opt/2, [], Opts).
 
98
 
 
99
expand_opt(basic_validation, Os) ->
 
100
    [no_code_generation,to_pp,binary|Os];
 
101
expand_opt(strong_validation, Os) ->
 
102
    [no_code_generation,to_kernel,binary|Os];
 
103
expand_opt(report, Os) ->
 
104
    [report_errors,report_warnings|Os];
 
105
expand_opt(return, Os) ->
 
106
    [return_errors,return_warnings|Os];
 
107
expand_opt(r7, Os) ->
 
108
    [no_float_opt,no_new_funs,no_new_binaries,no_new_apply|Os];
 
109
expand_opt(O, Os) -> [O|Os].
 
110
 
 
111
filter_opts(Opts0) ->
 
112
    %% Native code generation is not supported if no_new_funs is given.
 
113
    case member(no_new_funs, Opts0) of
 
114
        false -> Opts0;
 
115
        true -> Opts0 -- [native]
 
116
    end.
 
117
 
 
118
%% format_error(ErrorDescriptor) -> string()
 
119
 
 
120
format_error(no_native_support) ->
 
121
    "this system is not configured for native-code compilation.";
 
122
format_error({native, E}) ->
 
123
    io_lib:fwrite("native-code compilation failed with reason: ~P.",
 
124
                  [E, 25]);
 
125
format_error({native_crash, E}) ->
 
126
    io_lib:fwrite("native-code compilation crashed with reason: ~P.",
 
127
                  [E, 25]);
 
128
format_error({open,E}) ->
 
129
    io_lib:format("open error '~s'", [file:format_error(E)]);
 
130
format_error({epp,E}) ->
 
131
    epp:format_error(E);
 
132
format_error(write_error) ->
 
133
    "error writing file";
 
134
format_error({rename,S}) ->
 
135
    io_lib:format("error renaming ~s", [S]);
 
136
format_error({parse_transform,M,R}) ->
 
137
    io_lib:format("error in parse transform '~s': ~p", [M, R]);
 
138
format_error({core_transform,M,R}) ->
 
139
    io_lib:format("error in core transform '~s': ~p", [M, R]);
 
140
format_error({crash,Pass,Reason}) ->
 
141
    io_lib:format("internal error in ~p;\ncrash reason: ~p", [Pass,Reason]);
 
142
format_error({bad_return,Pass,Reason}) ->
 
143
    io_lib:format("internal error in ~p;\nbad return value: ~p", [Pass,Reason]).
 
144
 
 
145
%% The compile state record.
 
146
-record(compile, {filename="",
 
147
                  dir="",
 
148
                  base="",
 
149
                  ifile="",
 
150
                  ofile="",
 
151
                  module=[],
 
152
                  code=[],
 
153
                  core_code=[],
 
154
                  abstract_code=[],             %Abstract code for debugger.
 
155
                  options=[],
 
156
                  errors=[],
 
157
                  warnings=[]}).
 
158
 
 
159
internal(Master, Input, Opts) ->
 
160
    Master ! {self(),
 
161
              case catch internal(Input, Opts) of
 
162
                  {'EXIT', Reason} ->
 
163
                      {error, Reason};
 
164
                  Other ->
 
165
                      Other
 
166
              end}.
 
167
 
 
168
internal({forms,Forms}, Opts) ->
 
169
    Ps = passes(forms, Opts),
 
170
    internal_comp(Ps, "", "", #compile{code=Forms,options=Opts});
 
171
internal({file,File}, Opts) ->
 
172
    Ps = passes(file, Opts),
 
173
    Compile = #compile{options=Opts},
 
174
    case member(from_core, Opts) of
 
175
        true -> internal_comp(Ps, File, ".core", Compile);
 
176
        false ->
 
177
            case member(from_beam, Opts) of
 
178
                true ->
 
179
                    internal_comp(Ps, File, ".beam", Compile);
 
180
                false ->
 
181
                    case member(from_asm, Opts) orelse member(asm, Opts) of
 
182
                        true ->
 
183
                            internal_comp(Ps, File, ".S", Compile);
 
184
                        false ->
 
185
                            internal_comp(Ps, File, ".erl", Compile)
 
186
                    end
 
187
            end
 
188
    end.
 
189
 
 
190
internal_comp(Passes, File, Suffix, St0) ->
 
191
    Dir = filename:dirname(File),
 
192
    Base = filename:basename(File, Suffix),
 
193
    St1 = St0#compile{filename=File, dir=Dir, base=Base,
 
194
                      ifile=erlfile(Dir, Base, Suffix),
 
195
                      ofile=objfile(Base, St0)},
 
196
    Run = case member(time, St1#compile.options) of
 
197
              true  ->
 
198
                  io:format("Compiling ~p\n", [File]),
 
199
                  fun run_tc/2;
 
200
              false -> fun({_Name,Fun}, St) -> catch Fun(St) end
 
201
          end,
 
202
    case fold_comp(Passes, Run, St1) of
 
203
        {ok,St2} -> comp_ret_ok(St2);
 
204
        {error,St2} -> comp_ret_err(St2)
 
205
    end.
 
206
 
 
207
fold_comp([{Name,Test,Pass}|Ps], Run, St) ->
 
208
    case Test(St) of
 
209
        false ->                                %Pass is not needed.
 
210
            fold_comp(Ps, Run, St);
 
211
        true ->                                 %Run pass in the usual way.
 
212
            fold_comp([{Name,Pass}|Ps], Run, St)
 
213
    end;
 
214
fold_comp([{Name,Pass}|Ps], Run, St0) ->
 
215
    case Run({Name,Pass}, St0) of
 
216
        {ok,St1} -> fold_comp(Ps, Run, St1);
 
217
        {error,St1} -> {error,St1};
 
218
        {'EXIT',Reason} ->
 
219
            Es = [{St0#compile.ifile,[{none,?MODULE,{crash,Name,Reason}}]}],
 
220
            {error,St0#compile{errors=St0#compile.errors ++ Es}};
 
221
        Other ->
 
222
            Es = [{St0#compile.ifile,[{none,?MODULE,{bad_return,Name,Other}}]}],
 
223
            {error,St0#compile{errors=St0#compile.errors ++ Es}}
 
224
    end;
 
225
fold_comp([], _Run, St) -> {ok,St}.
 
226
 
 
227
os_process_size() ->
 
228
    case os:type() of
 
229
        {unix, sunos} ->
 
230
            Size = os:cmd("ps -o vsz -p " ++ os:getpid() ++ " | tail -1"),
 
231
            list_to_integer(lib:nonl(Size));
 
232
        _ ->
 
233
            0
 
234
    end.            
 
235
 
 
236
run_tc({Name,Fun}, St) ->
 
237
    Before0 = statistics(runtime),
 
238
    Val = (catch Fun(St)),
 
239
    After0 = statistics(runtime),
 
240
    {Before_c, _} = Before0,
 
241
    {After_c, _} = After0,
 
242
    io:format(" ~-30s: ~10.3f s (~w k)\n",
 
243
              [Name, (After_c-Before_c) / 1000, os_process_size()]),
 
244
    Val.
 
245
 
 
246
comp_ret_ok(#compile{code=Code,warnings=Warn,module=Mod,options=Opts}=St) ->
 
247
    report_warnings(St),
 
248
    Ret1 = case member(binary, Opts) andalso not member(no_code_generation, Opts) of
 
249
               true -> [Code];
 
250
               false -> []
 
251
           end,
 
252
    Ret2 = case member(return_warnings, Opts) of
 
253
               true -> Ret1 ++ [Warn];
 
254
               false -> Ret1
 
255
           end,
 
256
    list_to_tuple([ok,Mod|Ret2]).
 
257
 
 
258
comp_ret_err(St) ->
 
259
    report_errors(St),
 
260
    report_warnings(St),
 
261
    case member(return_errors, St#compile.options) of
 
262
        true -> {error,St#compile.errors,St#compile.warnings};
 
263
        false -> error
 
264
    end.
 
265
 
 
266
%% passes(form|file, [Option]) -> [{Name,PassFun}]
 
267
%%  Figure out which passes that need to be run.
 
268
 
 
269
passes(forms, Opts) ->
 
270
    select_passes(standard_passes(), Opts);
 
271
passes(file, Opts) ->
 
272
    case member(from_beam, Opts) of
 
273
        true ->
 
274
            Ps = [?pass(read_beam_file)|binary_passes()],
 
275
            select_passes(Ps, Opts);
 
276
        false ->
 
277
            Ps = case member(from_asm, Opts) orelse member(asm, Opts) of
 
278
                     true ->
 
279
                         [?pass(beam_consult_asm)|asm_passes()];
 
280
                     false ->
 
281
                         case member(from_core, Opts) of
 
282
                             true ->
 
283
                                 [?pass(parse_core)|core_passes()];
 
284
                             false ->
 
285
                                 [?pass(parse_module)|standard_passes()]
 
286
                         end
 
287
                 end,
 
288
            Fs = select_passes(Ps, Opts),
 
289
    
 
290
            %% If the last pass saves the resulting binary to a file,
 
291
            %% insert a first pass to remove the file.
 
292
            case last(Fs)  of
 
293
                {save_binary,_Fun} -> [?pass(remove_file)|Fs];
 
294
                _Other -> Fs
 
295
            end
 
296
    end.
 
297
 
 
298
%% select_passes([Command], Opts) ->  [{Name,Function}]
 
299
%%  Interpret the lists of commands to return a pure list of passes.
 
300
%%
 
301
%%  Command can be one of:
 
302
%%
 
303
%%    {pass,Mod}        Will be expanded to a call to the external
 
304
%%                      function Mod:module(Code, Options).  This
 
305
%%                      function must transform the code and return
 
306
%%                      {ok,NewCode} or {error,Term}.
 
307
%%                      Example: {pass,beam_codegen}
 
308
%%
 
309
%%    {Name,Fun}        Name is an atom giving the name of the pass.
 
310
%%                      Fun is an 'fun' taking one argument: a compile record.
 
311
%%                      The fun should return {ok,NewCompileRecord} or
 
312
%%                      {error,NewCompileRecord}.
 
313
%%                      Note: ?pass(Name) is equvivalent to {Name,fun Name/1}.
 
314
%%                      Example: ?pass(parse_module)
 
315
%%
 
316
%%    {Name,Test,Fun}   Like {Name,Fun} above, but the pass will be run
 
317
%%                      (and listed by the `time' option) only if Test(St)
 
318
%%                      returns true.
 
319
%%
 
320
%%    {src_listing,Ext} Produces an Erlang source listing with the
 
321
%%                      the file extension Ext.  (Ext should not contain
 
322
%%                      a period.)  No more passes will be run.
 
323
%%
 
324
%%    {listing,Ext}     Produce an listing of the terms in the internal
 
325
%%                      representation.  The extension of the listing
 
326
%%                      file will be Ext.  (Ext should not contain
 
327
%%                      a period.)   No more passes will be run.
 
328
%%
 
329
%%    {done,Ext}        End compilation at this point. Produce a listing
 
330
%%                      as with {listing,Ext}, unless 'binary' is
 
331
%%                      specified, in which case the current
 
332
%%                      representation of the code is returned without
 
333
%%                      creating an output file.
 
334
%%
 
335
%%    {iff,Flag,Cmd}    If the given Flag is given in the option list,
 
336
%%                      Cmd will be interpreted as a command.
 
337
%%                      Otherwise, Cmd will be ignored.
 
338
%%                      Example: {iff,dcg,{listing,"codegen}}
 
339
%%
 
340
%%    {unless,Flag,Cmd} If the given Flag is NOT given in the option list,
 
341
%%                      Cmd will be interpreted as a command.
 
342
%%                      Otherwise, Cmd will be ignored.
 
343
%%                      Example: {unless,no_kernopt,{pass,sys_kernopt}}
 
344
%%
 
345
 
 
346
select_passes([{pass,Mod}|Ps], Opts) ->
 
347
    F = fun(St) ->
 
348
                case catch Mod:module(St#compile.code, St#compile.options) of
 
349
                    {ok,Code} ->
 
350
                        {ok,St#compile{code=Code}};
 
351
                    {error,Es} ->
 
352
                        {error,St#compile{errors=St#compile.errors ++ Es}}
 
353
                end
 
354
        end,
 
355
    [{Mod,F}|select_passes(Ps, Opts)];
 
356
select_passes([{src_listing,Ext}|_], _Opts) ->
 
357
    [{listing,fun (St) -> src_listing(Ext, St) end}];
 
358
select_passes([{listing,Ext}|_], _Opts) ->
 
359
    [{listing,fun (St) -> listing(Ext, St) end}];
 
360
select_passes([{done,Ext}|_], Opts) ->
 
361
    select_passes([{unless,binary,{listing,Ext}}], Opts);
 
362
select_passes([{iff,Flag,Pass}|Ps], Opts) ->
 
363
    select_cond(Flag, true, Pass, Ps, Opts);
 
364
select_passes([{unless,Flag,Pass}|Ps], Opts) ->
 
365
    select_cond(Flag, false, Pass, Ps, Opts);
 
366
select_passes([{_,Fun}=P|Ps], Opts) when is_function(Fun) ->
 
367
    [P|select_passes(Ps, Opts)];
 
368
select_passes([{_,Test,Fun}=P|Ps], Opts) when is_function(Test),
 
369
                                              is_function(Fun) ->
 
370
    [P|select_passes(Ps, Opts)];
 
371
select_passes([], _Opts) ->
 
372
    [];
 
373
select_passes([List|Ps], Opts) when is_list(List) ->
 
374
    case select_passes(List, Opts) of
 
375
        [] -> select_passes(Ps, Opts);
 
376
        Nested ->
 
377
            case last(Nested) of
 
378
                {listing,_Fun} -> Nested;
 
379
                _Other         -> Nested ++ select_passes(Ps, Opts)
 
380
            end
 
381
    end.
 
382
 
 
383
select_cond(Flag, ShouldBe, Pass, Ps, Opts) ->
 
384
    ShouldNotBe = not ShouldBe,
 
385
    case member(Flag, Opts) of 
 
386
        ShouldBe    -> select_passes([Pass|Ps], Opts);
 
387
        ShouldNotBe -> select_passes(Ps, Opts)
 
388
    end.
 
389
 
 
390
%% The standard passes (almost) always run.
 
391
 
 
392
standard_passes() ->
 
393
    [?pass(transform_module),
 
394
     {iff,'dpp',{listing,"pp"}},
 
395
     ?pass(lint_module),
 
396
     {iff,'P',{src_listing,"P"}},
 
397
     {iff,'to_pp',{done,"P"}},
 
398
 
 
399
     {iff,'dabstr',{listing,"abstr"}},
 
400
     {iff,debug_info,?pass(save_abstract_code)},
 
401
 
 
402
     ?pass(expand_module),
 
403
     {iff,'dexp',{listing,"expand"}},
 
404
     {iff,'E',{src_listing,"E"}},
 
405
     {iff,'to_exp',{done,"E"}},
 
406
 
 
407
     %% Conversion to Core Erlang.
 
408
     ?pass(core_module),
 
409
     {iff,'dcore',{listing,"core"}},
 
410
     {iff,'to_core0',{done,"core"}}
 
411
     | core_passes()].
 
412
 
 
413
core_passes() ->
 
414
    %% Optimization and transforms of Core Erlang code.
 
415
    [{unless,no_copt,
 
416
      [{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/1},
 
417
       ?pass(core_fold_module),
 
418
       {core_inline_module,fun test_core_inliner/1,fun core_inline_module/1},
 
419
       {core_fold_after_inline,fun test_core_inliner/1,fun core_fold_module/1},
 
420
       ?pass(core_transforms)]},
 
421
     {iff,dcopt,{listing,"copt"}},
 
422
     {iff,'to_core',{done,"core"}}
 
423
     | kernel_passes()].
 
424
 
 
425
kernel_passes() ->
 
426
    %% Destructive setelement/3 optimization and core lint.
 
427
    [?pass(core_dsetel_module),
 
428
     {iff,clint,?pass(core_lint_module)},
 
429
     {iff,core,?pass(save_core_code)},
 
430
     
 
431
     %% Kernel Erlang and code generation.
 
432
     ?pass(kernel_module),
 
433
     {iff,dkern,{listing,"kernel"}},
 
434
     {iff,'to_kernel',{done,"kernel"}},
 
435
     {pass,v3_life},
 
436
     {iff,dlife,{listing,"life"}},
 
437
     {pass,v3_codegen},
 
438
     {iff,dcg,{listing,"codegen"}}
 
439
     | asm_passes()].
 
440
 
 
441
asm_passes() ->
 
442
    %% Assembly level optimisations.
 
443
    [{unless,no_postopt,
 
444
      [{pass,beam_block},
 
445
       {iff,dblk,{listing,"block"}},
 
446
       {unless,no_bopt,{pass,beam_bool}},
 
447
       {iff,dbool,{listing,"bool"}},
 
448
       {unless,no_topt,{pass,beam_type}},
 
449
       {iff,dtype,{listing,"type"}},
 
450
       {pass,beam_dead},              %Must always run since it splits blocks.
 
451
       {iff,ddead,{listing,"dead"}},
 
452
       {unless,no_jopt,{pass,beam_jump}},
 
453
       {iff,djmp,{listing,"jump"}},
 
454
       {pass,beam_clean},
 
455
       {iff,dclean,{listing,"clean"}},
 
456
       {pass,beam_flatten}]},
 
457
 
 
458
     %% If post optimizations are turned off, we still coalesce
 
459
     %% adjacent labels and remove unused labels to keep the
 
460
     %% HiPE compiler happy.
 
461
     {iff,no_postopt,
 
462
      [?pass(beam_unused_labels),
 
463
       {pass,beam_clean}]},
 
464
 
 
465
     {iff,dopt,{listing,"optimize"}},
 
466
     {iff,'S',{listing,"S"}},
 
467
     {iff,'to_asm',{done,"S"}},
 
468
 
 
469
     {pass,beam_validator},
 
470
     ?pass(beam_asm)
 
471
     | binary_passes()].
 
472
 
 
473
binary_passes() ->
 
474
    [{native_compile,fun test_native/1,fun native_compile/1},
 
475
     {unless,binary,?pass(save_binary)}].
 
476
 
 
477
%%%
 
478
%%% Compiler passes.
 
479
%%%
 
480
 
 
481
%% Remove the target file so we don't have an old one if the compilation fail.
 
482
remove_file(St) ->
 
483
    file:delete(St#compile.ofile),
 
484
    {ok,St}.
 
485
 
 
486
-record(asm_module, {module,
 
487
                     exports,
 
488
                     labels,
 
489
                     functions=[],
 
490
                     cfun,
 
491
                     code,
 
492
                     attributes=[]}).
 
493
 
 
494
preprocess_asm_forms(Forms) ->
 
495
    R = #asm_module{},
 
496
    R1 = collect_asm(Forms, R),
 
497
    {R1#asm_module.module,
 
498
     {R1#asm_module.module,
 
499
      R1#asm_module.exports,
 
500
      R1#asm_module.attributes,
 
501
      R1#asm_module.functions,
 
502
      R1#asm_module.labels}}.
 
503
 
 
504
collect_asm([], R) ->
 
505
    case R#asm_module.cfun of
 
506
        undefined ->
 
507
            R;
 
508
        {A,B,C} ->
 
509
            R#asm_module{functions=R#asm_module.functions++
 
510
                         [{function,A,B,C,R#asm_module.code}]}
 
511
    end;
 
512
collect_asm([{module,M} | Rest], R) ->
 
513
    collect_asm(Rest, R#asm_module{module=M});
 
514
collect_asm([{exports,M} | Rest], R) ->
 
515
    collect_asm(Rest, R#asm_module{exports=M});
 
516
collect_asm([{labels,M} | Rest], R) ->
 
517
    collect_asm(Rest, R#asm_module{labels=M});
 
518
collect_asm([{function,A,B,C} | Rest], R) ->
 
519
    R1 = case R#asm_module.cfun of
 
520
             undefined ->
 
521
                 R;
 
522
             {A0,B0,C0} ->
 
523
                 R#asm_module{functions=R#asm_module.functions++
 
524
                              [{function,A0,B0,C0,R#asm_module.code}]}
 
525
         end,
 
526
    collect_asm(Rest, R1#asm_module{cfun={A,B,C}, code=[]});
 
527
collect_asm([{attributes, Attr} | Rest], R) ->
 
528
    collect_asm(Rest, R#asm_module{attributes=Attr});
 
529
collect_asm([X | Rest], R) ->
 
530
    collect_asm(Rest, R#asm_module{code=R#asm_module.code++[X]}).
 
531
 
 
532
beam_consult_asm(St) ->
 
533
    case file:consult(St#compile.ifile) of
 
534
        {ok, Forms0} ->
 
535
            {Module, Forms} = preprocess_asm_forms(Forms0),
 
536
            {ok,St#compile{module=Module, code=Forms}};
 
537
        {error,E} ->
 
538
            Es = [{St#compile.ifile,[{none,?MODULE,{open,E}}]}],
 
539
            {error,St#compile{errors=St#compile.errors ++ Es}}
 
540
    end.
 
541
 
 
542
read_beam_file(St) ->
 
543
    case file:read_file(St#compile.ifile) of
 
544
        {ok,Beam} ->
 
545
            Infile = St#compile.ifile,
 
546
            case is_too_old(Infile) of
 
547
                true ->
 
548
                    {ok,St#compile{module=none,code=none}};
 
549
                false ->
 
550
                    Mod0 = filename:rootname(filename:basename(Infile)),
 
551
                    Mod = list_to_atom(Mod0),
 
552
                    {ok,St#compile{module=Mod,code=Beam,ofile=Infile}}
 
553
            end;
 
554
        {error,E} ->
 
555
            Es = [{St#compile.ifile,[{none,?MODULE,{open,E}}]}],
 
556
            {error,St#compile{errors=St#compile.errors ++ Es}}
 
557
    end.
 
558
 
 
559
is_too_old(BeamFile) ->
 
560
    case beam_lib:chunks(BeamFile, ["CInf"]) of
 
561
        {ok,{_,[{"CInf",Term0}]}} ->
 
562
            Term = binary_to_term(Term0),
 
563
            Opts = proplists:get_value(options, Term, []),
 
564
            lists:member(no_new_funs, Opts);
 
565
        _ -> false
 
566
    end.
 
567
 
 
568
parse_module(St) ->
 
569
    Opts = St#compile.options,
 
570
    Cwd = ".",
 
571
    IncludePath = [Cwd, St#compile.dir|inc_paths(Opts)],
 
572
    Tab = ets:new(compiler__tab, [protected,named_table]),
 
573
    ets:insert(Tab, {compiler_options,Opts}),
 
574
    R =  epp:parse_file(St#compile.ifile, IncludePath, pre_defs(Opts)),
 
575
    ets:delete(Tab),
 
576
    case R of
 
577
        {ok,Forms} ->
 
578
            {ok,St#compile{code=Forms}};
 
579
        {error,E} ->
 
580
            Es = [{St#compile.ifile,[{none,?MODULE,{epp,E}}]}],
 
581
            {error,St#compile{errors=St#compile.errors ++ Es}}
 
582
    end.
 
583
 
 
584
parse_core(St) ->
 
585
    case file:read_file(St#compile.ifile) of
 
586
        {ok,Bin} ->
 
587
            case core_scan:string(binary_to_list(Bin)) of
 
588
                {ok,Toks,_} ->
 
589
                    case core_parse:parse(Toks) of
 
590
                        {ok,Mod} ->
 
591
                            Name = (Mod#c_module.name)#c_atom.val,
 
592
                            {ok,St#compile{module=Name,code=Mod}};
 
593
                        {error,E} ->
 
594
                            Es = [{St#compile.ifile,[E]}],
 
595
                            {error,St#compile{errors=St#compile.errors ++ Es}}
 
596
                    end;
 
597
                {error,E,_} ->
 
598
                    Es = [{St#compile.ifile,[E]}],
 
599
                    {error,St#compile{errors=St#compile.errors ++ Es}}
 
600
            end;
 
601
        {error,E} ->
 
602
            Es = [{St#compile.ifile,[{none,compile,{open,E}}]}],
 
603
            {error,St#compile{errors=St#compile.errors ++ Es}}
 
604
    end.
 
605
 
 
606
compile_options([{attribute,_L,compile,C}|Fs]) when is_list(C) ->
 
607
    C ++ compile_options(Fs);
 
608
compile_options([{attribute,_L,compile,C}|Fs]) ->
 
609
    [C|compile_options(Fs)];
 
610
compile_options([_F|Fs]) -> compile_options(Fs);
 
611
compile_options([]) -> [].
 
612
 
 
613
transforms(Os) -> [ M || {parse_transform,M} <- Os ]. 
 
614
 
 
615
transform_module(St) ->
 
616
    %% Extract compile options from code into options field.
 
617
    Ts = transforms(St#compile.options ++ compile_options(St#compile.code)),
 
618
    foldl_transform(St, Ts).
 
619
 
 
620
foldl_transform(St, [T|Ts]) ->
 
621
    Name = "transform " ++ atom_to_list(T),
 
622
    Fun = fun(S) -> T:parse_transform(S#compile.code, S#compile.options) end,
 
623
    Run = case member(time, St#compile.options) of
 
624
              true  -> fun run_tc/2;
 
625
              false -> fun({_Name,F}, S) -> catch F(S) end
 
626
          end,
 
627
    case Run({Name, Fun}, St) of
 
628
        {error,Es,Ws} ->
 
629
            {error,St#compile{warnings=St#compile.warnings ++ Ws,
 
630
                              errors=St#compile.errors ++ Es}};
 
631
        {'EXIT',R} ->
 
632
            Es = [{St#compile.ifile,[{none,compile,{parse_transform,T,R}}]}],
 
633
            {error,St#compile{errors=St#compile.errors ++ Es}};
 
634
        Forms ->
 
635
            foldl_transform(St#compile{code=Forms}, Ts)
 
636
    end;
 
637
foldl_transform(St, []) -> {ok,St}.
 
638
 
 
639
get_core_transforms(Opts) -> [M || {core_transform,M} <- Opts]. 
 
640
 
 
641
core_transforms(St) ->
 
642
    %% The options field holds the complete list of options at this
 
643
 
 
644
    Ts = get_core_transforms(St#compile.options),
 
645
    foldl_core_transforms(St, Ts).
 
646
 
 
647
foldl_core_transforms(St, [T|Ts]) ->
 
648
    Name = "core transform " ++ atom_to_list(T),
 
649
    Fun = fun(S) -> T:core_transform(S#compile.code, S#compile.options) end,
 
650
    Run = case member(time, St#compile.options) of
 
651
              true  -> fun run_tc/2;
 
652
              false -> fun({_Name,F}, S) -> catch F(S) end
 
653
          end,
 
654
    case Run({Name, Fun}, St) of
 
655
        {'EXIT',R} ->
 
656
            Es = [{St#compile.ifile,[{none,compile,{core_transform,T,R}}]}],
 
657
            {error,St#compile{errors=St#compile.errors ++ Es}};
 
658
        Forms ->
 
659
            foldl_core_transforms(St#compile{code=Forms}, Ts)
 
660
    end;
 
661
foldl_core_transforms(St, []) -> {ok,St}.
 
662
 
 
663
%%% Fetches the module name from a list of forms. The module attribute must
 
664
%%% be present.
 
665
get_module([{attribute,_,module,{M,_As}} | _]) -> M;
 
666
get_module([{attribute,_,module,M} | _]) -> M;
 
667
get_module([_ | Rest]) ->
 
668
    get_module(Rest).
 
669
 
 
670
%%% A #compile state is returned, where St.base has been filled in
 
671
%%% with the module name from Forms, as a string, in case it wasn't
 
672
%%% set in St (i.e., it was "").
 
673
add_default_base(St, Forms) ->
 
674
    F = St#compile.filename,
 
675
    case F of
 
676
        "" ->
 
677
            M = get_module(Forms),
 
678
            St#compile{base = atom_to_list(M)};
 
679
        _ ->
 
680
            St
 
681
    end.
 
682
 
 
683
lint_module(St) ->
 
684
    case erl_lint:module(St#compile.code,
 
685
                         St#compile.ifile, St#compile.options) of
 
686
        {ok,Ws} ->
 
687
            %% Insert name of module as base name, if needed. This is
 
688
            %% for compile:forms to work with listing files.
 
689
            St1 = add_default_base(St, St#compile.code),
 
690
            {ok,St1#compile{warnings=St1#compile.warnings ++ Ws}};
 
691
        {error,Es,Ws} ->
 
692
            {error,St#compile{warnings=St#compile.warnings ++ Ws,
 
693
                              errors=St#compile.errors ++ Es}}
 
694
    end.
 
695
 
 
696
core_lint_module(St) ->
 
697
    case core_lint:module(St#compile.code, St#compile.options) of
 
698
        {ok,Ws} ->
 
699
            {ok,St#compile{warnings=St#compile.warnings ++ Ws}};
 
700
        {error,Es,Ws} ->
 
701
            {error,St#compile{warnings=St#compile.warnings ++ Ws,
 
702
                              errors=St#compile.errors ++ Es}}
 
703
    end.
 
704
 
 
705
%% expand_module(State) -> State'
 
706
%%  Do the common preprocessing of the input forms.
 
707
 
 
708
expand_module(#compile{code=Code,options=Opts0}=St0) ->
 
709
    {Mod,Exp,Forms,Opts1} = sys_pre_expand:module(Code, Opts0),
 
710
    Opts2 = expand_opts(Opts1),
 
711
    Opts = filter_opts(Opts2),
 
712
    {ok,St0#compile{module=Mod,options=Opts,code={Mod,Exp,Forms}}}.
 
713
 
 
714
core_module(#compile{code=Code0,options=Opts,ifile=File}=St) ->
 
715
    {ok,Code,Ws} = v3_core:module(Code0, Opts),
 
716
    {ok,St#compile{code=Code,warnings=St#compile.warnings ++ [{File,Ws}]}}.
 
717
 
 
718
core_fold_module(#compile{code=Code0,options=Opts,ifile=File}=St) ->
 
719
    {ok,Code,Ws} = sys_core_fold:module(Code0, Opts),
 
720
    {ok,St#compile{code=Code,warnings=St#compile.warnings ++ [{File,Ws}]}}.
 
721
 
 
722
test_old_inliner(#compile{options=Opts}) ->
 
723
    %% The point of this test is to avoid loading the old inliner
 
724
    %% if we know that it will not be used.
 
725
    case any(fun(no_inline) -> true;
 
726
                (_) -> false
 
727
             end, Opts) of
 
728
      true -> false;
 
729
      false ->
 
730
        any(fun({inline,_}) -> true;
 
731
               (_) -> false
 
732
            end, Opts)
 
733
    end.
 
734
 
 
735
test_core_inliner(#compile{options=Opts}) ->
 
736
    case any(fun(no_inline) -> true;
 
737
                (_) -> false
 
738
             end, Opts) of
 
739
        true -> false;
 
740
        false ->
 
741
            any(fun(inline) -> true;
 
742
                   (_) -> false
 
743
                end, Opts)
 
744
    end.
 
745
 
 
746
core_old_inliner(#compile{code=Code0,options=Opts}=St) ->
 
747
    case catch sys_core_inline:module(Code0, Opts) of
 
748
        {ok,Code} ->
 
749
            {ok,St#compile{code=Code}};
 
750
        {error,Es} ->
 
751
            {error,St#compile{errors=St#compile.errors ++ Es}}
 
752
    end.
 
753
 
 
754
core_inline_module(#compile{code=Code0,options=Opts}=St) ->
 
755
    Code = cerl_inline:core_transform(Code0, Opts),
 
756
    {ok,St#compile{code=Code}}.
 
757
 
 
758
core_dsetel_module(#compile{code=Code0,options=Opts}=St) ->
 
759
    {ok,Code} = sys_core_dsetel:module(Code0, Opts),
 
760
    {ok,St#compile{code=Code}}.
 
761
 
 
762
kernel_module(#compile{code=Code0,options=Opts,ifile=File}=St) ->
 
763
    {ok,Code,Ws} = v3_kernel:module(Code0, Opts),
 
764
    {ok,St#compile{code=Code,warnings=St#compile.warnings ++ [{File,Ws}]}}.
 
765
 
 
766
save_abstract_code(St) ->
 
767
    {ok,St#compile{abstract_code=abstract_code(St)}}.
 
768
 
 
769
abstract_code(#compile{code=Code}) ->
 
770
    Abstr = {raw_abstract_v1,Code},
 
771
    case catch erlang:term_to_binary(Abstr, [compressed]) of
 
772
        {'EXIT',_} -> term_to_binary(Abstr);
 
773
        Other -> Other
 
774
    end.
 
775
 
 
776
save_core_code(St) ->
 
777
    {ok,St#compile{core_code=cerl:from_records(St#compile.code)}}.
 
778
 
 
779
beam_unused_labels(#compile{code=Code0}=St) ->
 
780
    Code = beam_jump:module_labels(Code0),
 
781
    {ok,St#compile{code=Code}}.
 
782
 
 
783
beam_asm(#compile{ifile=File,code=Code0,abstract_code=Abst,options=Opts0}=St) ->
 
784
    Source = filename:absname(File),
 
785
    Opts = filter(fun is_informative_option/1, Opts0),
 
786
    case beam_asm:module(Code0, Abst, Source, Opts) of
 
787
        {ok,Code} -> {ok,St#compile{code=Code,abstract_code=[]}};
 
788
        {error,Es} -> {error,St#compile{errors=St#compile.errors ++ Es}}
 
789
    end.
 
790
 
 
791
test_native(#compile{options=Opts}) ->
 
792
    %% This test must be made late, because the r7 or no_new_funs options
 
793
    %% will turn off the native option.
 
794
    member(native, Opts).
 
795
 
 
796
native_compile(#compile{code=none}=St) -> {ok,St};
 
797
native_compile(St) ->
 
798
    case erlang:system_info(hipe_architecture) of
 
799
        undefined ->
 
800
            Ws = [{St#compile.ifile,[{none,compile,no_native_support}]}],
 
801
            {ok,St#compile{warnings=St#compile.warnings ++ Ws}};
 
802
        _ ->
 
803
            native_compile_1(St)
 
804
    end.
 
805
 
 
806
native_compile_1(St) ->
 
807
    Opts0 = [no_new_binaries|St#compile.options],
 
808
    IgnoreErrors = member(ignore_native_errors, Opts0),
 
809
    Opts = case keysearch(hipe, 1, Opts0) of
 
810
               {value,{hipe,L}} when list(L) -> L;
 
811
               {value,{hipe,X}} -> [X];
 
812
               _ -> []
 
813
           end,
 
814
    case catch hipe:compile(St#compile.module,
 
815
                            St#compile.core_code,
 
816
                            St#compile.code,
 
817
                            Opts) of
 
818
        {ok, {Type,Bin}} when binary(Bin) ->
 
819
            {ok, embed_native_code(St, {Type,Bin})};
 
820
        {error, R} ->
 
821
            case IgnoreErrors of
 
822
                true ->
 
823
                    Ws = [{St#compile.ifile,[{none,?MODULE,{native,R}}]}],
 
824
                    {ok,St#compile{warnings=St#compile.warnings ++ Ws}};
 
825
                false ->
 
826
                    Es = [{St#compile.ifile,[{none,?MODULE,{native,R}}]}],
 
827
                    {error,St#compile{errors=St#compile.errors ++ Es}}
 
828
            end;
 
829
        {'EXIT',R} ->
 
830
            case IgnoreErrors of
 
831
                true ->
 
832
                    Ws = [{St#compile.ifile,[{none,?MODULE,{native_crash,R}}]}],
 
833
                    {ok,St#compile{warnings=St#compile.warnings ++ Ws}};
 
834
                false ->
 
835
                    exit(R)
 
836
            end
 
837
    end.
 
838
 
 
839
embed_native_code(St, {Architecture,NativeCode}) ->
 
840
    {ok, _, Chunks0} = beam_lib:all_chunks(St#compile.code),
 
841
    ChunkName = hipe_unified_loader:chunk_name(Architecture),
 
842
    Chunks1 = lists:keydelete(ChunkName, 1, Chunks0),
 
843
    Chunks = Chunks1 ++ [{ChunkName,NativeCode}],
 
844
    {ok, BeamPlusNative} = beam_lib:build_module(Chunks),
 
845
    St#compile{code=BeamPlusNative}.
 
846
 
 
847
%% Returns true if the option is informative and therefore should be included
 
848
%% in the option list of the compiled module.
 
849
 
 
850
is_informative_option(beam) -> false;
 
851
is_informative_option(report_warnings) -> false;
 
852
is_informative_option(report_errors) -> false;
 
853
is_informative_option(binary) -> false;
 
854
is_informative_option(verbose) -> false;
 
855
is_informative_option(_) -> true.
 
856
    
 
857
save_binary(#compile{code=none}=St) -> {ok,St};
 
858
save_binary(St) ->
 
859
    Tfile = tmpfile(St#compile.ofile),          %Temp working file
 
860
    case write_binary(Tfile, St#compile.code, St) of
 
861
        ok ->
 
862
            case file:rename(Tfile, St#compile.ofile) of
 
863
                ok ->
 
864
                    {ok,St};
 
865
                {error,_Error} ->
 
866
                    file:delete(Tfile),
 
867
                    Es = [{St#compile.ofile,[{none,?MODULE,{rename,Tfile}}]}],
 
868
                    {error,St#compile{errors=St#compile.errors ++ Es}}
 
869
            end;
 
870
        {error,_Error} ->
 
871
            Es = [{Tfile,[{compile,write_error}]}],
 
872
            {error,St#compile{errors=St#compile.errors ++ Es}}
 
873
    end.
 
874
 
 
875
write_binary(Name, Bin, St) ->
 
876
    Opts = case member(compressed, St#compile.options) of
 
877
               true -> [compressed];
 
878
               false -> []
 
879
           end,
 
880
    case file:write_file(Name, Bin, Opts) of
 
881
        ok -> ok;
 
882
        {error,_}=Error -> Error
 
883
    end.
 
884
 
 
885
%% report_errors(State) -> ok
 
886
%% report_warnings(State) -> ok
 
887
 
 
888
report_errors(St) ->
 
889
    case member(report_errors, St#compile.options) of
 
890
        true ->
 
891
            foreach(fun ({{F,_L},Eds}) -> list_errors(F, Eds);
 
892
                        ({F,Eds}) -> list_errors(F, Eds) end,
 
893
                    St#compile.errors);
 
894
        false -> ok
 
895
    end.
 
896
 
 
897
report_warnings(#compile{options=Opts,warnings=Ws0}) ->
 
898
    case member(report_warnings, Opts) of
 
899
        true ->
 
900
            Ws1 = flatmap(fun({{F,_L},Eds}) -> format_message(F, Eds);
 
901
                             ({F,Eds}) -> format_message(F, Eds) end,
 
902
                     Ws0),
 
903
            Ws = ordsets:from_list(Ws1),
 
904
            foreach(fun({_,Str}) -> io:put_chars(Str) end, Ws);
 
905
        false -> ok
 
906
    end.
 
907
 
 
908
format_message(F, [{Line,Mod,E}|Es]) ->
 
909
    M = {Line,io_lib:format("~s:~w: Warning: ~s\n", [F,Line,Mod:format_error(E)])},
 
910
    [M|format_message(F, Es)];
 
911
format_message(F, [{Mod,E}|Es]) ->
 
912
    M = {none,io_lib:format("~s: Warning: ~s\n", [F,Mod:format_error(E)])},
 
913
    [M|format_message(F, Es)];
 
914
format_message(_, []) -> [].
 
915
 
 
916
%% list_errors(File, ErrorDescriptors) -> ok
 
917
 
 
918
list_errors(F, [{Line,Mod,E}|Es]) ->
 
919
    io:fwrite("~s:~w: ~s\n", [F,Line,Mod:format_error(E)]),
 
920
    list_errors(F, Es);
 
921
list_errors(F, [{Mod,E}|Es]) ->
 
922
    io:fwrite("~s: ~s\n", [F,Mod:format_error(E)]),
 
923
    list_errors(F, Es);
 
924
list_errors(_F, []) -> ok.
 
925
 
 
926
%% erlfile(Dir, Base) -> ErlFile
 
927
%% outfile(Base, Extension, Options) -> OutputFile
 
928
%% objfile(Base, Target, Options) -> ObjFile
 
929
%% tmpfile(ObjFile) -> TmpFile
 
930
%%  Work out the correct input and output file names.
 
931
 
 
932
iofile(File) when atom(File) ->
 
933
    iofile(atom_to_list(File));
 
934
iofile(File) ->
 
935
    {filename:dirname(File), filename:basename(File, ".erl")}.
 
936
 
 
937
erlfile(Dir, Base, Suffix) ->
 
938
    filename:join(Dir, Base++Suffix).
 
939
 
 
940
outfile(Base, Ext, Opts) when atom(Ext) ->
 
941
    outfile(Base, atom_to_list(Ext), Opts);
 
942
outfile(Base, Ext, Opts) ->
 
943
    Obase = case keysearch(outdir, 1, Opts) of
 
944
                {value, {outdir, Odir}} -> filename:join(Odir, Base);
 
945
                _Other -> Base                  % Not found or bad format
 
946
            end,
 
947
    Obase++"."++Ext.
 
948
 
 
949
objfile(Base, St) ->
 
950
    outfile(Base, "beam", St#compile.options).
 
951
 
 
952
tmpfile(Ofile) ->
 
953
    reverse([$#|tl(reverse(Ofile))]).
 
954
 
 
955
%% pre_defs(Options)
 
956
%% inc_paths(Options)
 
957
%%  Extract the predefined macros and include paths from the option list.
 
958
 
 
959
pre_defs([{d,M,V}|Opts]) ->
 
960
    [{M,V}|pre_defs(Opts)];
 
961
pre_defs([{d,M}|Opts]) ->
 
962
    [M|pre_defs(Opts)];
 
963
pre_defs([_|Opts]) ->
 
964
    pre_defs(Opts);
 
965
pre_defs([]) -> [].
 
966
 
 
967
inc_paths(Opts) ->
 
968
    [ P || {i,P} <- Opts, list(P) ].
 
969
 
 
970
src_listing(Ext, St) ->
 
971
    listing(fun (Lf, {_Mod,_Exp,Fs}) -> do_src_listing(Lf, Fs);
 
972
                (Lf, Fs) -> do_src_listing(Lf, Fs) end,
 
973
            Ext, St).
 
974
 
 
975
do_src_listing(Lf, Fs) ->
 
976
    foreach(fun (F) -> io:put_chars(Lf, [erl_pp:form(F),"\n"]) end,
 
977
            Fs).
 
978
 
 
979
listing(Ext, St) ->
 
980
    listing(fun(Lf, Fs) -> beam_listing:module(Lf, Fs) end, Ext, St).
 
981
 
 
982
listing(LFun, Ext, St) ->
 
983
    Lfile = outfile(St#compile.base, Ext, St#compile.options),
 
984
    case file:open(Lfile, [write,delayed_write]) of
 
985
        {ok,Lf} -> 
 
986
            LFun(Lf, St#compile.code),
 
987
            ok = file:close(Lf),
 
988
            {ok,St};
 
989
        {error,_Error} ->
 
990
            Es = [{Lfile,[{none,compile,write_error}]}],
 
991
            {error,St#compile{errors=St#compile.errors ++ Es}}
 
992
    end.
 
993
 
 
994
options() ->
 
995
    help(standard_passes()).
 
996
 
 
997
help([{iff,Flag,{src_listing,Ext}}|T]) ->
 
998
    io:fwrite("~p - Generate .~s source listing file\n", [Flag,Ext]),
 
999
    help(T);
 
1000
help([{iff,Flag,{listing,Ext}}|T]) ->
 
1001
    io:fwrite("~p - Generate .~s file\n", [Flag,Ext]),
 
1002
    help(T);
 
1003
help([{iff,Flag,{Name,Fun}}|T]) when function(Fun) ->
 
1004
    io:fwrite("~p - Run ~s\n", [Flag,Name]),
 
1005
    help(T);
 
1006
help([{iff,_Flag,Action}|T]) ->
 
1007
    help(Action),
 
1008
    help(T);
 
1009
help([{unless,Flag,{pass,Pass}}|T]) ->
 
1010
    io:fwrite("~p - Skip the ~s pass\n", [Flag,Pass]),
 
1011
    help(T);
 
1012
help([{unless,no_postopt=Flag,List}|T]) when list(List) ->
 
1013
    %% Hard-coded knowledgde here.
 
1014
    io:fwrite("~p - Skip all post optimisation\n", [Flag]),
 
1015
    help(List),
 
1016
    help(T);
 
1017
help([{unless,_Flag,Action}|T]) ->
 
1018
    help(Action),
 
1019
    help(T);
 
1020
help([_|T]) ->
 
1021
    help(T);
 
1022
help(_) ->
 
1023
    ok.
 
1024
 
 
1025
 
 
1026
%% compile(AbsFileName, Outfilename, Options)
 
1027
%%   Compile entry point for erl_compile.
 
1028
 
 
1029
compile(File0, _OutFile, Options) ->
 
1030
    File = shorten_filename(File0),
 
1031
    case file(File, make_erl_options(Options)) of
 
1032
        {ok,_Mod} -> ok;
 
1033
        Other -> Other
 
1034
    end.
 
1035
 
 
1036
compile_beam(File0, _OutFile, Opts) ->
 
1037
    File = shorten_filename(File0),
 
1038
    case file(File, [from_beam|make_erl_options(Opts)]) of
 
1039
        {ok,_Mod} -> ok;
 
1040
        Other -> Other
 
1041
    end.
 
1042
 
 
1043
compile_asm(File0, _OutFile, Opts) ->
 
1044
    File = shorten_filename(File0),
 
1045
    case file(File, [asm|make_erl_options(Opts)]) of
 
1046
        {ok,_Mod} -> ok;
 
1047
        Other -> Other
 
1048
    end.
 
1049
 
 
1050
compile_core(File0, _OutFile, Opts) ->
 
1051
    File = shorten_filename(File0),
 
1052
    case file(File, [from_core|make_erl_options(Opts)]) of
 
1053
        {ok,_Mod} -> ok;
 
1054
        Other -> Other
 
1055
    end.
 
1056
 
 
1057
shorten_filename(Name0) ->
 
1058
    {ok,Cwd} = file:get_cwd(),
 
1059
    case lists:prefix(Cwd, Name0) of
 
1060
        false -> Name0;
 
1061
        true ->
 
1062
            Name = case lists:nthtail(length(Cwd), Name0) of
 
1063
                       "/"++N -> N;
 
1064
                       N -> N
 
1065
                   end,
 
1066
            Name
 
1067
    end.
 
1068
 
 
1069
%% Converts generic compiler options to specific options.
 
1070
 
 
1071
make_erl_options(Opts) ->
 
1072
 
 
1073
    %% This way of extracting will work even if the record passed
 
1074
    %% has more fields than known during compilation.
 
1075
 
 
1076
    Includes = Opts#options.includes,
 
1077
    Defines = Opts#options.defines,
 
1078
    Outdir = Opts#options.outdir,
 
1079
    Warning = Opts#options.warning,
 
1080
    Verbose = Opts#options.verbose,
 
1081
    Specific = Opts#options.specific,
 
1082
    OutputType = Opts#options.output_type,
 
1083
    Cwd = Opts#options.cwd,
 
1084
 
 
1085
    Options =
 
1086
        case Verbose of
 
1087
            true ->  [verbose];
 
1088
            false -> []
 
1089
        end ++
 
1090
        case Warning of
 
1091
            0 -> [];
 
1092
            _ -> [report_warnings]
 
1093
        end ++
 
1094
        map(
 
1095
          fun ({Name, Value}) ->
 
1096
                  {d, Name, Value};
 
1097
              (Name) ->
 
1098
                  {d, Name}
 
1099
          end,
 
1100
          Defines) ++
 
1101
        case OutputType of
 
1102
            undefined -> [];
 
1103
            jam -> [jam];
 
1104
            beam -> [beam];
 
1105
            native -> [native]
 
1106
        end,
 
1107
 
 
1108
    Options++[report_errors, {cwd, Cwd}, {outdir, Outdir}|
 
1109
              map(fun(Dir) -> {i, Dir} end, Includes)]++Specific.