20
%% @author Richard Carlsson <richardc@csd.uu.se>
21
%% @copyright 2000-2002 Richard Carlsson
22
%% @doc Translation from (HiPE-ified) Core Erlang to HiPE Icode.
20
%% @author Richard Carlsson <richardc@it.uu.se>
21
%% @copyright 2000-2006 Richard Carlsson
22
%% @doc Translation from Core Erlang to HiPE Icode.
26
%% TODO: use type information to avoid tests, remove dead code, etc.
27
%% TODO: compile case-switches over true/false using shortcut code.
28
%% TODO: handle binaries
29
%% TODO: compile tail-called letrec-defined functions as goto-loops.
30
%% TODO: remove unnecessary reduction tests
31
%% TODO: generate branch prediction info
24
%% TODO: annotate Icode leaf functions as such.
25
%% TODO: add a pass to remove unnecessary reduction tests
26
%% TODO: generate branch prediction info?
33
28
-module(cerl_to_icode).
35
-export([function/3, function/4, module/1, module/2]).
37
-import(lists, [mapfoldl/3]).
39
%% @spec module(Module::cerl()) -> [icode()]
40
%% @equiv module(T, [])
45
%% @spec module(Module::cerl(), Options::[term()]) -> [icode()]
47
%% cerl() = cerl:cerl()
48
%% icode() = hipe_icode:icode()
50
%% @doc Transforms a Core Erlang module to linear HiPE Icode. The result
51
%% is a list of Icode function definitions. Currently, no options are
54
%% <p>Note: Except for the module name, which is included in the header
55
%% of each Icode function definition, the remaining information (exports
56
%% and attributes) associated with the module definition is not included
57
%% in the resulting Icode.</p>
60
%% @see cerl_hipeify:module/1
61
%% @see cerl_lambdalift:module/1
64
%% TODO: when we handle local letrecs, change the order of these:
65
module_1(cerl_lambdalift:module(cerl_hipeify:module(T)), Options).
67
module_1(T, _Options) ->
68
M = cerl:atom_val(cerl:module_name(T)),
72
error_msg("bad module name: ~P.", [M, 5]),
76
{Icode, _} = mapfoldl(fun function_definition/2,
77
S, cerl:module_defs(T)),
80
%% For now, we simply assume that all function bodies should have degree
81
%% one (i.e., return exactly one value). We clear the code ackumulator
82
%% before we start compiling each function.
84
function_definition({V, F}, S) ->
85
N = var_name_to_fname(cerl:var_name(V)),
86
S1 = s__set_code([], S),
87
{Icode, S2} = function_1(N, F, 1, S1),
88
{{hipe_icode:icode_fun(Icode), Icode}, S2}.
90
var_name_to_fname({A, N}) when atom(A), integer(N) ->
91
A; %% The stated arity is ignored.
92
var_name_to_fname(A) when atom(A) ->
94
var_name_to_fname(N) ->
95
error_msg("bad function name: ~P.", [N, 5]),
99
reset_label_counter(),
103
%% @spec function(Module::atom(), Name::atom(), Function::cerl()) ->
105
%% @equiv function(Module, Name, Fun, 1)
107
function(Module, Name, Fun) ->
108
function(Module, Name, Fun, 1).
111
%% @spec function(Module::atom(), Name::atom(), Fun::cerl(),
112
%% Degree::integer()) -> icode()
114
%% @doc Transforms a Core Erlang function to a HiPE Icode function
115
%% definition. <code>Fun</code> must represent a fun-expression, which
116
%% may not contain free variables. <code>Module</code> and
117
%% <code>Name</code> specify the module and function name of the
118
%% resulting Icode function.
120
%% <p><code>Degree</code> specifies the number of values the function is
121
%% expected to return; this is typically 1 (one); cf.
122
%% <code>function/3</code>.</p>
126
%% <li>Last call optimization is handled, even when the tail call is
127
%% "hidden" by let-definitions.</li>
129
%% <li>It is assumed that all <code>primop</code> calls in the code
130
%% represent Icode primops or macro instructions, and that all
131
%% inter-module calls (both calls to statically named functions, and
132
%% dynamic meta-calls) represent <em>actual</em> inter-module calls -
133
%% not primitive or built-in operations.</li>
135
%% <li>The following primops (see
136
%% "<code>cerl_hipe_primops.hrl</code>") are detected by the
137
%% translation and handled specially:
139
%% <tr><td><code>exit/1</code>, <code>throw/1</code>,
140
%% <code>error/1</code></td>
141
%% <td>generate exceptions</td></tr>
142
%% <tr><td><code>not/1</code>, <code>and/2</code>,
143
%% <code>or/2</code></td>
144
%% <td>strict boolean operators</td></tr>
145
%% <tr><td><code>'=='/2</code>, <code>'/='/2</code></td>
146
%% <td>arithmetic (un)equality</td></tr>
147
%% <tr><td><code>'=:='/2</code>, <code>'=/='/2</code></td>
148
%% <td>exact (un)equality</td></tr>
149
%% <tr><td><code>'<'/2</code>, <code>'>'/2</code></td>
150
%% <td>smaller/greater than</td></tr>
151
%% <tr><td><code>'=<'/2</code></td>
152
%% <td>smaller than or equal to</td></tr>
153
%% <tr><td><code>'>='/2</code></td>
154
%% <td>greater than or equal to</td></tr>
155
%% <tr><td><code>receive_select/0</code></td>
156
%% <td>select current message</td></tr>
157
%% <tr><td><code>receive_next/0</code></td>
158
%% <td>loop to try next message</td></tr>
159
%% <tr><td><code>make_fun/6</code></td>
160
%% <td>create a functional value</td></tr>
161
%% <tr><td><code>apply_fun/2</code></td>
162
%% <td>apply a functional value</td></tr>
164
%% The boolean operators are expected to be used in guard expressions,
165
%% as well as in other expressions. See below for details on the
166
%% <code>receive_...</code> operations.</li>
168
%% <li>Compilation of clauses is simplistic. No pattern matching
169
%% compilation or similar optimizations is done. Indexing is not (yet)
170
%% done. Guards that are <code>true</code> or <code>false</code> are
171
%% recognized as trivially true/false; for all other guards, code will
172
%% be generated. Catch-all clauses (with <code>true</code> guard and
173
%% variable-only patterns) are detected, and any following clauses are
177
%% <p><b>Important</b>: This function does not handle occurrences of
178
%% fun-expressions inside the body of <code>Fun</code> itself, nor
179
%% <code>apply</code>-expressions whose operators are not locally bound
180
%% function variables. These must be transformed away before this
181
%% function is called, by use of lambda lifting and the
182
%% <code>make_fun</code> and <code>call_fun</code> primitive operations
183
%% to create and apply functional values.</p>
185
%% <p><code>receive</code>-expressions are expected to have a particular
188
%% <li>There must be exactly one clause, with the atom
189
%% <code>true</code> as guard, and only a single variable as pattern.
190
%% The variable will be bound to a message in the mailbox, and can be
191
%% referred to in the clause body.</li>
193
%% <li>In the body of that clause, all paths must execute one of the
194
%% primitive operations <code>receive_select/0</code> or
195
%% <code>receive_next/0</code> before another
196
%% <code>receive</code>-statement might be executed.
197
%% <code>receive_select/0</code> always returns, but without a value,
198
%% while <code>receive_next/0</code> never returns, either causing
199
%% the nearest surrounding receive-expression to be re-tried with the
200
%% next message in the input queue, or timing out.</li>
205
-include("cerl_hipe_primops.hrl").
30
-define(NO_UNUSED, true).
34
-export([function/3, function/4, module/1]).
37
%% Added in an attempt to suppress message by Dialyzer, but I run into
38
%% an internal compiler error in the old inliner and commented it out.
39
%% The inlining is performed manually instead :-( - Kostis
40
%% -compile({inline, [{error_fun_value,1}]}).
42
%% ---------------------------------------------------------------------
207
45
%% Icode primitive operation names
209
47
-define(OP_REDTEST, redtest).
210
48
-define(OP_CONS, cons).
211
49
-define(OP_TUPLE, mktuple).
50
-define(OP_ELEMENT, {erlang,element,2}). %% This has an MFA name
212
51
-define(OP_UNSAFE_HD, unsafe_hd).
213
52
-define(OP_UNSAFE_TL, unsafe_tl).
214
53
-define(OP_UNSAFE_ELEMENT(N), {unsafe_element, N}).
215
-define(OP_GET_MESSAGE, get_msg).
54
-define(OP_UNSAFE_SETELEMENT(N), {unsafe_update_element, N}).
55
-define(OP_CHECK_GET_MESSAGE, check_get_msg).
216
56
-define(OP_NEXT_MESSAGE, next_msg).
217
57
-define(OP_SELECT_MESSAGE, select_msg).
218
58
-define(OP_SET_TIMEOUT, set_timeout).
219
59
-define(OP_CLEAR_TIMEOUT, clear_timeout).
220
60
-define(OP_WAIT_FOR_MESSAGE, suspend_msg).
61
-define(OP_APPLY_FIXARITY(N), {apply_N, N}).
221
62
-define(OP_MAKE_FUN(M, F, A, H, I), {mkfun, {M, F, A}, H, I}).
222
63
-define(OP_FUN_ELEMENT(N), {closure_element, N}).
254
94
-define(TYPE_IS_NUMBER, number).
255
95
-define(TYPE_IS_PID, pid).
256
96
-define(TYPE_IS_PORT, port).
97
-define(TYPE_IS_RECORD(Atom_, Size_), {record, Atom_, Size_}).
257
98
-define(TYPE_IS_REFERENCE, reference).
258
99
-define(TYPE_IS_TUPLE, tuple).
260
%% Boolean temporary values
262
-define(BOOL_TRUE, 1).
263
-define(BOOL_FALSE, 0).
264
-define(BOOL_IS_TRUE, ?TYPE_FIXNUM(0)).
265
-define(BOOL_IS_FALSE, ?TYPE_FIXNUM(0)).
267
101
%% Record definitions
269
103
-record(ctxt, {final = false,
105
fail = [], % [] or fail-to label
106
class = expr, % expr | guard
107
line = 0, % current line number
108
'receive' % undefined | #receive{}
275
111
-record('receive', {loop}).
277
-record('fun', {label}).
112
-record(var, {name}).
113
-record('fun', {label, vars}).
116
%% ---------------------------------------------------------------------
120
%% @spec module(Module::cerl()) -> [icode()]
121
%% @equiv module(Module, [])
130
%% @spec module(Module::cerl(), Options::[term()]) -> [icode()]
132
%% cerl() = cerl:cerl()
133
%% icode() = hipe_icode:icode()
135
%% @doc Transforms a Core Erlang module to linear HiPE Icode. The result
136
%% is a list of Icode function definitions. Currently, no options are
139
%% <p>This function first calls the {@link cerl_hipeify:transform/2}
140
%% function on the module.</p>
142
%% <p>Note: Except for the module name, which is included in the header
143
%% of each Icode function definition, the remaining information (exports
144
%% and attributes) associated with the module definition is not included
145
%% in the resulting Icode.</p>
148
%% @see cerl_hipeify:transform/1
150
module(E, Options) ->
151
module_1(cerl_hipeify:transform(E, Options), Options).
153
module_1(E, Options) ->
154
M = cerl:atom_val(cerl:module_name(E)),
158
error_msg("bad module name: ~P.", [M, 5]),
162
S = s__set_pmatch(proplists:get_value(pmatch, Options), S0),
163
{Icode, _} = lists:mapfoldl(fun function_definition/2,
164
S, cerl:module_defs(E)),
167
%% For now, we simply assume that all function bodies should have degree
168
%% one (i.e., return exactly one value). We clear the code ackumulator
169
%% before we start compiling each function.
171
function_definition({V, F}, S) ->
172
S1 = s__set_code([], S),
173
{Icode, S2} = function_1(cerl:var_name(V), F, 1, S1),
174
{{icode_icode_name(Icode), Icode}, S2}.
177
reset_label_counter(),
180
%% @spec function(Module::atom(), Name::atom(), Function::cerl()) ->
182
%% @equiv function(Module, Name, Fun, 1)
185
function(Module, Name, Fun) ->
186
function(Module, Name, Fun, 1).
190
%% @spec function(Module::atom(), Name::{atom(), integer()},
191
%% Fun::cerl(), Degree::integer()) -> icode()
193
%% @doc Transforms a Core Erlang function to a HiPE Icode function
194
%% definition. `Fun' must represent a fun-expression, which may not
195
%% contain free variables. `Module' and `Name' specify the module and
196
%% function name of the resulting Icode function. Note that the arity
197
%% part of `Name' is not necessarily equivalent to the number of
198
%% parameters of `Fun' (this can happen e.g., for lifted closure
201
%% <p>`Degree' specifies the number of values the function is expected
202
%% to return; this is typically 1 (one); cf. {@link function/3}.</p>
206
%% <li>This function assumes that the code has been transformed into a
207
%% very simple and explicit form, using the {@link cerl_hipeify}
210
%% <li>Several primops (see "`cerl_hipe_primops.hrl'") are
211
%% detected by the translation and handled specially.</li>
213
%% <li>Tail call optimization is handled, even when the call is
214
%% "hidden" by let-definitions.</li>
216
%% <li>It is assumed that all `primop' calls in the code represent
217
%% Icode primops or macro instructions, and that all inter-module
218
%% calls (both calls to statically named functions, and dynamic
219
%% meta-calls) represent <em>actual</em> inter-module calls - not
220
%% primitive or built-in operations.</li>
222
%% <li>The following special form:
224
%% 'true' when 'true' -> True
225
%% 'false' when 'true' -> False
227
%% is recognized as an if-then-else switch where `Test' is known
228
%% to always yield 'true' or 'false'. Efficient jumping code is
229
%% generated for such expressions, in particular if nested. Note that
230
%% there must be exactly two clauses; order is not important.</li>
232
%% <li>Compilation of clauses is simplistic. No pattern matching
233
%% compilation or similar optimizations is done at this stage. Guards
234
%% that are `true' or `false' are recognized as trivially true/false;
235
%% for all other guards, code will be generated. Catch-all clauses
236
%% (with `true' guard and variable-only patterns) are detected, and
237
%% any following clauses are discarded.</li>
240
%% <p><b>Important</b>: This function does not handle occurrences of
241
%% fun-expressions in the body of `Fun', nor `apply'-expressions whose
242
%% operators are not locally bound function variables. These must be
243
%% transformed away before this function is called, by closure
244
%% conversion ({@link cerl_cconv}) using the `make_fun' and `call_fun'
245
%% primitive operations to create and apply functional values.</p>
247
%% <p>`receive'-expressions are expected to have a particular
250
%% <li>There must be exactly one clause, with the atom
251
%% `true' as guard, and only a single variable as pattern.
252
%% The variable will be bound to a message in the mailbox, and can be
253
%% referred to in the clause body.</li>
255
%% <li>In the body of that clause, all paths must execute one of the
256
%% primitive operations `receive_select/0' or
257
%% `receive_next/0' before another
258
%% `receive'-statement might be executed.
259
%% `receive_select/0' always returns, but without a value,
260
%% while `receive_next/0' never returns, either causing
261
%% the nearest surrounding receive-expression to be re-tried with the
262
%% next message in the input queue, or timing out.</li>
267
-include("cerl_hipe_primops.hrl").
279
269
%% Main translation function:
281
272
function(Module, Name, Fun, Degree) ->
282
273
S = init(Module),
283
274
{Icode, _} = function_1(Name, Fun, Degree, S),
286
%% We use the following convention for tail-recursive calls within the
289
279
function_1(Name, Fun, Degree, S) ->
290
280
reset_var_counter(),
291
281
LowV = max_var(),
292
282
LowL = max_label(),
294
283
%% Create input variables for the function parameters, and a list of
295
284
%% target variables for the result of the function.
296
285
Args = cerl:fun_vars(Fun),
297
Arity = length(Args),
298
ArgType = get_type(Args),
299
Vs = make_vars(Arity),
300
Vs1 = make_vars(Arity), % input variable temporaries
286
IcodeArity = length(Args),
287
ArgType = get_arg_types(Fun),
288
Vs = make_vars(IcodeArity),
289
Vs1 = make_vars(IcodeArity), % input variable temporaries
301
290
Ts = make_vars(Degree),
303
292
%% Initialise environment and context.
304
293
Env = bind_vars(Args, Vs, env__new()),
305
%% TODO: if the function returns no values, we can use effect mode.
294
%% TODO: if the function returns no values, we can use effect mode
306
295
Ctxt = #ctxt{final = true, effect = false},
308
%% Each basic block must begin with a label; also, we need to do a
309
%% reduction test at the start of each function. Note that we
296
%% Each basic block must begin with a label. Note that we
310
297
%% immediately transfer the input parameters to local variables, for
311
298
%% our self-recursive calling convention.
312
299
Start = new_label(),
313
300
Local = new_label(),
314
301
S1 = add_code([icode_label(Start)]
315
302
++ make_moves(Vs, Vs1)
316
++ [icode_label(Local)]
317
++ make_op(?OP_REDTEST, [], [], #ctxt{}),
318
s__set_function({Name, Arity}, S)),
303
++ [icode_label(Local)],
304
s__set_function(Name, S)),
319
305
S2 = expr(cerl:fun_body(Fun), Ts, Ctxt, Env,
320
306
s__set_local_entry({Local, Vs}, S1)),
322
308
%% This creates an Icode function definition. The ranges of used
323
309
%% variables and labels below should be nonempty. Note that the
324
%% input variables are `Vs1', which will be transferred to `Vs' (see
310
%% input variables for the Icode function are `Vs1', which will be
311
%% transferred to `Vs' (see above).
326
312
HighV = new_var(), % assure nonempty range
327
313
HighL = max_label(),
328
Lambda = lists:member(lambda, cerl:get_ann(Fun)),
329
Leaf = false, %% TODO: annotate functions with is-leaf info
314
Closure = lists:member(closure, cerl:get_ann(Fun)),
330
315
Module = s__get_module(S2),
331
316
Code = s__get_code(S2),
332
Function = icode_icode({Module, Name, Arity}, Vs1, Lambda, Leaf,
333
Code, {LowV, HighV}, {LowL, HighL}, ArgType),
336
expr(E, Ts, Ctxt, Env, S) ->
317
Function = icode_icode(Module, Name, Vs1, Closure, Code,
318
{LowV, HighV}, {LowL, HighL}, ArgType),
320
{value, {_, OrigArity}} =
321
lists:keysearch(closure_orig_arity, 1, cerl:get_ann(Fun)),
322
{hipe_icode:icode_closure_arity_update(Function,
325
true -> {Function, S2}
328
%% ---------------------------------------------------------------------
329
%% Main expression handler
331
expr(E, Ts, Ctxt, Env, S0) ->
332
%% Insert source code position information
333
case get_line(cerl:get_ann(E)) of
335
expr_1(E, Ts, Ctxt, Env, S0);
336
Line when Line > Ctxt#ctxt.line ->
337
Txt = "Line: " ++ integer_to_list(Line),
338
S1 = add_code([icode_comment(Txt)], S0),
339
expr_1(E, Ts, Ctxt#ctxt{line = Line}, Env, S1);
341
expr_1(E, Ts, Ctxt, Env, S0)
344
expr_1(E, Ts, Ctxt, Env, S) ->
337
345
case cerl:type(E) of
339
347
expr_var(E, Ts, Ctxt, Env, S);
450
484
S1 = exprs(cerl:values_es(E), Ts, Ctxt#ctxt{final = false}, Env, S),
451
485
maybe_return(Ts, Ctxt, S1).
453
%% Nonconstant tuples and cons cells
487
%% ---------------------------------------------------------------------
488
%% Nonconstant tuples
455
490
expr_tuple(E, _Ts, #ctxt{effect = true} = Ctxt, Env, S) ->
456
expr_list(cerl:tuple_es(E), Ctxt, Env, S);
491
{_Vs, S1} = expr_list(cerl:tuple_es(E), Ctxt, Env, S),
457
493
expr_tuple(E, [_V] = Ts, Ctxt, Env, S) ->
458
494
{Vs, S1} = expr_list(cerl:tuple_es(E), Ctxt, Env, S),
459
S2 = add_code(make_op(?OP_TUPLE, Ts, Vs, Ctxt), S1),
460
maybe_return(Ts, Ctxt, S2);
495
add_code(make_op(?OP_TUPLE, Ts, Vs, Ctxt), S1);
461
496
expr_tuple(E, Ts, _Ctxt, _Env, _S) ->
462
497
error_degree_mismatch(length(Ts), E),
500
%% ---------------------------------------------------------------------
501
%% Nonconstant cons cells
465
503
expr_cons(E, _Ts, #ctxt{effect = true} = Ctxt, Env, S) ->
466
expr_list([cerl:cons_hd(E), cerl:cons_tl(E)], Ctxt, Env, S);
504
{_Vs, S1} =expr_list([cerl:cons_hd(E), cerl:cons_tl(E)], Ctxt, Env, S),
467
506
expr_cons(E, [_V] = Ts, Ctxt, Env, S) ->
468
507
{Vs, S1} = expr_list([cerl:cons_hd(E), cerl:cons_tl(E)],
470
S2 = add_code(make_op(?OP_CONS, Ts, Vs, Ctxt), S1),
471
maybe_return(Ts, Ctxt, S2);
509
add_code(make_op(?OP_CONS, Ts, Vs, Ctxt), S1);
472
510
expr_cons(E, Ts, _Ctxt, _Env, _S) ->
473
511
error_degree_mismatch(length(Ts), E),
514
%% ---------------------------------------------------------------------
476
517
%% We want to make sure we are not easily tricked by expressions hidden
477
%% in contexts like "let X = Expr in X"; this should not destroy last
518
%% in contexts like "let X = Expr in X"; this should not destroy tail
478
519
%% call properties.
480
521
expr_let(E, Ts, Ctxt, Env, S) ->
522
F = fun (B, Ctxt, Env, S) -> expr(B, Ts, Ctxt, Env, S) end,
523
expr_let_1(E, F, Ctxt, Env, S).
525
expr_let_1(E, F, Ctxt, Env, S) ->
526
E1 = cerl_lib:reduce_expr(E),
482
527
case cerl:is_c_let(E1) of
484
expr_let_1(E1, Ts, Ctxt, Env, S);
529
expr_let_2(E1, F, Ctxt, Env, S);
486
531
%% Redispatch the new expression.
487
expr(E1, Ts, Ctxt, Env, S)
490
expr_let_1(E, Ts, Ctxt, Env, S) ->
535
expr_let_2(E, F, Ctxt, Env, S) ->
491
536
Vars = cerl:let_vars(E),
492
537
Vs = make_vars(length(Vars)),
493
538
S1 = expr(cerl:let_arg(E), Vs,
494
539
Ctxt#ctxt{effect = false, final = false}, Env, S),
495
540
Env1 = bind_vars(Vars, Vs, Env),
496
B = cerl:let_body(E),
497
expr(B, Ts, Ctxt, Env1, S1).
541
F(cerl:let_body(E), Ctxt, Env1, S1).
543
%% ---------------------------------------------------------------------
499
546
%% To compile a sequencing operator, we generate code for effect only
500
547
%% for the first expression (the "argument") and then use the
501
%% surrounding context for the second expression (the "body") .
548
%% surrounding context for the second expression (the "body"). Note that
549
%% we always create a new dummy target variable; this is necessary for
550
%% many ICode operations, even if the result is not used.
503
552
expr_seq(E, Ts, Ctxt, Env, S) ->
553
F = fun (B, Ctxt, Env, S) -> expr(B, Ts, Ctxt, Env, S) end,
554
expr_seq_1(E, F, Ctxt, Env, S).
556
expr_seq_1(E, F, Ctxt, Env, S) ->
504
557
Ctxt1 = Ctxt#ctxt{effect = true, final = false},
505
S1 = expr(cerl:seq_arg(E), [], Ctxt1, Env, S),
506
expr(cerl:seq_body(E), Ts, Ctxt, Env, S1).
508
expr_binary(E, [V]=Ts, #ctxt{fail=FL, class = guard}=Ctxt, Env, S) ->
558
S1 = expr(cerl:seq_arg(E), [make_var()], Ctxt1, Env, S),
559
F(cerl:seq_body(E), Ctxt, Env, S1).
561
%% ---------------------------------------------------------------------
564
expr_binary(E, [V]=Ts, Ctxt, Env, S) ->
567
Segs = cerl:binary_segments(E),
568
S1 = case do_size_code(Segs, S, Env, Ctxt) of
570
Primop = {hipe_bs_primop, {bs_init2, Size, 0}},
571
add_code([icode_call_primop([V, Base, Offset], Primop, [])],
573
{var, S0, SizeVar} ->
574
Primop = {hipe_bs_primop, {bs_init2, 0}},
575
add_code([icode_call_primop([V, Base, Offset],
579
Vars = make_vars(length(Segs)),
580
S2 = binary_segments(Segs, Vars, Ctxt, Env, S1, 0, Base, Offset),
581
maybe_return(Ts, Ctxt, S2).
583
do_size_code(Segs, S, Env, Ctxt) ->
584
case do_size_code(Segs, S, Env, cerl:c_int(0), [], []) of
585
{[], [], Const, S1} ->
586
{const, S1, (cerl:concrete(Const) + 7) div 8};
587
{Pairs, Bins, Const, S1} ->
589
S2 = add_code([icode_move(V1, icode_const(cerl:int_val(Const)))], S1),
590
{S3, SizeVar} = create_size_code(Pairs, Bins, Ctxt, V1, S2),
594
do_size_code([Seg|Rest], S, Env, Const, Pairs, Bins) ->
595
Size = cerl:bitstr_size(Seg),
596
Unit = cerl:bitstr_unit(Seg),
597
Val = cerl:bitstr_val(Seg),
598
case calculate_size(Unit, Size, 0, Env, S) of
599
{NewVal, [], S, _} ->
600
do_size_code(Rest, S, Env, add_val(NewVal, Const), Pairs, Bins);
601
{UnitVal, [Var], S1, _} ->
602
do_size_code(Rest, S1, Env, Const, [{UnitVal,Var}|Pairs], Bins);
605
S1 = expr(Val, [Binary], #ctxt{final=false}, Env, S),
606
do_size_code(Rest, S1, Env, Const, Pairs, [{all,Binary}|Bins])
608
do_size_code([], S, _Env, Const, Pairs, Bins) ->
609
{Pairs, Bins, Const, S}.
611
add_val(NewVal, Const) ->
612
cerl:c_int(NewVal + cerl:concrete(Const)).
614
create_size_code([{UnitVal, Var}|Rest], Bins, Ctxt, Old, S0) ->
616
S = make_bs_add(UnitVal, Old, Var, Dst, Ctxt, S0),
617
create_size_code(Rest, Bins, Ctxt, Dst, S);
618
create_size_code([], Bins, Ctxt, Old, S0) ->
620
S = make_bs_bits_to_bytes(Old, Dst, Ctxt, S0),
621
create_size_code(Bins, Ctxt, Dst, S).
623
create_size_code([{all,Bin}|Rest], Ctxt, Old, S0) ->
625
S = make_binary_size(Old, Bin, Dst, Ctxt, S0),
626
create_size_code(Rest, Ctxt, Dst, S);
627
create_size_code([], _Ctxt, Dst, S) ->
630
make_bs_add(Unit, Old, Var, Dst, #ctxt{fail=FL, class=guard}, S0) ->
632
Primop = {hipe_bs_primop, {bs_add, Unit}},
633
add_code([icode_guardop([Dst], Primop, [Old, Var], SL, FL),
634
icode_label(SL)], S0);
635
make_bs_add(Unit, Old, Var, Dst, _Ctxt, S0) ->
636
Primop = {hipe_bs_primop, {bs_add, Unit}},
637
add_code([icode_call_primop([Dst], Primop, [Old, Var])], S0).
639
make_bs_bits_to_bytes(Old, Dst, #ctxt{fail=FL, class=guard}, S0) ->
641
Primop = {hipe_bs_primop, bs_bits_to_bytes},
642
add_code([icode_guardop([Dst], Primop, [Old], SL, FL),
643
icode_label(SL)], S0);
644
make_bs_bits_to_bytes(Old, Dst, _Ctxt, S0) ->
645
Primop = {hipe_bs_primop, bs_bits_to_bytes},
646
add_code([icode_call_primop([Dst], Primop, [Old])], S0).
648
make_binary_size(Old, Bin, Dst, #ctxt{fail=FL, class=guard}, S0) ->
509
649
SL1 = new_label(),
510
650
SL2 = new_label(),
511
Segs = cerl:binary_segs(E),
512
S1 = add_code([icode_guardop([], {hipe_bs_primop, {bs_init, 0,0}}, [], SL1, FL),
513
icode_label(SL1)], S),
514
Vars = make_vars(length(Segs)),
515
S2 = bin_segs(Segs, Vars, Ctxt, Env, 0, S1),
516
S3 = add_code([icode_guardop([V], {hipe_bs_primop, bs_final}, [], SL2, FL),
517
icode_label(SL2)], S2),
518
maybe_return(Ts, Ctxt, S3);
520
expr_binary(E, [V]=Ts, Ctxt, Env, S) ->
521
Segs = cerl:binary_segs(E),
522
S1 = add_code([icode_call_primop([], {hipe_bs_primop, {bs_init, 0,0}}, [])], S),
523
Vars = make_vars(length(Segs)),
524
S2 = bin_segs(Segs, Vars, Ctxt, Env, S1, 0),
525
S3 = add_code([icode_call_primop([V], {hipe_bs_primop, bs_final}, [])], S2),
526
maybe_return(Ts, Ctxt, S3).
528
bin_segs([Seg|Rest], [T|Ts], Ctxt=#ctxt{}, Env, S, Align) ->
529
{S1, NewAlign} = bin_seg(Seg, [T], Ctxt, Env, S, Align),
530
bin_segs(Rest, Ts, Ctxt, Env, S1, NewAlign);
531
bin_segs([], [], #ctxt{}, _Env, S, _Align) ->
534
bin_seg(E, Ts, Ctxt, Env, S, Align) ->
535
Size = cerl:bin_seg_size(E),
536
Unit = cerl:bin_seg_unit(E),
537
LiteralFlags = cerl:bin_seg_flags(E),
538
Val = cerl:bin_seg_val(E),
539
Type = cerl:concrete(cerl:bin_seg_type(E)),
540
S0 = expr(Val, Ts, Ctxt#ctxt{final = false}, Env, S),
651
add_code([icode_guardop([Dst], {erlang, size, 1}, [Bin], SL1, FL),
653
icode_guardop([Dst], '+', [Old, Dst], SL2, FL),
654
icode_label(SL2)], S0);
655
make_binary_size(Old, Bin, Dst, _Ctxt, S0) ->
656
add_code([icode_call_primop([Dst], {erlang, size, 1}, [Bin]),
657
icode_call_primop([Dst], '+', [Old, Dst])], S0).
659
binary_segments(SegList, TList, Ctxt=#ctxt{}, Env, S, Align, Base,
661
case do_const_segs(SegList, TList, S, Align, Base, Offset) of
662
{[Seg|Rest], [T|Ts], S1} ->
663
{S2, NewAlign} = bitstr(Seg, [T], Ctxt, Env, S1, Align,
665
binary_segments(Rest, Ts, Ctxt, Env, S2, NewAlign, Base, Offset);
670
do_const_segs(SegList, TList, S, Align, Base, Offset) ->
671
case get_segs(SegList, TList, [], 0, {[], SegList, TList}) of
672
{[], SegList, TList} ->
674
{ConstSegs, RestSegs, RestT} ->
675
String = create_string(ConstSegs, <<>>, 0),
676
Flags = translate_flags1([], Align),
677
Name = {bs_put_string, String, length(String), Flags},
678
Primop = {hipe_bs_primop, Name},
680
add_code([icode_call_primop([Offset], Primop, [Base, Offset])],
684
get_segs([Seg|Rest], [_|RestT], Acc, AccSize, BestPresent) ->
685
Size = cerl:bitstr_size(Seg),
686
Unit = cerl:bitstr_unit(Seg),
687
Val = cerl:bitstr_val(Seg),
688
case allowed(Size, Unit, Val, AccSize) of
689
{true, NewAccSize} ->
692
get_segs(Rest, RestT, [Seg|Acc], NewAccSize, BestPresent);
694
get_segs(Rest, RestT, [Seg|Acc], NewAccSize,
695
{lists:reverse([Seg|Acc]), Rest, RestT})
697
{possible, NewAccSize} ->
698
get_segs(Rest, RestT, [Seg|Acc], NewAccSize, BestPresent);
702
get_segs([], [], _Acc, _AccSize, Best) ->
706
create_string([Seg|Rest], Bin, TotalSize) ->
707
Size = cerl:bitstr_size(Seg),
708
Unit = cerl:bitstr_unit(Seg),
709
NewSize = cerl:int_val(Size) * cerl:int_val(Unit),
710
LitVal = cerl:concrete(cerl:bitstr_val(Seg)),
711
LiteralFlags = cerl:bitstr_flags(Seg),
712
FlagVal = translate_flags(LiteralFlags, []),
713
NewTotalSize = NewSize + TotalSize,
714
Pad = (8 - NewTotalSize rem 8) rem 8,
715
NewBin = case cerl:concrete(cerl:bitstr_type(Seg)) of
717
case {FlagVal band 2, FlagVal band 4} of
719
<<Bin:TotalSize/binary-unit:1,
720
LitVal:NewSize/integer-little-signed, 0:Pad>>;
722
<<Bin:TotalSize/binary-unit:1,
723
LitVal:NewSize/integer-signed, 0:Pad>>;
725
<<Bin:TotalSize/binary-unit:1,
726
LitVal:NewSize/integer-little, 0:Pad>>;
728
<<Bin:TotalSize/binary-unit:1,
729
LitVal:NewSize/integer, 0:Pad>>
732
case FlagVal band 2 of
734
<<Bin:TotalSize/binary-unit:1,
735
LitVal:NewSize/float-little, 0:Pad>>;
737
<<Bin:TotalSize/binary-unit:1,
738
LitVal:NewSize/float, 0:Pad>>
741
create_string(Rest, NewBin, NewTotalSize);
743
create_string([], Bin, _Size) ->
746
allowed(Size, Unit, Val, AccSize) ->
747
case {cerl:is_c_int(Size), cerl:is_literal(Val)} of
749
NewAccSize = cerl:int_val(Size) * cerl:int_val(Unit) + AccSize,
750
case NewAccSize rem 8 of
754
{possible, NewAccSize}
760
bitstr(E, Ts, Ctxt, Env, S, Align, Base, Offset) ->
761
Size = cerl:bitstr_size(E),
762
Unit = cerl:bitstr_unit(E),
763
LiteralFlags = cerl:bitstr_flags(E),
764
Val = cerl:bitstr_val(E),
765
Type = cerl:concrete(cerl:bitstr_type(E)),
766
S0 = expr(Val, Ts, Ctxt#ctxt{final = false, effect = false}, Env, S),
541
767
ConstInfo = get_const_info(Val, Type),
542
768
Flags = translate_flags(LiteralFlags, Align),
543
769
SizeInfo = calculate_size(Unit, Size, Align, Env, S0),
544
bin_seg_gen_op(Ts, Ctxt, SizeInfo, ConstInfo, Type, Flags).
770
bitstr_gen_op(Ts, Ctxt, SizeInfo, ConstInfo, Type, Flags, Base, Offset).
546
bin_seg_gen_op([V], #ctxt{fail=FL, class=guard}, SizeInfo, ConstInfo, Type, Flags) ->
772
bitstr_gen_op([V], #ctxt{fail=FL, class=guard}, SizeInfo, ConstInfo,
773
Type, Flags, Base, Offset) ->
547
774
SL = new_label(),
549
776
{NewUnit, NewArgs, S1, NewAlign} ->
777
Args = [V|NewArgs] ++ [Base, Offset],
580
811
{bs_put_binary, NewUnit, Flags}
582
{add_code([icode_call_primop([], {hipe_bs_primop, Name} ,Args)], S), NewAlign};
813
Primop = {hipe_bs_primop, Name},
814
{add_code([icode_call_primop([Offset], Primop, Args)], S),
583
816
{all, NewAlign, S} ->
585
818
Name = {bs_put_binary_all, Flags},
586
{add_code([icode_call_primop([], {hipe_bs_primop, Name}, [V])], S), NewAlign}
819
Primop = {hipe_bs_primop, Name},
820
{add_code([icode_call_primop([Offset], Primop,
821
[V, Base, Offset])], S),
825
%% ---------------------------------------------------------------------
589
828
%% Note that the arity of the called function only depends on the length
590
829
%% of the argument list; the arity stated by the function name is
593
832
expr_apply(E, Ts, Ctxt, Env, S) ->
594
Op = reduce_expr(cerl:apply_op(E)),
595
Name = case cerl:is_c_var(Op) of
597
case cerl:var_name(Op) of
598
{N, A} = Id when atom(N), integer(A) ->
599
case env__lookup(Id, Env) of
601
%% This is assumed to be a function
602
%% in the same module, not
603
%% necessarily exported.
606
%% This is assumed to be a
607
%% nonescaping, nonexported function,
608
%% defined locally by a
609
%% letrec-expression.
610
%% TODO: letrec-calls
611
throw(calling_local_function_not_handled);
614
"cannot use functional "
615
"values indirectly: ~P.",
620
error_nonlocal_application(Op),
624
error_nonlocal_application(Op),
833
Op = cerl_lib:reduce_expr(cerl:apply_op(E)),
627
834
{Vs, S1} = expr_list(cerl:apply_args(E), Ctxt, Env, S),
628
add_local_call(Name, Vs, Ts, Ctxt, S1, get_type(E)).
630
%% If we know the module and function names statically, we do not have
631
%% to go through the much more inefficient generic meta-call operator.
835
case cerl:is_c_var(Op) of
837
case cerl:var_name(Op) of
838
{N, A} = V when is_atom(N), is_integer(A) ->
839
case env__lookup(V, Env) of
841
%% Assumed to be a function in the
842
%% current module; we don't check.
843
add_local_call(V, Vs, Ts, Ctxt, S1,
845
{ok, #'fun'{label = L, vars = Vs1}} ->
846
%% Call to a local letrec-bound function.
847
add_letrec_call(L, Vs1, Vs, Ctxt, S1);
849
error_msg("cannot call via variable; must "
850
"be closure converted: ~P.",
855
error_nonlocal_application(Op),
859
error_nonlocal_application(Op),
863
%% ---------------------------------------------------------------------
866
%% Unless we know the module and function names statically, we have to
867
%% go through the meta-call operator for a static number of arguments.
633
869
expr_call(E, Ts, Ctxt, Env, S) ->
634
Module = reduce_expr(cerl:call_module(E)),
635
Name = reduce_expr(cerl:call_name(E)),
870
Module = cerl_lib:reduce_expr(cerl:call_module(E)),
871
Name = cerl_lib:reduce_expr(cerl:call_name(E)),
636
872
case cerl:is_c_atom(Module) and cerl:is_c_atom(Name) of
638
874
M = cerl:atom_val(Module),
639
N = cerl:atom_val(Name),
875
F = cerl:atom_val(Name),
640
876
{Vs, S1} = expr_list(cerl:call_args(E), Ctxt, Env, S),
641
Code = case Ctxt#ctxt.final of
643
[icode_call_remote(Ts, M, N, Vs)];
645
[icode_enter_remote(M, N, Vs)]
877
add_code(make_call(M, F, Ts, Vs, Ctxt), S1);
649
%% Metacalls are handled using the Icode `apply'
651
Args = cerl:make_list(cerl:call_args(E)),
652
{As, S1} = expr_list([Module, Name, Args], Ctxt, Env, S),
653
Code = case Ctxt#ctxt.final of
655
[icode_call_remote(Ts, erlang, apply, As)];
657
[icode_enter_remote(erlang, apply, As)]
879
Args = cerl:call_args(E),
881
{Vs, S1} = expr_list([Module, Name | Args], Ctxt, Env, S),
882
add_code(make_op(?OP_APPLY_FIXARITY(N), Ts, Vs, Ctxt), S1)
885
%% ---------------------------------------------------------------------
662
888
%% Core Erlang primop calls are generally mapped directly to Icode
663
889
%% primop calls, with a few exceptions (listed above), which are
664
890
%% expanded inline, sometimes depending on context. Note that primop
665
%% calls do not have specialized last-call forms.
891
%% calls do not have specialized tail-call forms.
667
893
expr_primop(E, Ts, Ctxt, Env, S) ->
668
894
Name = cerl:atom_val(cerl:primop_name(E)),
783
1019
case cerl:is_c_int(N) of
786
S1 = expr(F, [V], Ctxt, Env, S),
787
S2 = add_code(make_op(?OP_FUN_ELEMENT(cerl:int_val(N)),
790
maybe_return(Ts, Ctxt, S2);
1022
S1 = expr(F, [V], Ctxt#ctxt{final = false, effect = false},
1024
add_code(make_op(?OP_FUN_ELEMENT(cerl:int_val(N)),
792
1028
error_primop_badargs(?PRIMOP_FUN_ELEMENT, As),
796
%% Catch-expressions:
798
expr_catch(E, [T] = Ts, Ctxt, Env, S) ->
1032
primop_goto_label(A, S) ->
1033
{Label,S1} = s__get_label(A, S),
1034
add_code([icode_goto(Label)], S1).
1037
case cerl:type(E) of
1039
Name = cerl:atom_val(cerl:primop_name(E)),
1040
As = cerl:primop_args(E),
1042
case {Name, Arity} of
1043
{?PRIMOP_GOTO_LABEL, 1} ->
1052
primop_reduction_test(Ctxt, S) ->
1053
add_code(make_op(?OP_REDTEST, [], [], Ctxt), S).
1055
primop_dsetelement([N | As1] = As, Ts, Ctxt, Env, S) ->
1056
case cerl:is_c_int(N) of
1058
{Vs, S1} = expr_list(As1, Ctxt, Env, S),
1059
add_code(make_op(?OP_UNSAFE_SETELEMENT(cerl:int_val(N)),
1063
error_primop_badargs(?PRIMOP_DSETELEMENT, As),
1067
%% ---------------------------------------------------------------------
1070
%% We want to rewrite trivial things like `try A of X -> B catch ...',
1071
%% where A is safe, into a simple let-binding `let X = A in B', avoiding
1072
%% unnecessary try-blocks. (The `let' might become further simplified.)
1074
expr_try(E, Ts, Ctxt, Env, S) ->
1075
F = fun (B, Ctxt, Env, S) -> expr(B, Ts, Ctxt, Env, S) end,
1076
expr_try_1(E, F, Ctxt, Env, S).
1078
expr_try_1(E, F, Ctxt, Env, S) ->
1079
A = cerl:try_arg(E),
1080
case is_safe_expr(A) of
1082
E1 = cerl:c_let(cerl:try_vars(E), A, cerl:try_body(E)),
1083
expr_let_1(E1, F, Ctxt, Env, S);
1085
expr_try_2(E, F, Ctxt, Env, S)
1088
%% TODO: maybe skip begin_try/end_try and just use fail-labels...
1090
expr_try_2(E, F, Ctxt, Env, S) ->
1091
Cont = new_continuation_label(Ctxt),
800
1092
Catch = new_label(),
801
S1 = add_code([icode_pushcatch(Catch,Cont),icode_label(Cont)], S),
1094
S1 = add_code([icode_begin_try(Catch,Next),icode_label(Next)], S),
1095
Vars = cerl:try_vars(E),
1096
Vs = make_vars(length(Vars)),
1097
Ctxt1 = Ctxt#ctxt{final = false},
1098
S2 = expr(cerl:try_arg(E), Vs, Ctxt1, Env, S1),
1099
Env1 = bind_vars(Vars, Vs, Env),
1100
S3 = add_code([icode_end_try()], S2),
1101
S4 = F(cerl:try_body(E), Ctxt, Env1, S3),
1102
S5 = add_continuation_jump(Cont, Ctxt, S4),
1103
EVars = cerl:try_evars(E),
1104
EVs = make_vars(length(EVars)),
1105
Env2 = bind_vars(EVars, EVs, Env),
1106
S6 = add_code([icode_label(Catch), icode_begin_handler(EVs)], S5),
1107
S7 = F(cerl:try_handler(E), Ctxt, Env2, S6),
1108
add_continuation_label(Cont, Ctxt, S7).
1110
%% ---------------------------------------------------------------------
1111
%% Letrec-expressions (local goto-labels)
1113
%% We only handle letrec-functions as continuations. The fun-bodies are
1114
%% always compiled in the same context as the main letrec-body. Note
1115
%% that we cannot propagate "advanced" contexts like boolean-compilation
1116
%% into the letrec body like we do for ordinary lets or seqs, since the
1117
%% context for an individual local function would be depending on the
1118
%% contexts of its call sites.
1120
expr_letrec(E, Ts, Ctxt, Env, S) ->
1121
Ds = cerl:letrec_defs(E),
1122
Env1 = add_defs(Ds, Env),
1123
S1 = expr(cerl:letrec_body(E), Ts, Ctxt, Env1, S),
802
1124
Next = new_continuation_label(Ctxt),
803
S2 = expr(cerl:catch_body(E), Ts, Ctxt, Env, S1),
804
S3 = add_code([icode_remove_catch(Catch)], S2),
805
S4 = add_continuation_jump(Next, Ctxt, S3),
806
S5 = add_code([icode_label(Catch),
807
icode_restore_catch(T, Catch)],
809
add_continuation_label(Next, Ctxt, S5);
810
expr_catch(_E, _Ts, _Ctxt, _Env, _S) ->
811
error_msg("use of catch expression expects degree other than 1."),
816
%% For now, we rewrite try-expressions to be simulated using
817
%% catch-expressions and unique references. The generated code has the
818
%% following structure:
820
%% let V0 = primop 'make_ref'() in
821
%% case catch {V0, #TryArg#} of
822
%% {V1, V2} when primop '=:='(V0, V1) -> V2
826
%% {'EXIT', V2} when 'true' -> <'EXIT', V2>
827
%% V2 when 'true' -> <'THROW', V2>
832
%% (Note that even though we introduce new variables, they are only used
833
%% locally, so we never need to rename existing variables.)
835
expr_try(E, Ts, Ctxt = #ctxt{class = guard}, Env, S) ->
836
%% The limited form of try-expressions allowed in guards:
837
%% "try Expr of X -> X catch <X1,X2> -> 'false' end".
840
Ctxt1 = Ctxt#ctxt{fail = Fail},
841
S1 = expr(cerl:try_arg(E), Ts, Ctxt1, Env, S),
842
S2 = add_code([icode_goto(Next), icode_label(Fail)], S1),
843
S3 = expr(cerl:c_atom(false), Ts, Ctxt, Env, S2),
844
add_code([icode_label(Next)], S3);
845
expr_try(_E, _Ts, _Ctxt, _Env, _S) ->
846
throw(try_expressions_not_handled).
847
%%% [Id0, Id1, Id2] = env__new_integer_keys(3, Env),
848
%%% V0 = cerl:c_var(Id0),
849
%%% V1 = cerl:c_var(Id1),
850
%%% V2 = cerl:c_var(Id2),
851
%%% True = cerl:c_atom('true'),
852
%%% Exit = cerl:c_atom('EXIT'),
853
%%% Throw = cerl:c_atom('THROW'),
854
%%% Cs2 = [cerl:c_clause([cerl:c_tuple([Exit, V2])], True,
855
%%% cerl:c_values([Exit, V2])),
856
%%% cerl:c_clause([V2], True,
857
%%% cerl:c_values([Throw, V2]))],
858
%%% Body = cerl:c_let(cerl:try_vars(E),
859
%%% cerl:c_case(V1, Cs2),
860
%%% cerl:try_body(E)),
861
%%% Guard = cerl:c_primop(cerl:c_atom('=:='), [V0, V1]),
862
%%% Cs1 = [cerl:c_clause([cerl:c_tuple([V1, V2])], Guard, V2),
863
%%% cerl:c_clause([V1], True, Body)],
864
%%% Catch = cerl:c_catch(cerl:c_tuple([V0, cerl:try_expr(E)])),
865
%%% MakeRef = cerl:c_primop(cerl:c_atom(make_ref), []),
866
%%% E1 = cerl:c_let([V0], MakeRef, cerl:c_case(Catch, Cs1)),
867
%%% %%% info_msg("\n" ++ cerl_prettypr:format(E1), []),
868
%%% expr(Effect, E1, Ts, Ctxt, Env, S).
870
%% Receive-expressions: There may only be exactly one clause, which must
871
%% be a trivial catch-all with exactly one (variable) pattern. Each
872
%% message will be read from the mailbox and bound to the pattern
873
%% variable; the body of the clause must do the switching and call
874
%% either of the primops `receive_select/0' or `receive_next/0'.
1125
S2 = add_continuation_jump(Next, Ctxt, S1),
1126
S3 = defs(Ds, Ts, Ctxt, Env1, S2),
1127
add_continuation_label(Next, Ctxt, S3).
1129
add_defs([{V, _F} | Ds], Env) ->
1130
{_, A} = cerl:var_name(V),
1133
Env1 = bind_fun(V, L, Vs, Env),
1135
add_defs([], Env) ->
1138
defs([{V, F} | Ds], Ts, Ctxt, Env, S) ->
1139
Name = cerl:var_name(V),
1140
#'fun'{label = L, vars = Vs} = env__get(Name, Env),
1141
S1 = add_code([icode_label(L)], S),
1142
Env1 = bind_vars(cerl:fun_vars(F), Vs, Env),
1143
S2 = expr(cerl:fun_body(F), Ts, Ctxt, Env1, S1),
1144
defs(Ds, Ts, Ctxt, Env, S2);
1145
defs([], _Ts, _Ctxt, _Env, S) ->
1148
%% ---------------------------------------------------------------------
1149
%% Receive-expressions
1151
%% There may only be exactly one clause, which must be a trivial
1152
%% catch-all with exactly one (variable) pattern. Each message will be
1153
%% read from the mailbox and bound to the pattern variable; the body of
1154
%% the clause must do the switching and call either of the primops
1155
%% `receive_select/0' or `receive_next/0'.
876
1157
expr_receive(E, Ts, Ctxt, Env, S) ->
1158
F = fun (B, Ctxt, Env, S) -> expr(B, Ts, Ctxt, Env, S) end,
1159
expr_receive_1(E, F, Ctxt, Env, S).
1161
expr_receive_1(E, F, Ctxt, Env, S) ->
877
1162
case cerl:receive_clauses(E) of
879
1164
case cerl:clause_pats(C) of
881
1166
case cerl_clauses:is_catchall(C) of
883
expr_receive_1(C, E, Ts, Ctxt, Env, S);
1168
expr_receive_2(C, E, F, Ctxt, Env, S);
885
1170
error_msg("receive-expression clause "
886
"is not a catch-all."),
1171
"must be a catch-all."),
1023
1330
%% same - add a dummy label if necessary.
1024
1331
S1 = add_code(make_op(?OP_NEXT_MESSAGE, [], [], #ctxt{})
1025
1332
++ [icode_goto(Loop)], S0),
1026
L = new_continuation_label(Ctxt),
1027
add_continuation_label(L, Ctxt, S1);
1333
add_new_continuation_label(Ctxt, S1);
1029
warning_not_in_receive(?PRIMOP_RECEIVE_NEXT),
1335
error_not_in_receive(?PRIMOP_RECEIVE_NEXT),
1033
1339
primop_receive_select(Ts, #ctxt{'receive' = R} = Ctxt, S) ->
1035
1341
#'receive'{} ->
1036
S1 = add_code(make_op(?OP_SELECT_MESSAGE, [], [], Ctxt),
1038
maybe_return(Ts, Ctxt, S1);
1342
add_code(make_op(?OP_SELECT_MESSAGE, Ts, [], Ctxt), S);
1040
warning_not_in_receive(?PRIMOP_RECEIVE_SELECT),
1344
error_not_in_receive(?PRIMOP_RECEIVE_SELECT),
1348
%% ---------------------------------------------------------------------
1044
1349
%% Case expressions
1046
%% We know that the pattern matching compilation has split all switches
1047
%% into separate groups of tuples, integers, atoms, etc., and that each
1048
%% such switch over a group of constructors is protected by a type test.
1049
%% Thus, it is straightforward to generate switch instructions.
1351
%% Typically, pattern matching compilation has split all switches into
1352
%% separate groups of tuples, integers, atoms, etc., where each such
1353
%% switch over a group of constructors is protected by a type test.
1354
%% Thus, it is straightforward to generate switch instructions. (If no
1355
%% pattern matching compilation has been done, we don't care about
1356
%% efficiency anyway, so we don't spend any extra effort here.)
1051
1358
expr_case(E, Ts, Ctxt, Env, S) ->
1359
F = fun (B, Ctxt, Env, S) -> expr(B, Ts, Ctxt, Env, S) end,
1360
expr_case_1(E, F, Ctxt, Env, S).
1362
expr_case_1(E, F, Ctxt, Env, S) ->
1052
1363
Cs = cerl:case_clauses(E),
1053
Vs = make_vars(clauses_degree(Cs)),
1054
S1 = expr(cerl:case_arg(E), Vs,
1055
Ctxt#ctxt{final = false, effect = false}, Env, S),
1364
A = cerl:case_arg(E),
1365
case cerl_lib:is_bool_switch(Cs) of
1367
%% An if-then-else with a known boolean argument
1368
{True, False} = cerl_lib:bool_switch_cases(Cs),
1369
bool_switch(A, True, False, F, Ctxt, Env, S);
1371
Vs = make_vars(cerl:clause_arity(hd(Cs))),
1372
Ctxt1 = Ctxt#ctxt{final = false, effect = false},
1373
S1 = expr(A, Vs, Ctxt1, Env, S),
1374
expr_case_2(Vs, Cs, F, Ctxt, Env, S1)
1377
%% Switching on a value
1379
expr_case_2(Vs, Cs, F, Ctxt, Env, S1) ->
1056
1380
case is_constant_switch(Cs) of
1058
switch_val_clauses(Cs, Ts, Vs, Ctxt, Env, S1);
1382
switch_val_clauses(Cs, F, Vs, Ctxt, Env, S1);
1060
1384
case is_tuple_switch(Cs) of
1062
switch_tuple_clauses(Cs, Ts, Vs, Ctxt, Env, S1);
1386
switch_tuple_clauses(Cs, F, Vs, Ctxt, Env, S1);
1064
clauses(Cs, Ts, Vs, Ctxt, Env, S1)
1388
case is_binary_switch(Cs, S1) of
1390
switch_binary_clauses(Cs, F, Vs, Ctxt, Env, S1);
1392
clauses(Cs, F, Vs, Ctxt, Env, S1)
1068
%% We check only the first clause to see what the degree of the
1069
%% corresponding switch expression should be. (I.e., we assume that we
1070
%% are given nice code that does not combine clauses with differing
1071
%% pattern degrees.)
1073
clauses_degree([C | _Cs]) ->
1074
length(cerl:clause_pats(C)).
1076
1397
%% Check if a list of clauses represents a switch over a number (more
1077
1398
%% than 1) of constants (atoms or integers/floats), or tuples (whose
1078
1399
%% elements are all variables)
1080
1401
is_constant_switch(Cs) ->
1081
is_switch(Cs, fun (P) -> (cerl:type(P) == literal) andalso
1402
is_switch(Cs, fun (P) -> (cerl:type(P) =:= literal) andalso
1082
1403
is_constant(cerl:concrete(P)) end).
1084
1405
is_tuple_switch(Cs) ->
1085
1406
is_switch(Cs, fun (P) -> cerl:is_c_tuple(P) andalso
1086
1407
all_vars(cerl:tuple_es(P)) end).
1409
is_binary_switch(Cs, S) ->
1410
case s__get_pmatch(S) of
1411
False when False =:= false; False =:= undefined ->
1413
Other when Other =:= duplicate_all; Other =:= no_duplicates; Other =:= true->
1414
is_binary_switch1(Cs, 0)
1417
is_binary_switch1([C|Cs], N) ->
1418
case cerl:clause_pats(C) of
1420
case cerl:is_c_binary(P) of
1422
is_binary_switch1(Cs, N + 1);
1424
if Cs =:= [], N > 0 ->
1425
%% The final clause may be a catch-all.
1426
cerl:type(P) =:= var;
1434
is_binary_switch1([], N) ->
1088
1437
all_vars([E | Es]) ->
1089
1438
case cerl:is_c_var(E) of
1090
1439
true -> all_vars(Es);
1114
1464
is_switch([], _F, N) ->
1117
is_simple_clause(C) ->
1118
case cerl:clause_pats(C) of
1120
G = cerl:clause_guard(C),
1121
case cerl_clauses:eval_guard(G) of
1122
{value, true} -> {true, P};
1128
switch_val_clauses(Cs, Ts, Vs, Ctxt, Env, S) ->
1129
switch_clauses(Cs, Ts, Vs, Ctxt, Env,
1467
switch_val_clauses(Cs, F, Vs, Ctxt, Env, S) ->
1468
switch_clauses(Cs, F, Vs, Ctxt, Env,
1130
1469
fun (P) -> cerl:concrete(P) end,
1131
1470
fun icode_switch_val/4,
1132
1471
fun val_clause_body/9,
1135
val_clause_body(_N, _V, C, Ts, Next, _Fail, Ctxt, Env, S) ->
1136
clause_body(C, Ts, Next, Ctxt, Env, S).
1474
val_clause_body(_N, _V, C, F, Next, _Fail, Ctxt, Env, S) ->
1475
clause_body(C, F, Next, Ctxt, Env, S).
1138
switch_tuple_clauses(Cs, Ts, Vs, Ctxt, Env, S) ->
1139
switch_clauses(Cs, Ts, Vs, Ctxt, Env,
1477
switch_tuple_clauses(Cs, F, Vs, Ctxt, Env, S) ->
1478
switch_clauses(Cs, F, Vs, Ctxt, Env,
1140
1479
fun (P) -> cerl:tuple_arity(P) end,
1141
1480
fun icode_switch_tuple_arity/4,
1142
1481
fun tuple_clause_body/9,
1145
tuple_clause_body(N, V, C, Ts, Next, Fail, Ctxt, Env, S0) ->
1484
tuple_clause_body(N, V, C, F, Next, Fail, Ctxt, Env, S0) ->
1146
1485
Vs = make_vars(N),
1147
1486
S1 = tuple_elements(Vs, V, S0),
1148
1487
Es = cerl:tuple_es(hd(cerl:clause_pats(C))),
1149
1488
{Env1, S2} = patterns(Es, Vs, Fail, Env, S1),
1150
clause_body(C, Ts, Next, Ctxt, Env1, S2).
1489
clause_body(C, F, Next, Ctxt, Env1, S2).
1152
switch_clauses(Cs, Ts, [V], Ctxt, Env, GetVal, Switch, Body, S0) ->
1491
switch_clauses(Cs, F, [V], Ctxt, Env, GetVal, Switch, Body, S0) ->
1153
1492
Cs1 = [switch_clause(C, GetVal) || C <- Cs],
1154
1493
Cases = [{V, L} || {V, L, _} <- Cs1],
1155
1494
Default = [C || {default, C} <- Cs1],
1156
1495
Fail = new_label(),
1157
1496
S1 = add_code([Switch(V, Fail, length(Cases), Cases)], S0),
1158
1497
Next = new_continuation_label(Ctxt),
1159
S2 = case Default of
1160
[] -> add_infinite_loop(Fail, S1);
1498
S3 = case Default of
1499
[] -> add_default_case(Fail, Ctxt, S1);
1162
clause_body(C, Ts, Next, Ctxt, Env,
1163
add_code([icode_label(Fail)], S1))
1501
%% Bind the catch-all variable (this always succeeds)
1502
{Env1, S2} = patterns(cerl:clause_pats(C), [V], Fail,
1504
clause_body(C, F, Next, Ctxt, Env1,
1505
add_code([icode_label(Fail)], S2))
1165
S3 = switch_cases(Cs1, V, Ts, Next, Fail, Ctxt, Env, Body, S2),
1166
add_continuation_label(Next, Ctxt, S3).
1507
S4 = switch_cases(Cs1, V, F, Next, Fail, Ctxt, Env, Body, S3),
1508
add_continuation_label(Next, Ctxt, S4).
1168
1510
switch_clause(C, F) ->
1169
1511
[P] = cerl:clause_pats(C),
1173
1515
_ -> {icode_const(F(P)), L, C}
1176
switch_cases([{N, L, C} | Cs], V, Ts, Next, Fail, Ctxt, Env, Body,
1518
switch_binary_clauses(Cs, F, Vs, Ctxt, Env, S) ->
1519
{Bins, Default} = get_binary_clauses(Cs),
1520
BMatch = cerl_binary_pattern_match:add_offset_to_bin(Bins),
1522
Next = new_continuation_label(Ctxt),
1523
S1 = binary_match(BMatch, F, Vs, Next, Fail, Ctxt, Env, S),
1524
S2 = case Default of
1525
[] -> add_default_case(Fail, Ctxt, S1);
1527
clause_body(C, F, Next, Ctxt, Env,
1528
add_code([icode_label(Fail)], S1))
1530
add_continuation_label(Next, Ctxt, S2).
1532
get_binary_clauses(Cs) ->
1533
get_binary_clauses(Cs, []).
1535
get_binary_clauses([C|Cs], Acc) ->
1536
[P] = cerl:clause_pats(C),
1537
case cerl:is_c_binary(P) of
1539
get_binary_clauses(Cs, [C|Acc]);
1541
{lists:reverse(Acc),[C]}
1543
get_binary_clauses([], Acc) ->
1544
{lists:reverse(Acc),[]}.
1546
switch_cases([{N, L, C} | Cs], V, F, Next, Fail, Ctxt, Env, Body, S0) ->
1178
1547
S1 = add_code([icode_label(L)], S0),
1179
S2 = Body(icode_const_val(N), V, C, Ts, Next, Fail, Ctxt, Env, S1),
1180
switch_cases(Cs, V, Ts, Next, Fail, Ctxt, Env, Body, S2);
1181
switch_cases([_ | Cs], V, Ts, Next, Fail, Ctxt, Env, Body, S) ->
1182
switch_cases(Cs, V, Ts, Next, Fail, Ctxt, Env, Body, S);
1183
switch_cases([], _V, _Ts, _Next, _Fail, _Ctxt, _Env, _Body, S) ->
1548
S2 = Body(icode_const_val(N), V, C, F, Next, Fail, Ctxt, Env, S1),
1549
switch_cases(Cs, V, F, Next, Fail, Ctxt, Env, Body, S2);
1550
switch_cases([_ | Cs], V, F, Next, Fail, Ctxt, Env, Body, S) ->
1551
switch_cases(Cs, V, F, Next, Fail, Ctxt, Env, Body, S);
1552
switch_cases([], _V, _F, _Next, _Fail, _Ctxt, _Env, _Body, S) ->
1186
%% The exact behaviour if all clauses fail is undefined; we generate
1187
%% code to keep the executing program in an infinite loop if this
1188
%% happens, which is safe and will not destroy information for later
1189
%% analyses. (We do not want to throw an arbitrary exception, and
1190
%% continuing execution after the `case', as in a C `switch' statement,
1191
%% would add a new possible path to the program, which could destroy
1192
%% program properties.) Recall that the `final' and `effect' context
1193
%% flags distribute over the clause bodies.
1555
%% Recall that the `final' and `effect' context flags distribute over
1556
%% the clause bodies.
1195
clauses(Cs, Ts, Vs, Ctxt, Env, S) ->
1558
clauses(Cs, F, Vs, Ctxt, Env, S) ->
1196
1559
Next = new_continuation_label(Ctxt),
1197
S1 = clauses_1(Cs, Ts, Vs, undefined, Next, Ctxt, Env, S),
1560
S1 = clauses_1(Cs, F, Vs, undefined, Next, Ctxt, Env, S),
1198
1561
add_continuation_label(Next, Ctxt, S1).
1200
clauses_1([C | Cs], Ts, Vs, Fail, Next, Ctxt, Env, S) ->
1563
clauses_1([C | Cs], F, Vs, Fail, Next, Ctxt, Env, S) ->
1201
1564
case cerl_clauses:is_catchall(C) of
1203
1566
%% The fail label will not actually be used in this case.
1204
clause(C, Ts, Vs, Fail, Next, Ctxt, Env, S);
1567
clause(C, F, Vs, Fail, Next, Ctxt, Env, S);
1206
1569
%% The previous `Fail' is not used here.
1207
1570
Fail1 = new_label(),
1208
S1 = clause(C, Ts, Vs, Fail1, Next, Ctxt, Env, S),
1571
S1 = clause(C, F, Vs, Fail1, Next, Ctxt, Env, S),
1209
1572
S2 = add_code([icode_label(Fail1)], S1),
1210
clauses_1(Cs, Ts, Vs, Fail1, Next, Ctxt, Env, S2)
1573
clauses_1(Cs, F, Vs, Fail1, Next, Ctxt, Env, S2)
1212
clauses_1([], _Ts, _Vs, Fail, _Next, _Ctxt, _Env, S) ->
1213
if Fail == undefined ->
1575
clauses_1([], _F, _Vs, Fail, _Next, Ctxt, _Env, S) ->
1576
if Fail =:= undefined ->
1214
1577
L = new_label(),
1215
add_infinite_loop(L, S);
1578
add_default_case(L, Ctxt, S);
1217
1580
add_code([icode_goto(Fail)], S) % use existing label
1220
add_infinite_loop(L, S) ->
1221
add_code([icode_label(L), icode_goto(L)], S).
1223
clause(C, Ts, Vs, Fail, Next, Ctxt, Env, S) ->
1583
%% The exact behaviour if all clauses fail is undefined; we generate an
1584
%% 'internal_error' exception if this happens, which is safe and will
1585
%% not get in the way of later analyses. (Continuing execution after the
1586
%% `case', as in a C `switch' statement, would add a new possible path
1587
%% to the program, which could destroy program properties.) Note that
1588
%% this code is only generated if some previous stage has created a
1589
%% switch over clauses without a final catch-all; this could be both
1590
%% legal and non-redundant, e.g. if the last clause does pattern
1591
%% matching to extract components of a (known) constructor. The
1592
%% generated default-case code *should* be unreachable, but we need it
1593
%% in order to have a safe fail-label.
1595
add_default_case(L, Ctxt, S) ->
1596
S1 = add_code([icode_label(L)], S),
1597
add_error(icode_const(internal_error), Ctxt, S1).
1599
clause(C, F, Vs, Fail, Next, Ctxt, Env, S) ->
1224
1600
G = cerl:clause_guard(C),
1225
1601
case cerl_clauses:eval_guard(G) of
1226
1602
{value, true} ->
1227
1603
{Env1, S1} = patterns(cerl:clause_pats(C), Vs, Fail, Env,
1229
clause_body(C, Ts, Next, Ctxt, Env1, S1);
1605
clause_body(C, F, Next, Ctxt, Env1, S1);
1230
1606
{value, false} ->
1231
1607
add_code([icode_goto(Fail)], S);
1374
1759
{bs_get_binary, NewUnit, Flags}
1376
S1= add_code([icode_guardop([V],{hipe_bs_primop, Name}, Args, L, Fail),
1377
icode_label(L)], S0),
1761
Primop = {hipe_bs_primop, Name},
1762
S1 = add_code([icode_guardop([V], Primop, Args, L, Fail),
1763
icode_label(L)], S0),
1378
1764
{pattern(T, V, Fail, Env, S1), NewAlign};
1379
1765
{all, NewAlign, S0} ->
1381
1767
Name = {bs_get_binary_all, Flags},
1382
S1= add_code([icode_guardop([V], {hipe_bs_primop, Name}, [], L, Fail),
1383
icode_label(L)], S0),
1768
Primop = {hipe_bs_primop, Name},
1769
S1 = add_code([icode_guardop([V], Primop, [], L, Fail),
1770
icode_label(L)], S0),
1384
1771
{pattern(T, V, Fail, Env, S1), NewAlign}
1774
%binary_pattern(P, V, Fail, Env, S) ->
1777
% Orig = make_var(),
1778
% OrigOffset = make_var(),
1779
% BinSize = make_var(),
1780
% State = {Orig, OrigOffset, BinSize},
1781
% {Size, NewBinSegs} = cerl_binary_pattern_match:add_offset_to_pattern(P),
1782
% Arity = length(NewBinSegs),
1783
% Vars = make_vars(Arity),
1784
% S1 = add_code([icode_guardop([Orig], {hipe_bsi_primop, bs_get_orig}, [V], L1, Fail),
1786
% icode_call_primop([OrigOffset], {hipe_bsi_primop, bs_get_orig_offset}, [V]),
1787
% icode_call_primop([BinSize], {hipe_bsi_primop, bs_get_size}, [V])], S),
1788
% S2 = translate_size_expr(Size, State, L2, Fail, Env, S1),
1789
% S3 = add_code([icode_label(L2)], S2),
1790
% bitstr_patterns(NewBinSegs, Vars, State, Fail, Env, S3).
1792
%bitstr_patterns([Seg|Rest], [T|Ts], State, Fail, Env, S) ->
1793
% {NewEnv, S1} = bitstr_pattern(Seg, T, State, Fail, Env, S),
1794
% bitstr_patterns(Rest, Ts, State, Fail, NewEnv, S1);
1796
%bitstr_patterns([], [], _State, _Fail, Env, S) ->
1799
%bitstr_pattern(P, V, State, Fail, Env, S) ->
1800
% T = cerl_binary_pattern_match:new_bitstr_val(P),
1801
% Size = cerl_binary_pattern_match:new_bitstr_size(P),
1802
% Offset = cerl_binary_pattern_match:new_bitstr_offset(P),
1803
% {LiteralType,LiteralFlags} = cerl_binary_pattern_match:new_bitstr_type(P),
1804
% Align = test_align(Offset),
1805
% Flags=translate_flags(LiteralFlags, Align),
1806
% Type = cerl:atom_val(LiteralType),
1807
% OffsetVar = make_var(),
1808
% OffsetConst = cerl_binary_pattern_match:size_const(Offset),
1810
% case type_of_size(Size) of
1816
% SizeVar = make_var(),
1817
% S0 = add_size_code(Size, SizeVar, Env, S),
1820
% S2 = add_offset_code(Offset, OffsetVar, Env, S1),
1821
% S3 = add_final_code(Type, V, SizeExpr, OffsetVar, OffsetConst, State, Flags, S2),
1822
% pattern(T, V, Fail, Env, S3).
1825
%% ---------------------------------------------------------------------
1826
%% Boolean expressions
1387
1828
%% This generates code for a boolean expression (such as "primop
1388
1829
%% 'and'(X, Y)") in a normal expression context, when an actual `true'
1389
%% or `false' value is to be computed.
1830
%% or `false' value is to be computed. We set up a default fail-label
1831
%% for generating a `badarg' error, unless we are in a guard.
1833
boolean_expr(E, [V], Ctxt=#ctxt{class = guard}, Env, S) ->
1834
{Code, True, False} = make_bool_glue(V),
1835
S1 = boolean(E, True, False, Ctxt, Env, S),
1391
1837
boolean_expr(E, [V] = Ts, Ctxt, Env, S) ->
1392
{Code, True, False} = make_bool_glue(V, true, false),
1393
Ctxt1 = Ctxt#ctxt{final = false},
1838
{Code, True, False} = make_bool_glue(V),
1840
Cont = new_continuation_label(Ctxt),
1841
Ctxt1 = Ctxt#ctxt{final = false, effect = false, fail = Fail},
1394
1842
S1 = boolean(E, True, False, Ctxt1, Env, S),
1395
maybe_return(Ts, Ctxt, add_code(Code, S1));
1843
S2 = maybe_return(Ts, Ctxt, add_code(Code, S1)),
1844
S3 = add_continuation_jump(Cont, Ctxt, S2),
1845
S4 = add_code([icode_label(Fail)], S3),
1846
S5 = add_error(icode_const(badarg), Ctxt, S4), % can add dummy label
1847
S6 = add_continuation_jump(Cont, Ctxt, S5), % avoid empty basic block
1848
add_continuation_label(Cont, Ctxt, S6);
1396
1849
boolean_expr(_, [], _Ctxt, _Env, _S) ->
1397
1850
error_high_degree(),
1400
1853
error_low_degree(),
1403
%% This generates jumping code for booleans, but does not generally use
1404
%% shortcuts for logical operators, unless the expression is "safe"
1405
%% (i.e., has no side effects and cannot fail), or we are in guard
1406
%% context; otherwise, we set a flag to be checked if necessary after
1407
%% both branches have been evaluated. Note that since subexpressions are
1408
%% checked repeatedly to see if they are safe, etc., this is really
1409
%% quadratic, but I don't expect booleans to be very deeply nested.
1411
%% TODO: use a pre-pass instead to annotate expressions as safe.
1413
boolean(E, True, False, Ctxt, Env, S) ->
1414
case Ctxt#ctxt.class of
1416
pure_boolean(E, True, False, Ctxt, Env, S);
1418
case is_safe_expr(E) of
1856
%% This is for when we expect a boolean result in jumping code context,
1857
%% but are not sure what the expression will produce, or we know that
1858
%% the result is not a boolean and we just want error handling.
1860
expect_boolean_value(E, True, False, Ctxt, Env, S) ->
1862
S1 = expr(E, [V], Ctxt#ctxt{final = false}, Env, S),
1863
case Ctxt#ctxt.fail of
1865
%% No fail-label set - this means we are *sure* that the
1866
%% result can only be 'true' or 'false'.
1867
add_code([make_type([V], ?TYPE_ATOM(true), True, False)],
1871
add_code([make_type([V], ?TYPE_ATOM(true), True, Next),
1873
make_type([V], ?TYPE_ATOM(false), False, Fail)],
1877
%% This generates code for a case-switch with exactly one 'true' branch
1878
%% and one 'false' branch, and no other branches (not even a catch-all).
1879
%% Note that E must be guaranteed to produce a boolean value for such a
1880
%% switch to have been generated.
1882
bool_switch(E, TrueExpr, FalseExpr, F, Ctxt, Env, S) ->
1883
Cont = new_continuation_label(Ctxt),
1885
False = new_label(),
1886
Ctxt1 = Ctxt#ctxt{final = false, effect = false},
1887
S1 = boolean(E, True, False, Ctxt1, Env, S),
1888
S2 = add_code([icode_label(True)], S1),
1889
S3 = F(TrueExpr, Ctxt, Env, S2),
1890
S4 = add_continuation_jump(Cont, Ctxt, S3),
1891
S5 = add_code([icode_label(False)], S4),
1892
S6 = F(FalseExpr, Ctxt, Env, S5),
1893
add_continuation_label(Cont, Ctxt, S6).
1895
%% This generates jumping code for booleans. If the fail-label is set,
1896
%% it tells where to go in case a value turns out not to be a boolean.
1898
%% In strict boolean expressions, we set a flag to be checked if
1899
%% necessary after both branches have been evaluated. An alternative
1900
%% would be to duplicate the code for the second argument, for each
1901
%% value ('true' or 'false') of the first argument.
1903
%% (Note that subexpressions are checked repeatedly to see if they are
1904
%% safe - this is quadratic, but I don't expect booleans to be very
1907
%% Note that 'and', 'or' and 'xor' are strict (like all primops)!
1909
boolean(E0, True, False, Ctxt, Env, S) ->
1910
E = cerl_lib:reduce_expr(E0),
1911
case cerl:type(E) of
1913
case cerl:concrete(E) of
1420
safe_boolean(E, True, False, Ctxt, Env, S);
1915
add_code([icode_goto(True)], S);
1422
generic_boolean(E, True, False, Ctxt, Env, S)
1426
%% Note that 'and' and 'or' are strict! Unless we know more about their
1427
%% subexpressions, we must evaluate both branches.
1429
generic_boolean(E0, True, False, Ctxt, Env, S) ->
1430
E = reduce_expr(E0),
1431
case cerl:type(E) of
1917
add_code([icode_goto(False)], S);
1919
expect_boolean_value(E, True, False, Ctxt, Env, S)
1922
case cerl:values_es(E) of
1924
boolean(E1, True, False, Ctxt, Env, S);
1926
error_msg("degree mismatch - expected boolean: ~P",
1433
1931
Name = cerl:atom_val(cerl:primop_name(E)),
1434
1932
As = cerl:primop_args(E),
1435
1933
Arity = length(As),
1436
1934
case {Name, Arity} of
1437
1935
{?PRIMOP_NOT, 1} ->
1936
%% `not' simply switches true and false labels.
1439
1938
boolean(A, False, True, Ctxt, Env, S);
1440
1939
{?PRIMOP_AND, 2} ->
1443
{Glue, True1, False1} =
1444
make_bool_glue(V, ?BOOL_TRUE, ?BOOL_FALSE),
1445
S1 = boolean(A, True1, False1, Ctxt, Env, S),
1446
S2 = add_code(Glue, S1),
1448
S3 = boolean(B, Test, False, Ctxt, Env, S2),
1449
add_code([icode_label(Test),
1450
make_type(V, ?BOOL_IS_FALSE,
1940
strict_and(As, True, False, Ctxt, Env, S);
1453
1941
{?PRIMOP_OR, 2} ->
1456
{Glue, True1, False1} =
1457
make_bool_glue(V, ?BOOL_TRUE, ?BOOL_FALSE),
1458
S1 = boolean(A, True1, False1, Ctxt, Env, S),
1459
S2 = add_code(Glue, S1),
1461
S3 = boolean(B, True, Test, Ctxt, Env, S2),
1462
add_code([icode_label(Test),
1463
make_type(V, ?BOOL_IS_FALSE,
1942
strict_or(As, True, False, Ctxt, Env, S);
1944
%% `xor' always needs to evaluate both arguments
1945
strict_xor(As, True, False, Ctxt, Env, S);
1467
1947
case is_comp_op(Name, Arity) of
1474
1954
type_test(Name, As, True, False,
1477
other_boolean(E, True, False, Ctxt,
1957
expect_boolean_value(E, True, False,
1483
case cerl:concrete(E) of
1485
add_code([icode_goto(True)], S);
1487
add_code([icode_goto(False)], S);
1489
error_msg("not a boolean value: ~P.", [X, 5]),
1493
case cerl:values_es(E) of
1495
boolean(E1, True, False, Ctxt, Env, S);
1497
error_msg("degree mismatch - expected boolean: ~P",
1963
%% Propagate boolean handling into clause bodies.
1964
%% (Note that case switches assume fallthrough code in the
1965
%% clause bodies, so we must add a dummy label as needed.)
1966
F = fun (B, Ctxt, Env, S) ->
1967
S1 = boolean(B, True, False, Ctxt, Env, S),
1968
add_new_continuation_label(Ctxt, S1)
1970
S1 = expr_case_1(E, F, Ctxt, Env, S),
1971
%% Add a final goto if necessary, to compensate for the
1972
%% final continuation label of the case-expression. This
1973
%% should be unreachable, so the value does not matter.
1974
add_continuation_jump(False, Ctxt, S1);
1502
%% Cf. 'expr_seq(...)'.
1503
Ctxt1 = Ctxt#ctxt{effect = true, final = false},
1504
S1 = expr(cerl:seq_arg(E), [], Ctxt1, Env, S),
1505
boolean(cerl:seq_body(E), True, False, Ctxt, Env, S1);
1976
%% Propagate boolean handling into body.
1977
F = fun (B, Ctxt, Env, S) ->
1978
boolean(B, True, False, Ctxt, Env, S)
1980
expr_seq_1(E, F, Ctxt, Env, S);
1507
%% Note that we have called 'reduce_expr' above.
1508
Vars = cerl:let_vars(E),
1509
Vs = make_vars(length(Vars)),
1510
S1 = expr(cerl:let_arg(E), Vs,
1511
Ctxt#ctxt{effect = false, final = false}, Env, S),
1512
Env1 = bind_vars(Vars, Vs, Env),
1513
B = cerl:let_body(E),
1514
boolean(B, True, False, Ctxt, Env1, S1);
1982
%% Propagate boolean handling into body. Note that we have
1983
%% called 'cerl_lib:reduce_expr/1' above.
1984
F = fun (B, Ctxt, Env, S) ->
1985
boolean(B, True, False, Ctxt, Env, S)
1987
expr_let_1(E, F, Ctxt, Env, S);
1989
case Ctxt#ctxt.class of
1991
%% This *must* be a "protected" guard expression on
1992
%% the form "try E of X -> X catch <...> -> 'false'"
1993
%% (we could of course test if the handler body is
1994
%% the atom 'false', etc.).
1995
Ctxt1 = Ctxt#ctxt{fail = False},
1996
boolean(cerl:try_arg(E), True, False, Ctxt1, Env,
1999
%% Propagate boolean handling into the handler and body
2000
%% (see propagation into case switches for comparison)
2001
F = fun (B, Ctxt, Env, S) ->
2002
boolean(B, True, False, Ctxt, Env, S)
2004
S1 = expr_try_1(E, F, Ctxt, Env, S),
2005
add_continuation_jump(False, Ctxt, S1)
1516
2008
%% This handles everything else, including cases that are
1517
2009
%% known to not return a boolean.
1518
other_boolean(E, True, False, Ctxt, Env, S)
1521
%% This is for when we expect a boolean result, but are not sure what
1522
%% the expression will produce, or we know that the result is not a
1523
%% boolean and we just want the error handling.
1525
other_boolean(E, True, False, Ctxt, Env, S) ->
1527
S1 = expr(E, [V], Ctxt#ctxt{final = false}, Env, S),
1529
S2 = add_code([make_type(V, ?TYPE_ATOM(true), True, L1),
1532
case Ctxt#ctxt.class of
1534
add_code([make_type(V, ?TYPE_ATOM(false), False,
1539
S3 = add_code([make_type(V, ?TYPE_ATOM(false), False, L2),
1540
icode_label(L2)], S2),
1541
add_exit(icode_const(error), Ctxt, S3)
1544
%% This generates jumping code for boolean expressions where no
1545
%% subexpression can have side effects *and* no subexpression can fail.
1547
safe_boolean(E0, True, False, Ctxt, Env, S) ->
1548
E = reduce_expr(E0),
1549
case cerl:type(E) of
1551
Name = cerl:atom_val(cerl:primop_name(E)),
1552
As = cerl:primop_args(E),
1554
case {Name, Arity} of
1558
S1 = safe_boolean(A, Next, False, Ctxt, Env,
1560
S2 = add_code([icode_label(Next)], S1),
1561
safe_boolean(B, True, False, Ctxt, Env, S2);
1565
S1 = safe_boolean(A, True, Next, Ctxt, Env,
1567
S2 = add_code([icode_label(Next)], S1),
1568
safe_boolean(B, True, False, Ctxt, Env, S2);
1570
generic_boolean(E, True, False, Ctxt, Env, S)
1573
safe_boolean(cerl:seq_body(E), True, False, Ctxt, Env, S);
1575
safe_boolean(cerl:try_arg(E), True, False, Ctxt, Env, S);
1577
safe_boolean(cerl:catch_body(E), True, False, Ctxt, Env, S);
1579
generic_boolean(E, True, False, Ctxt, Env, S)
1582
%% This generates jumping code for boolean expressions where no
1583
%% subexpression can have side effects (as e.g. in a clause guard),
1584
%% *but* subexpressions might fail.
1586
pure_boolean(E, True, False, Ctxt, Env, S) ->
1587
case is_safe_expr(E) of
1589
safe_boolean(E, True, False, Ctxt, Env, S);
1591
unsafe_pure_boolean(E, True, False, Ctxt, Env, S)
1594
unsafe_pure_boolean(E0, True, False, Ctxt, Env, S) ->
1595
E = reduce_expr(E0),
1596
case cerl:type(E) of
1598
Name = cerl:atom_val(cerl:primop_name(E)),
1599
As = cerl:primop_args(E),
1601
case {Name, Arity} of
1603
%% Done as in the "safe" case:
1606
S1 = pure_boolean(A, Next, False, Ctxt, Env,
1608
S2 = add_code([icode_label(Next)], S1),
1609
pure_boolean(B, True, False, Ctxt, Env, S2);
1611
%% This is done as in the generic case: since the
1612
%% second argument might crash, it must be evaluated
1613
%% even if the first yields `true'.
1616
{Glue, True1, False1} =
1617
make_bool_glue(V, ?BOOL_TRUE, ?BOOL_FALSE),
1618
S1 = pure_boolean(A, True1, False1, Ctxt, Env,
1620
S2 = add_code(Glue, S1),
1622
S3 = pure_boolean(B, True, Test, Ctxt, Env,
1624
add_code([icode_label(Test),
1625
make_type(V, ?BOOL_IS_FALSE,
1629
generic_boolean(E, True, False, Ctxt, Env, S)
1632
case Ctxt#ctxt.class of
1634
%% This should be a "protected" guard expression on
1635
%% the form "try E of X -> X catch <T,R> -> 'false'"
1636
%% but we don't actually check for this.
1637
Ctxt1 = Ctxt#ctxt{fail = False, class = guard},
1638
boolean(cerl:try_arg(E), True, False, Ctxt1, Env, S);
1640
generic_boolean(E, True, False, Ctxt, Env, S)
1643
generic_boolean(E, True, False, Ctxt, Env, S)
2010
expect_boolean_value(E, True, False, Ctxt, Env, S)
2013
strict_and([A, B], True, False, Ctxt, Env, S) ->
2015
{Glue, True1, False1} = make_bool_glue(V),
2016
S1 = boolean(A, True1, False1, Ctxt, Env, S),
2017
S2 = add_code(Glue, S1),
2019
S3 = boolean(B, Test, False, Ctxt, Env, S2),
2020
add_code([icode_label(Test),
2021
make_bool_test(V, True, False)],
2024
strict_or([A, B], True, False, Ctxt, Env, S) ->
2026
{Glue, True1, False1} = make_bool_glue(V),
2027
S1 = boolean(A, True1, False1, Ctxt, Env, S),
2028
S2 = add_code(Glue, S1),
2030
S3 = boolean(B, True, Test, Ctxt, Env, S2),
2031
add_code([icode_label(Test),
2032
make_bool_test(V, True, False)],
2035
strict_xor([A, B], True, False, Ctxt, Env, S) ->
2037
{Glue, True1, False1} = make_bool_glue(V),
2038
S1 = boolean(A, True1, False1, Ctxt, Env, S),
2039
S2 = add_code(Glue, S1),
2040
Test1 = new_label(),
2041
Test2 = new_label(),
2042
S3 = boolean(B, Test1, Test2, Ctxt, Env, S2),
2043
add_code([icode_label(Test1),
2044
make_bool_test(V, False, True),
2046
make_bool_test(V, True, False)],
1646
2049
%% Primitive comparison operations are inline expanded as conditional
1647
2050
%% branches when part of a boolean expression, rather than made into
1648
%% primop or guardop calls. Without type information, however, we cannot
1649
%% reduce comparisons `Expr == true' to simply `Expr' (and `Expr ==
1650
%% false' to `not Expr'), because we are not sure that Expr will yield a
1651
%% boolean - and if it does not, the result should be `false', not a
2051
%% primop or guardop calls. Note that Without type information, we
2052
%% cannot reduce equality tests like `Expr == true' to simply `Expr'
2053
%% (and `Expr == false' to `not Expr'), because we are not sure that
2054
%% Expr will yield a boolean - if it does not, the result of the
2055
%% comparison should be `false'.
1654
2057
comparison(Name, As, True, False, Ctxt, Env, S) ->
1655
2058
{Vs, S1} = expr_list(As, Ctxt, Env, S),
1835
2321
make_type(_, _, Label, Label) ->
1836
2322
icode_goto(Label);
1837
make_type(V, Test, True, False) ->
1838
icode_type(V, Test, True, False).
2323
make_type(Vs, Test, True, False) ->
2324
icode_type(Vs, Test, True, False).
1840
2326
%% Creating glue code with true/false target labels for assigning a
1841
%% corresponding 'true'/'false' value to a specific variable.
2327
%% corresponding 'true'/'false' value to a specific variable. Used as
2328
%% glue between boolean jumping code and boolean values.
2330
make_bool_glue(V) ->
2331
make_bool_glue(V, true, false).
1843
2333
make_bool_glue(V, T, F) ->
1844
2334
False = new_label(),
1845
2335
True = new_label(),
1846
2336
Next = new_label(),
1847
2337
Code = [icode_label(False),
1848
icode_mov(V, icode_const(F)),
2338
icode_move(V, icode_const(F)),
1849
2339
icode_goto(Next),
1850
2340
icode_label(True),
1851
icode_mov(V, icode_const(T)),
2341
icode_move(V, icode_const(T)),
1852
2342
icode_label(Next)],
1853
2343
{Code, True, False}.
1855
add_local_call({Name, _Arity} = Id, Vs, Ts, Ctxt, S, DstType) ->
1856
Module = s__get_module(S),
1857
case Ctxt#ctxt.final of
1859
add_code([icode_call_local(Ts, Module, Name, Vs, DstType)],S);
1861
Self = s__get_function(S),
1863
%% Tail-recursive call to same function.
1864
{Label, Vs1} = s__get_local_entry(S),
1865
add_code(make_moves(Vs1, Vs) ++
1866
[icode_goto(Label)],
1869
add_code([icode_enter_local(Module, Name, Vs)], S)
1873
%% In order to expose otherwise hidden cases of final expressions
1874
%% (enabling last call optimization), and other cases when we want to
1875
%% examine the type of some subexpression, we first try to remove all
1876
%% trivial let-bindings (`let X = Y in X', `let X = Y in Y', `let X = Y
1877
%% in let ... in ...', `let X = let ... in ... in ...', etc.), We do
1878
%% not, however, try to recognize any other similar cases, even for
1879
%% simple `case'-expressions like `case E of X -> X end'. Nor do we try
1880
%% to optimize uses of multiple-value aggregates of other degree than 1.
1883
case cerl:type(E) of
1885
case cerl:values_es(E) of
1892
%% We give up if the body does not reduce to a single
1893
%% variable. This is not a generic copy propagation.
1894
B = reduce_expr(cerl:let_body(E)),
1895
Vs = cerl:let_vars(E),
1896
case cerl:is_c_var(B) of
1897
true when length(Vs) == 1 ->
1898
%% We have `let <V1> = <E> in <V2>':
1899
A = cerl:let_arg(E),
1901
case cerl:var_name(V) =:= cerl:var_name(B) of
1903
%% `let X = <E> in X' equals `<E>'
1906
%% `let X = <E> in Y' is equivalent to `Y'
1907
%% if and only if `<E>' is "safe"; otherwise
1908
%% it is eqivalent to `do <E> Y'.
1909
case is_safe_expr(A) of
1913
cerl:update_c_seq(E, A, B)
1917
cerl:update_c_let(E, Vs, cerl:let_arg(E), B)
1923
%% Return `true' if `Node' represents a "safe" Core Erlang expression,
1924
%% otherwise `false'. An expression is safe if it always completes
1925
%% normally and does not modify the state (although the value it yields
1926
%% might depend on the state). Expressions of type `apply', `call',
1927
%% `case' and `receive' are always considered unsafe by this function.
1928
%% For `try' (and `catch'), it would really suffice to check if the
1929
%% guarded expression is a pure (albeit possibly unsafe) function to
1930
%% deduce whether it is safe, but then we'd have to write a separate
1931
%% function for that, so we don't bother to.
2345
make_bool_test(V, True, False) ->
2346
make_type([V], ?TYPE_ATOM(true), True, False).
2348
%% Checking if an expression is safe
1933
2350
is_safe_expr(E) ->
1934
case cerl:type(E) of
1942
is_safe_expr_list(cerl:values_es(E));
1944
is_safe_expr_list(cerl:tuple_es(E));
1946
case is_safe_expr(cerl:cons_hd(E)) of
1948
is_safe_expr(cerl:cons_tl(E));
1953
case is_safe_expr(cerl:let_arg(E)) of
1955
is_safe_expr(cerl:let_body(E));
1960
case is_safe_expr(cerl:seq_arg(E)) of
1962
is_safe_expr(cerl:seq_body(E));
1967
%% If the guarded expression is safe, the try-handler
1968
%% will never be evaluated, so we need not check it.
1969
case is_safe_expr(cerl:try_arg(E)) of
1971
is_safe_expr(cerl:try_body(E));
1976
is_safe_expr(cerl:catch_body(E));
1978
is_safe_expr(cerl:letrec_body(E));
1980
Name = cerl:atom_val(cerl:primop_name(E)),
1981
As = cerl:primop_args(E),
1982
case is_safe_op(Name, length(As)) of
1984
is_safe_expr_list(As);
2351
cerl_lib:is_safe_expr(E, fun function_check/2).
1992
is_safe_expr_list([E | Es]) ->
1993
case is_safe_expr(E) of
1995
is_safe_expr_list(Es);
1999
is_safe_expr_list([]) ->
2353
function_check(safe, {Name, Arity}) ->
2354
is_safe_op(Name, Arity);
2355
function_check(safe, {Module, Name, Arity}) ->
2356
erl_bifs:is_safe(Module, Name, Arity);
2357
function_check(pure, {Name, Arity}) ->
2358
is_pure_op(Name, Arity);
2359
function_check(pure, {Module, Name, Arity}) ->
2360
erl_bifs:is_pure(Module, Name, Arity);
2361
function_check(_, _) ->
2002
2364
%% There are very few really safe operations (sigh!). If we have type
2003
2365
%% information, several operations could be rewritten into specialized
2004
%% safe versions, such as '+'/2 -> add_integer/2 (which is safe).
2366
%% safe versions, such as '+'/2 -> add_integer/2.
2006
is_safe_op(?PRIMOP_IDENTITY, 1) -> true;
2007
2368
is_safe_op(N, A) ->
2008
2369
case is_comp_op(N, A) of
2306
2777
info_msg(S, Vs) ->
2307
2778
error_logger:info_msg(lists:concat([?MODULE, ": ", S, "\n"]), Vs).
2781
%% --------------------------------------------------------------------------
2784
binary_match(BMatch, F, Vs, Next, Fail, Ctxt, Env, S) ->
2786
Tree = cerl_binary_pattern_match:binary_match_clause_tree(BMatch),
2787
MTag = cerl_binary_pattern_match:binary_match_max_tag(BMatch),
2788
VarList = make_vars(MTag),
2790
OrigOffset = make_var(),
2793
S1 = add_code([icode_guardop([Orig], {hipe_bsi_primop, bs_get_orig}, Vs, L1, Fail),
2795
icode_call_primop([OrigOffset], {hipe_bsi_primop, bs_get_orig_offset}, Vs),
2796
icode_call_primop([Size], {hipe_bsi_primop, bs_get_size}, Vs)], S),
2797
{S2, _MState0} = clause_tree(Tree, VarList, F, {Orig, OrigOffset, Size}, Next, Fail, MState, Ctxt, Env, S1),
2800
clause_tree([], _VarList, _F, _State, _Next, Fail, MState, _Ctxt, _Env, S) ->
2801
{add_code([icode_goto(Fail)], S), MState};
2802
clause_tree(CTree, VarList, F, State, Next, Fail, MState, Ctxt, Env, S) ->
2803
Instr = cerl_binary_pattern_match:clause_tree_instr(CTree),
2804
NextTree = cerl_binary_pattern_match:clause_tree_success(CTree),
2805
FailTree = cerl_binary_pattern_match:clause_tree_fail(CTree),
2806
case cerl_binary_pattern_match:instr_type(Instr) of
2808
read_seg(Instr, NextTree, VarList, F, State, Next, Fail, MState, Ctxt, Env, S);
2810
bin_guard(Instr, NextTree, FailTree, VarList, F, State, Next, Fail, MState, Ctxt, Env, S);
2812
do_size(Instr, NextTree, FailTree, VarList, F, State, Next, Fail, MState, Ctxt, Env, S);
2814
do_match(Instr, NextTree, FailTree, VarList, F, State, Next, Fail, MState,Ctxt, Env, S);
2816
do_label(Instr, NextTree, VarList, F, State, Next, Fail, MState,Ctxt, Env, S);
2818
do_goto(Instr, MState, S);
2820
do_match_group(Instr, NextTree, FailTree, VarList, F, State, Next, Fail, MState,Ctxt, Env, S)
2823
read_seg(Instr, NextTree, VarList, F, State, Next, Fail, MState, Ctxt, Env, S) ->
2824
S1 = translate_binseg(Instr, VarList, State, Env, S),
2825
clause_tree(NextTree, VarList, F, State, Next, Fail, MState, Ctxt, Env, S1).
2827
bin_guard(Instr, Body, FailTree, VarList, F, State, Next, Fail, MState, Ctxt, Env, S) ->
2828
LabelPrimop = cerl_binary_pattern_match:bin_guard_label(Instr),
2829
Ref = translate_label_primop(LabelPrimop),
2830
{FL,S1} = s__get_label(Ref, S),
2831
{Env1, S2} = translate_bin_guard(Instr, VarList, Env, S1),
2832
S3 = F(Body, Ctxt, Env1, S2),
2833
S4 = add_continuation_jump(Next, Ctxt, S3),
2834
S5 = add_code([icode_label(FL)], S4),
2835
clause_tree(FailTree, VarList, F, State, Next, Fail, MState, Ctxt, Env, S5).
2837
do_size(Instr, NextTree, FailTree, VarList, F, State, Next, Fail, MState, Ctxt, Env, S) ->
2840
S1 = translate_size_expr(Instr, State, VarList, SL, FL, Env, S),
2841
S2 = add_code([icode_label(SL)], S1),
2842
{S3, MState1} = clause_tree(NextTree, VarList, F, State, Next, Fail, MState, Ctxt, Env, S2),
2843
S4 = add_code([icode_label(FL)], S3),
2844
clause_tree(FailTree, VarList, F, State, Next, Fail, MState1, Ctxt, Env, S4).
2846
do_match(Instr, NextTree, FailTree, VarList, F, State, Next, Fail, MState, Ctxt, Env, S) ->
2849
S1 = translate_match(Instr, VarList, SL, FL, S),
2850
S2 = add_code([icode_label(SL)], S1),
2851
{S3, MState1} = clause_tree(NextTree, VarList, F, State, Next, Fail, MState, Ctxt, Env, S2),
2852
S4 = add_code([icode_label(FL)], S3),
2853
clause_tree(FailTree, VarList, F, State, Next, Fail, MState1, Ctxt, Env, S4).
2855
do_match_group(Instr, NextTree, FailTree, VarList, F, State, Next, Fail, MState, Ctxt, Env, S) ->
2856
ValList = cerl_binary_pattern_match:match_group_vals(Instr),
2857
Tag = cerl_binary_pattern_match:match_group_tag(Instr),
2859
FullCases = [{Val,{translate_value(Val),new_label()}} || Val<-ValList, is_ok_val(Val)],
2860
Length = length(FullCases),
2861
Cases = [Case || {_, Case} <- FullCases],
2862
ResVar = get_resvar(Tag, VarList),
2863
S1 = add_code([icode_switch_val(ResVar,FL,Length,Cases)], S),
2864
do_cases(FullCases, NextTree, FailTree, FL, VarList, F, State, Next, Fail, MState, Ctxt, Env, S1).
2866
do_cases([{Value,{_, Label}}|Rest], NextTree, FailTree, FL, VarList, F, State,
2867
Next, Fail, MState, Ctxt, Env, S) ->
2868
{value, ClauseTree} = gb_trees:lookup(Value, NextTree),
2869
S1 = add_code([icode_label(Label)], S),
2870
{S2, MState1} = clause_tree(ClauseTree, VarList, F, State, Next, Fail, MState, Ctxt, Env, S1),
2871
do_cases(Rest, NextTree, FailTree, FL, VarList, F, State, Next, Fail, MState1, Ctxt, Env, S2);
2872
do_cases([], _NextTree, FailTree, FL, VarList, F, State, Next, Fail, MState, Ctxt, Env, S) ->
2873
S1 = add_code([icode_label(FL)], S),
2874
clause_tree(FailTree, VarList, F, State, Next, Fail, MState, Ctxt, Env, S1).
2876
do_label(Instr, NextTree, VarList, F, State, Next, Fail, MState, Ctxt, Env, S) ->
2877
LabelAlias = cerl_binary_pattern_match:label_name(Instr),
2878
{Label, MState1} = get_correct_label(LabelAlias, MState),
2879
S1 = add_code([icode_goto(Label),icode_label(Label)], S),
2880
clause_tree(NextTree, VarList, F, State, Next, Fail, MState1, Ctxt, Env, S1).
2882
do_goto(Instr, MState, S) ->
2883
LabelAlias = cerl_binary_pattern_match:goto_label(Instr),
2884
{Label, MState1} = get_correct_label(LabelAlias, MState),
2885
S1 = add_code([icode_goto(Label)], S),
2888
translate_binseg(Instr, VarList, State, Env, S) ->
2889
Size = cerl_binary_pattern_match:read_seg_size(Instr),
2890
Offset = cerl_binary_pattern_match:read_seg_offset(Instr),
2891
{LiteralType,LiteralFlags} = cerl_binary_pattern_match:read_seg_type(Instr),
2892
V = cerl_binary_pattern_match:read_seg_tag(Instr),
2893
ResVar = get_resvar(V, VarList),
2894
Align = test_align(Offset),
2895
Flags = translate_flags(LiteralFlags, Align),
2896
Type = cerl:atom_val(LiteralType),
2897
OffsetVar = make_var(),
2898
OffsetConst = cerl_binary_pattern_match:size_const(Offset),
2900
case type_of_size(Size) of
2906
SizeVar = make_var(),
2907
S0 = add_size_code(Size, SizeVar, VarList, Env, S),
2910
S2 = add_offset_code(Offset, OffsetVar, VarList, Env, S1),
2911
add_final_code(Type, ResVar, SizeExpr, OffsetVar, OffsetConst, State, Flags, S2).
2913
translate_value(Val) ->
2914
icode_const(cerl:concrete(Val)).
2917
case cerl:concrete(Val) of
2918
X when is_number(X) -> % is_integer(X) or is_number(X)
2924
translate_match(Instr, VarList, SL, FL, S) ->
2925
Val = cerl_binary_pattern_match:match_val(Instr),
2926
V = cerl_binary_pattern_match:match_tag(Instr),
2927
ResVar = get_resvar(V, VarList),
2928
case cerl:concrete(Val) of
2929
X when is_integer(X) ->
2930
add_code([make_type([ResVar], ?TYPE_INTEGER(X), SL, FL)], S);
2931
X when is_float(X) ->
2934
%% First doing an "is_float" test here might allow later
2935
%% stages to use a specialized equality test.
2936
add_code([make_type([ResVar], ?TYPE_IS_FLOAT, L, FL),
2938
icode_move(V1, icode_const(X)),
2939
make_if(?TEST_EQ, [ResVar, V1], SL, FL)],
2942
%% If the constant is not a float nor an integer
2943
%% The match can not succeed
2944
add_code([icode_goto(FL)], S)
2947
translate_size_expr(Instr, {_,_,BinSize}, VarList, SL, FL, Env, S) ->
2948
SizeVar = make_var(),
2949
All = cerl_binary_pattern_match:size_all(Instr),
2950
S1 = add_size_exp_code(Instr, SizeVar, VarList, FL, Env, S),
2951
S2 = test_eight_div(SizeVar, FL, S1),
2952
test_size(SizeVar, BinSize, All, SL, FL, S2).
2954
add_final_code(integer, ResVar, SizeExpr, OffsetVar, OffsetConst,
2955
{Orig, OrigOffset, _}, Flags, S) ->
2956
Offset = cerl:int_val(OffsetConst),
2957
case cerl:is_c_int(SizeExpr) of
2959
Size = cerl:int_val(SizeExpr),
2960
add_code([icode_call_primop([ResVar], {hipe_bsi_primop, {bs_get_integer, Size, Offset, Flags}},
2961
[OffsetVar, Orig, OrigOffset])], S);
2963
add_code([icode_call_primop([ResVar], {hipe_bsi_primop, {bs_get_integer, Offset, Flags}},
2964
[SizeExpr, OffsetVar, Orig, OrigOffset])], S)
2967
add_final_code(float, ResVar, SizeExpr, OffsetVar, OffsetConst,
2968
{Orig, OrigOffset, _}, Flags, S) ->
2969
Offset = cerl:int_val(OffsetConst),
2970
case cerl:is_c_int(SizeExpr) of
2972
Size = cerl:int_val(SizeExpr),
2973
add_code([icode_call_primop([ResVar], {hipe_bsi_primop, {bs_get_float, Size, Offset, Flags}},
2974
[OffsetVar, Orig, OrigOffset])], S);
2976
add_code([icode_call_primop([ResVar], {hipe_bsi_primop, {bs_get_float, Offset, Flags}},
2977
[SizeExpr, OffsetVar, Orig, OrigOffset])], S)
2980
add_final_code(binary, ResVar, SizeExpr, OffsetVar, OffsetConst,
2981
{Orig, OrigOffset, BinSize}, Flags, S) ->
2982
Offset = cerl:int_val(OffsetConst),
2983
case type_of_size(SizeExpr) of
2985
Size = cerl:int_val(SizeExpr),
2986
add_code([icode_call_primop([ResVar], {hipe_bsi_primop, {bs_get_binary, Size, Offset, Flags}},
2987
[OffsetVar, Orig, OrigOffset])], S);
2989
add_code([icode_call_primop([ResVar], {hipe_bsi_primop, {bs_get_binary_all, Offset, Flags}},
2990
[OffsetVar, Orig, OrigOffset, BinSize])], S);
2992
add_code([icode_call_primop([ResVar], {hipe_bsi_primop, {bs_get_binary, Offset, Flags}},
2993
[SizeExpr, OffsetVar, Orig, OrigOffset])], S)
2997
type_of_size(Size) ->
2998
case cerl:is_c_int(Size) of
3002
{SizeExpr, _Unit} = Size,
3003
case cerl:is_c_atom(SizeExpr) of
3011
add_size_code({{tag,Tag}, Unit}, SizeVar, VarList, _Env, S) ->
3012
UnitVal = cerl:int_val(Unit),
3013
NewSize = get_resvar(Tag, VarList),
3014
add_code([icode_call_primop([SizeVar],
3015
{hipe_bsi_primop, {bs_make_size, UnitVal}},
3017
add_size_code({Size, Unit}, SizeVar, _VarList, Env, S) ->
3018
NewSize = make_var(),
3019
UnitVal = cerl:int_val(Unit),
3020
S1 = expr(Size, [NewSize], #ctxt{final=false}, Env, S),
3021
add_code([icode_call_primop([SizeVar],
3022
{hipe_bsi_primop, {bs_make_size, UnitVal}},
3024
add_offset_code([{{tag,Tag}, Unit}|Rest], OffsetVar, VarList, Env, S) ->
3026
NewSize = get_resvar(Tag, VarList),
3027
UnitVal = cerl:int_val(Unit),
3028
Code = [icode_call_primop([Temp],
3029
{hipe_bsi_primop, {bs_make_size, UnitVal}},
3031
icode_call_primop([OffsetVar], '+', [OffsetVar, Temp])],
3032
add_offset_code(Rest, OffsetVar, VarList, Env, add_code(Code, S));
3033
add_offset_code([{Size, Unit}|Rest], OffsetVar, VarList, Env, S) ->
3035
NewSize = make_var(),
3036
UnitVal = cerl:int_val(Unit),
3037
S1 = expr(Size, [NewSize], #ctxt{final=false}, Env, S),
3038
Code = [icode_call_primop([Temp],
3039
{hipe_bsi_primop, {bs_make_size, UnitVal}},
3041
icode_call_primop([OffsetVar], {hipe_bsi_primop, bs_add},
3042
[OffsetVar, Temp])],
3043
add_offset_code(Rest, OffsetVar, VarList, Env, add_code(Code, S1));
3044
add_offset_code([], _OffsetVar, _VarList, _Env, S) ->
3046
add_offset_code(Size, OffsetVar, VarList, Env, S) ->
3047
Vars = cerl_binary_pattern_match:size_vars(Size),
3048
DefVars = cerl_binary_pattern_match:size_def_vars(Size),
3049
Code = [icode_move(OffsetVar, icode_const(0))],
3050
add_offset_code(DefVars++Vars, OffsetVar, VarList, Env, add_code(Code, S)).
3052
add_size_exp_code(Size, SizeVar, VarList, FL, Env, S) ->
3053
Vars = cerl_binary_pattern_match:size_vars(Size),
3054
DefVars = cerl_binary_pattern_match:size_def_vars(Size),
3055
Const = cerl_binary_pattern_match:size_const(Size),
3056
Code = [icode_move(SizeVar, icode_const(0))],
3057
add_size_exp_code(DefVars++Vars, Const, SizeVar, VarList, FL, Env, add_code(Code, S)).
3059
add_size_exp_code([{{tag, Tag}, Unit}|Rest], Const, SizeVar, VarList, FL, Env, S) ->
3061
NewSize = get_resvar(Tag, VarList),
3063
UnitVal = cerl:int_val(Unit),
3064
Code = [icode_guardop([Temp], {hipe_bsi_primop, {bs_make_size, UnitVal}},
3067
icode_call_primop([SizeVar], '+',[SizeVar, Temp])],
3068
add_size_exp_code(Rest, Const, SizeVar, VarList, FL, Env, add_code(Code, S));
3069
add_size_exp_code([{Size, Unit}|Rest], Const, SizeVar, VarList, FL, Env, S) ->
3072
NewSize = make_var(),
3073
UnitVal = cerl:int_val(Unit),
3074
S1 = expr(Size, [NewSize], #ctxt{final=false}, Env, S),
3075
Code = [icode_guardop([Temp], {hipe_bsi_primop, {bs_make_size, UnitVal}},
3078
icode_call_primop([SizeVar], {hipe_bsi_primop, bs_add},
3080
add_size_exp_code(Rest, Const, SizeVar, VarList, FL, Env, add_code(Code, S1));
3081
add_size_exp_code([], Const, SizeVar, _VarList, _FL, _Env, S) ->
3082
CC = icode_const(cerl:int_val(Const)),
3084
Code = [icode_move(Temp, CC),
3085
icode_call_primop([SizeVar], {hipe_bsi_primop, bs_add},
3089
test_eight_div(SizeVar, FL, S) ->
3091
add_code([icode_guardop([], {hipe_bsi_primop, bs_div_test},
3093
icode_label(TL)], S).
3095
test_size(SizeVar, BinSize, All, SL, FL, S) ->
3096
case cerl:atom_val(All) of
3098
add_code([icode_guardop([], {hipe_bsi_primop, bs_size_test_all},
3099
[SizeVar, BinSize], SL, FL)], S);
3101
add_code([icode_guardop([], {hipe_bsi_primop, bs_size_test},
3102
[SizeVar, BinSize], SL, FL)], S)
3105
test_align([{_Size, Unit}|Rest]) ->
3106
case cerl:int_val(Unit) band 7 of
3115
Vars = cerl_binary_pattern_match:size_vars(Size),
3118
get_resvar(N, VarList) ->
3119
lists:nth(N+1, VarList).
3121
translate_bin_guard(BinGuard, VarList, Env, S) ->
3122
Matches = cerl_binary_pattern_match:bin_guard_matches(BinGuard),
3123
Env1 = bind_matches(Matches, VarList, Env),
3126
bind_matches([Match|Rest], VarList, Env) ->
3127
Tag = cerl_binary_pattern_match:match_tag(Match),
3128
Val = cerl_binary_pattern_match:match_val(Match),
3129
T = get_resvar(Tag, VarList),
3130
bind_matches(Rest, VarList, bind_var(Val, T, Env));
3131
bind_matches([], _VarList, Env) ->
3134
translate_label_primop(LabelPrimop) ->
3135
?PRIMOP_SET_LABEL = cerl:atom_val(cerl:primop_name(LabelPrimop)),
3136
[Ref] = cerl:primop_args(LabelPrimop),
added
removed
lib/hipe/cerl/cerl_to_icode.erl
