diff options
-rw-r--r-- | HOWTO/INSTALL.md | 2 | ||||
-rw-r--r-- | erts/emulator/beam/beam_emu.c | 2 | ||||
-rw-r--r-- | erts/emulator/beam/beam_load.c | 174 | ||||
-rw-r--r-- | erts/emulator/beam/beam_load.h | 1 | ||||
-rw-r--r-- | erts/emulator/beam/ops.tab | 10 | ||||
-rw-r--r-- | erts/emulator/drivers/unix/unix_efile.c | 11 | ||||
-rwxr-xr-x | erts/emulator/utils/beam_makeops | 295 | ||||
-rw-r--r-- | lib/crypto/c_src/crypto.c | 202 | ||||
-rw-r--r-- | lib/kernel/doc/src/rpc.xml | 3 | ||||
-rw-r--r-- | lib/kernel/src/rpc.erl | 5 | ||||
-rw-r--r-- | system/doc/design_principles/sup_princ.xml | 2 | ||||
-rw-r--r-- | system/doc/programming_examples/funs.xmlsrc | 2 | ||||
-rw-r--r-- | system/doc/top/templates/index.html.src | 8 |
13 files changed, 407 insertions, 310 deletions
diff --git a/HOWTO/INSTALL.md b/HOWTO/INSTALL.md index adfc44baae..2ae1ed3c8d 100644 --- a/HOWTO/INSTALL.md +++ b/HOWTO/INSTALL.md @@ -68,7 +68,7 @@ also find the utilities needed for building the documentation. Required for building the application `crypto`. Further, `ssl` and `ssh` require a working crypto application and will also be skipped if OpenSSL is missing. The `public_key` - application will available without `crypto`, but the functionality + application is available without `crypto`, but the functionality will be very limited. The development package of OpenSSL including the header files are needed as well diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index a390422040..09a41f2b56 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -4102,7 +4102,7 @@ do { \ StoreBifResult(1, result); } - OpCase(i_bs_put_utf16_jIs): { + OpCase(bs_put_utf16_jIs): { Eterm arg; GetArg1(2, arg); diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 16cbdbffea..a98900460e 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -2028,42 +2028,47 @@ load_code(LoaderState* stp) ASSERT(arity == last_op->arity); do_transform: - if (stp->genop == NULL) { - last_op_next = NULL; - goto get_next_instr; - } - + ASSERT(stp->genop != NULL); if (gen_opc[stp->genop->op].transform != -1) { - int need; - tmp_op = stp->genop; - - for (need = gen_opc[stp->genop->op].min_window-1; need > 0; need--) { - if (tmp_op == NULL) { - goto get_next_instr; - } - tmp_op = tmp_op->next; + if (stp->genop->next == NULL) { + /* + * Simple heuristic: Most transformations requires + * at least two instructions, so make sure that + * there are. That will reduce the number of + * TE_SHORT_WINDOWs. + */ + goto get_next_instr; } switch (transform_engine(stp)) { case TE_FAIL: - last_op_next = NULL; - last_op = NULL; + /* + * No transformation found. stp->genop != NULL and + * last_op_next is still valid. Go ahead and load + * the instruction. + */ break; case TE_OK: + /* + * Some transformation was applied. last_op_next is + * no longer valid and stp->genop may be NULL. + * Try to transform again. + */ + if (stp->genop == NULL) { + last_op_next = &stp->genop; + goto get_next_instr; + } last_op_next = NULL; - last_op = NULL; goto do_transform; case TE_SHORT_WINDOW: - last_op_next = NULL; - last_op = NULL; + /* + * No transformation applied. stp->genop != NULL and + * last_op_next is still valid. Fetch a new instruction + * before trying the transformation again. + */ goto get_next_instr; } } - if (stp->genop == NULL) { - last_op_next = NULL; - goto get_next_instr; - } - /* * From the collected generic instruction, find the specific * instruction. @@ -2584,7 +2589,10 @@ load_code(LoaderState* stp) { GenOp* next = stp->genop->next; FREE_GENOP(stp, stp->genop); - stp->genop = next; + if ((stp->genop = next) == NULL) { + last_op_next = &stp->genop; + goto get_next_instr; + } goto do_transform; } } @@ -2728,13 +2736,6 @@ mixed_types(LoaderState* stp, GenOpArg Size, GenOpArg* Rest) } static int -same_label(LoaderState* stp, GenOpArg Target, GenOpArg Label) -{ - return Target.type = TAG_f && Label.type == TAG_u && - Target.val == Label.val; -} - -static int is_killed_apply(LoaderState* stp, GenOpArg Reg, GenOpArg Live) { return Reg.type == TAG_x && Live.type == TAG_u && @@ -4805,31 +4806,25 @@ transform_engine(LoaderState* st) Uint op; int ap; /* Current argument. */ Uint* restart; /* Where to restart if current match fails. */ - GenOpArg def_vars[TE_MAX_VARS]; /* Default buffer for variables. */ - GenOpArg* var = def_vars; - int num_vars = 0; + GenOpArg var[TE_MAX_VARS]; /* Buffer for variables. */ + GenOpArg* rest_args = NULL; + int num_rest_args = 0; int i; /* General index. */ Uint mask; GenOp* instr; + GenOp* first = st->genop; + GenOp* keep = NULL; Uint* pc; - int rval; static Uint restart_fail[1] = {TOP_fail}; - ASSERT(gen_opc[st->genop->op].transform != -1); - pc = op_transform + gen_opc[st->genop->op].transform; - restart = pc; + ASSERT(gen_opc[first->op].transform != -1); + restart = op_transform + gen_opc[first->op].transform; restart: - if (var != def_vars) { - erts_free(ERTS_ALC_T_LOADER_TMP, (void *) var); - var = def_vars; - } ASSERT(restart != NULL); pc = restart; ASSERT(*pc < NUM_TOPS); /* Valid instruction? */ - instr = st->genop; - -#define RETURN(r) rval = (r); goto do_return; + instr = first; #ifdef DEBUG restart = NULL; @@ -4847,7 +4842,7 @@ transform_engine(LoaderState* st) * We'll need at least one more instruction to decide whether * this combination matches or not. */ - RETURN(TE_SHORT_WINDOW); + return TE_SHORT_WINDOW; } if (*pc++ != instr->op) goto restart; @@ -5009,19 +5004,9 @@ transform_engine(LoaderState* st) #if defined(TOP_rest_args) case TOP_rest_args: { - int n = *pc++; int formal_arity = gen_opc[instr->op].arity; - int j = formal_arity; - - num_vars = n + (instr->arity - formal_arity); - var = erts_alloc(ERTS_ALC_T_LOADER_TMP, - num_vars * sizeof(GenOpArg)); - for (i = 0; i < n; i++) { - var[i] = def_vars[i]; - } - while (i < num_vars) { - var[i++] = instr->a[j++]; - } + num_rest_args = instr->arity - formal_arity; + rest_args = instr->a + formal_arity; } break; #endif @@ -5030,21 +5015,22 @@ transform_engine(LoaderState* st) break; case TOP_commit: instr = instr->next; /* The next_instr was optimized away. */ - - /* - * The left-hand side of this transformation matched. - * Delete all matched instructions. - */ - while (st->genop != instr) { - GenOp* next = st->genop->next; - FREE_GENOP(st, st->genop); - st->genop = next; - } + keep = instr; + st->genop = instr; #ifdef DEBUG instr = 0; #endif break; - +#if defined(TOP_keep) + case TOP_keep: + /* Keep the current instruction unchanged. */ + keep = instr; + st->genop = instr; +#ifdef DEBUG + instr = 0; +#endif + break; +#endif #if defined(TOP_call_end) case TOP_call_end: { @@ -5069,22 +5055,19 @@ transform_engine(LoaderState* st) lastp = &((*lastp)->next); } - instr = instr->next; /* The next_instr was optimized away. */ - - /* - * The left-hand side of this transformation matched. - * Delete all matched instructions. - */ - while (st->genop != instr) { - GenOp* next = st->genop->next; - FREE_GENOP(st, st->genop); - st->genop = next; - } - *lastp = st->genop; + keep = instr->next; /* The next_instr was optimized away. */ + *lastp = keep; st->genop = new_instr; } - RETURN(TE_OK); + /* FALLTHROUGH */ #endif + case TOP_end: + while (first != keep) { + GenOp* next = first->next; + FREE_GENOP(st, first); + first = next; + } + return TE_OK; case TOP_new_instr: /* * Note that the instructions are generated in reverse order. @@ -5096,6 +5079,12 @@ transform_engine(LoaderState* st) instr->arity = gen_opc[op].arity; ap = 0; break; +#ifdef TOP_rename + case TOP_rename: + instr->op = op = *pc++; + instr->arity = gen_opc[op].arity; + return TE_OK; +#endif case TOP_store_type: i = *pc++; instr->a[ap].type = i; @@ -5115,14 +5104,10 @@ transform_engine(LoaderState* st) #if defined(TOP_store_rest_args) case TOP_store_rest_args: { - int n = *pc++; - int num_extra = num_vars - n; - - ASSERT(n <= num_vars); - GENOP_ARITY(instr, instr->arity+num_extra); + GENOP_ARITY(instr, instr->arity+num_rest_args); memcpy(instr->a, instr->def_args, ap*sizeof(GenOpArg)); - memcpy(instr->a+ap, var+n, num_extra*sizeof(GenOpArg)); - ap += num_extra; + memcpy(instr->a+ap, rest_args, num_rest_args*sizeof(GenOpArg)); + ap += num_rest_args; } break; #endif @@ -5134,21 +5119,12 @@ transform_engine(LoaderState* st) case TOP_try_me_else_fail: restart = restart_fail; break; - case TOP_end: - RETURN(TE_OK); case TOP_fail: - RETURN(TE_FAIL); + return TE_FAIL; default: ASSERT(0); } } -#undef RETURN - - do_return: - if (var != def_vars) { - erts_free(ERTS_ALC_T_LOADER_TMP, (void *) var); - } - return rval; } static void diff --git a/erts/emulator/beam/beam_load.h b/erts/emulator/beam/beam_load.h index 22ab71c868..68f4b96893 100644 --- a/erts/emulator/beam/beam_load.h +++ b/erts/emulator/beam/beam_load.h @@ -33,7 +33,6 @@ typedef struct gen_op_entry { int specific; int num_specific; int transform; - int min_window; } GenOpEntry; extern GenOpEntry gen_opc[]; diff --git a/erts/emulator/beam/ops.tab b/erts/emulator/beam/ops.tab index 772460c177..15f27835a8 100644 --- a/erts/emulator/beam/ops.tab +++ b/erts/emulator/beam/ops.tab @@ -181,11 +181,6 @@ i_jump_on_val_zero y f I i_jump_on_val x f I I i_jump_on_val y f I I -jump Target | label Lbl | same_label(Target, Lbl) => label Lbl - -is_ne_exact L1 S1 S2 | jump Fail | label L2 | same_label(L1, L2) => \ - is_eq_exact Fail S1 S2 | label L2 - %macro: get_list GetList -pack get_list x x x get_list x x y @@ -1355,9 +1350,7 @@ bs_put_utf8 Fail u Src=s => i_bs_put_utf8 Fail Src i_bs_put_utf8 j s -bs_put_utf16 Fail Flags=u Src=s => i_bs_put_utf16 Fail Flags Src - -i_bs_put_utf16 j I s +bs_put_utf16 j I s bs_put_utf32 Fail=j Flags=u Src=s => \ i_bs_validate_unicode Fail Src | bs_put_integer Fail i=32 u=1 Flags Src @@ -1539,7 +1532,6 @@ gen_minus p Live Reg=d Int=i Dst | negation_is_small(Int) => \ # GCing arithmetic instructions. # -gen_plus Fail Live Y=y X=x Dst => i_plus Fail Live X Y Dst gen_plus Fail Live S1 S2 Dst => i_plus Fail Live S1 S2 Dst gen_minus Fail Live S1 S2 Dst => i_minus Fail Live S1 S2 Dst diff --git a/erts/emulator/drivers/unix/unix_efile.c b/erts/emulator/drivers/unix/unix_efile.c index 81ed1996df..0861435264 100644 --- a/erts/emulator/drivers/unix/unix_efile.c +++ b/erts/emulator/drivers/unix/unix_efile.c @@ -638,12 +638,21 @@ efile_writev(Efile_error* errInfo, /* Where to return error codes */ do { w = writev(fd, &iov[cnt], b); } while (w < 0 && errno == EINTR); + if (w < 0 && errno == EINVAL) { + goto single_write; + } } else + single_write: /* Degenerated io vector - use regular write */ #endif { do { - w = write(fd, iov[cnt].iov_base, iov[cnt].iov_len); + size_t iov_len = iov[cnt].iov_len; + size_t limit = 1024*1024*1024; /* 1GB */ + if (iov_len > limit) { + iov_len = limit; + } + w = write(fd, iov[cnt].iov_base, iov_len); } while (w < 0 && errno == EINTR); ASSERT(w <= iov[cnt].iov_len || (w == -1 && errno != EINTR)); diff --git a/erts/emulator/utils/beam_makeops b/erts/emulator/utils/beam_makeops index f805e7cc64..2e7073a8f0 100755 --- a/erts/emulator/utils/beam_makeops +++ b/erts/emulator/utils/beam_makeops @@ -113,7 +113,6 @@ my @if_line; # my $te_max_vars = 0; # Max number of variables ever needed. my %gen_transform; -my %min_window; my %match_engine_ops; # All opcodes for the match engine. my %gen_transform_offset; my @transformations; @@ -382,7 +381,6 @@ while (<>) { $gen_arity{$name} = $arity; $gen_to_spec{"$name/$arity"} = undef; $num_specific{"$name/$arity"} = 0; - $min_window{"$name/$arity"} = 255; $obsolete[$op_num] = defined $obsolete; } else { # Unnumbered generic operation. push(@unnumbered_generic, [$name, $arity]); @@ -440,7 +438,6 @@ $num_file_opcodes = @gen_opname; $gen_arity{$name} = $arity; $gen_to_spec{"$name/$arity"} = undef; $num_specific{"$name/$arity"} = 0; - $min_window{"$name/$arity"} = 255; } } @@ -607,7 +604,7 @@ sub emulator_output { $is_transformed{$name,$arity} or error("instruction $key has no specific instruction"); $spec_op = -1 unless defined $spec_op; - &init_item($name, $arity, $spec_op, $num_specific, $tr, $min_window{$key}); + &init_item($name, $arity, $spec_op, $num_specific, $tr); } } print "};\n"; @@ -1405,8 +1402,7 @@ sub tr_gen { foreach $ref (@g) { my($line, $orig_transform, $from_ref, $to_ref) = @$ref; - my $used_ref = used_vars($from_ref, $to_ref); - my $so_far = tr_gen_from($line, $used_ref, @$from_ref); + my $so_far = tr_gen_from($line, @$from_ref); tr_gen_to($line, $orig_transform, $so_far, @$to_ref); } @@ -1457,58 +1453,14 @@ sub tr_gen { print "};\n\n"; } -sub used_vars { - my($from_ref,$to_ref) = @_; - my %used; - my %seen; - - foreach my $ref (@$from_ref) { - my($name,$arity,@ops) = @$ref; - if ($name =~ /^[.]/) { - foreach my $var (@ops) { - $used{$var} = 1; - } - } else { - # Any variable that is used at least twice on the - # left-hand side is used. (E.g. "move R R".) - foreach my $op (@ops) { - my($var, $type, $type_val) = @$op; - next if $var eq ''; - $used{$var} = 1 if $seen{$var}; - $seen{$var} = 1; - } - } - } - - foreach my $ref (@$to_ref) { - my($name, $arity, @ops) = @$ref; - if ($name =~ /^[.]/) { - foreach my $var (@ops) { - $used{$var} = 1; - } - } else { - foreach my $op (@ops) { - my($var, $type, $type_val) = @$op; - next if $var eq ''; - $used{$var} = 1; - } - } - } - \%used; -} - sub tr_gen_from { - my($line,$used_ref,@tr) = @_; + my($line,@tr) = @_; my(%var) = (); my(%var_type); my($var_num) = 0; my(@code); - my($min_window) = 0; - my(@fix_rest_args); - my(@fix_pred_funcs); my($op, $ref); # Loop variables. my $where = "left side of transformation in line $line: "; - my %var_used = %$used_ref; my $may_fail = 0; my $is_first = 1; @@ -1530,8 +1482,20 @@ sub tr_gen_from { my $var; my(@args); - push(@fix_pred_funcs, scalar(@code)); - push(@code, [$name, @ops]); + foreach $var (@ops) { + error($where, "variable '$var' unbound") + unless defined $var{$var}; + if ($var_type{$var} eq 'scalar') { + push(@args, "var[$var{$var}]"); + } else { + push(@args, "rest_args"); + } + } + my $pi = tr_next_index(\@pred_table, \%pred_table, $name, @args); + my $op = make_op("$name()", 'pred', $pi); + my @slots = grep(/^\d+/, map { $var{$_} } @ops); + op_slot_usage($op, @slots); + push(@code, $op); next; } @@ -1544,7 +1508,6 @@ sub tr_gen_from { $opnum = $gen_opnum{$name,$arity}; push(@code, make_op("$name/$arity", 'next_instr', $opnum)); - $min_window++; foreach $op (@ops) { my($var, $type, $type_val, $cond, $val) = @$op; my $ignored_var = "$var (ignored)"; @@ -1593,15 +1556,21 @@ sub tr_gen_from { if (defined $var{$var}) { $ignored_var = ''; $may_fail = 1; - push(@code, &make_op($var, 'is_same_var', $var{$var})); + my $op = make_op($var, 'is_same_var', $var{$var}); + op_slot_usage($op, $var{$var}); + push(@code, $op); } elsif ($type eq '*') { - # - # Reserve a hole for a 'rest_args' instruction. - # + foreach my $type (values %var_type) { + error("only one use of a '*' variable is " . + "allowed on the left hand side of " . + "a transformation") + if $type eq 'array'; + } $ignored_var = ''; - push(@fix_rest_args, scalar(@code)); - push(@code, $var); - } elsif ($var_used{$var}) { + $var{$var} = 'unnumbered'; + $var_type{$var} = 'array'; + push(@code, make_op($var, 'rest_args')); + } else { $ignored_var = ''; $var_type{$var} = 'scalar'; $var{$var} = $var_num; @@ -1629,46 +1598,14 @@ sub tr_gen_from { # push(@code, make_op($may_fail ? '' : 'always reached', 'commit')); - # - # If there is an rest_args instruction, we must insert its correct - # variable number (higher than any other). - # - my $index; - &error("only one use of a '*' variable is allowed on the left hand side of a transformation") - if @fix_rest_args > 1; - foreach $index (@fix_rest_args) { - my $var = $code[$index]; - $var{$var} = $var_num++; - $var_type{$var} = 'array'; - splice(@code, $index, 1, &make_op($var, 'rest_args', $var{$var})); - } - - foreach $index (@fix_pred_funcs) { - my($name, @ops) = @{$code[$index]}; - my(@args); - my $var; - - foreach $var (@ops) { - &error($where, "variable '$var' unbound") - unless defined $var{$var}; - if ($var_type{$var} eq 'scalar') { - push(@args, "var[$var{$var}]"); - } else { - push(@args, "var+$var{$var}"); - } - } - my $pi = tr_next_index(\@pred_table, \%pred_table, $name, @args); - splice(@code, $index, 1, make_op("$name()", 'pred', $pi)); - } - $te_max_vars = $var_num if $te_max_vars < $var_num; - [$min_window, \%var, \%var_type, \@code]; + [\%var, \%var_type, \@code]; } sub tr_gen_to { my($line, $orig_transform, $so_far, @tr) = @_; - my($min_window, $var_ref, $var_type_ref, $code_ref) = @$so_far; + my($var_ref, $var_type_ref, $code_ref) = @$so_far; my(%var) = %$var_ref; my(%var_type) = %$var_type_ref; my(@code) = @$code_ref; @@ -1697,13 +1634,16 @@ sub tr_gen_to { if ($var_type{$var} eq 'scalar') { push(@args, "var[$var{$var}]"); } else { - push(@args, "var+$var{$var}"); + push(@args, "rest_args"); } } pop(@code); # Get rid of 'commit' instruction my $index = tr_next_index(\@call_table, \%call_table, $name, @args); - push(@code, make_op("$name()", 'call_end', $index)); + my $op = make_op("$name()", 'call_end', $index); + my @slots = grep(/^\d+/, map { $var{$_} } @ops); + op_slot_usage($op, @slots); + push(@code, $op); last; } @@ -1725,11 +1665,13 @@ sub tr_gen_to { my($var, $type, $type_val) = @$op; if ($type eq '*') { - push(@code, make_op($var, 'store_rest_args', $var{$var})); + push(@code, make_op($var, 'store_rest_args')); } elsif ($var ne '') { &error($where, "variable '$var' unbound") unless defined $var{$var}; - push(@code, &make_op($var, 'store_var_next_arg', $var{$var})); + my $op = make_op($var, 'store_var_next_arg', $var{$var}); + op_slot_usage($op, $var{$var}); + push(@code, $op); } elsif ($type ne '') { push(@code, &make_op('', 'store_type', "TAG_$type")); if ($type_val) { @@ -1744,6 +1686,10 @@ sub tr_gen_to { push(@code, make_op('', 'end')) unless is_instr($code[$#code], 'call_end'); + tr_maybe_keep(\@code); + tr_maybe_rename(\@code); + tr_remove_unused(\@code); + # # Chain together all codes segments having the same first operation. # @@ -1752,8 +1698,6 @@ sub tr_gen_to { my($dummy, $arity); ($dummy, $op, $arity) = @$first; my($comment) = "\n/*\n * Line $line:\n * $orig_transform\n */\n\n"; - $min_window{$key} = $min_window - if $min_window{$key} > $min_window; my $prev_last; $prev_last = pop(@{$gen_transform{$key}}) @@ -1771,6 +1715,148 @@ sub tr_gen_to { push(@{$gen_transform{$key}}, @code), } +sub tr_maybe_keep { + my($ref) = @_; + my @last_instr; + my $pos; + my $reused_instr; + + for (my $i = 0; $i < @$ref; $i++) { + my $instr = $$ref[$i]; + my($size, $instr_ref, $comment) = @$instr; + my($op, @args) = @$instr_ref; + if ($op eq 'next_instr') { + @last_instr = ($args[0]); + } elsif ($op eq 'set_var_next_arg') { + push @last_instr, $args[0]; + } elsif ($op eq 'next_arg') { + push @last_instr, 'ignored'; + } elsif ($op eq 'new_instr') { + unless (defined $pos) { + # 'new_instr' immediately after 'commit'. + $reused_instr = $args[0]; + return unless shift(@last_instr) == $reused_instr; + $pos = $i - 1; + } else { + # Second 'new_instr' after 'commit'. The instructions + # from $pos up to and including $i - 1 rebuilds the + # existing instruction exactly. + my $name = $gen_opname[$reused_instr]; + my $arity = $gen_arity[$reused_instr]; + my $reuse = make_op("$name/$arity", 'keep'); + splice @$ref, $pos, $i-$pos, ($reuse); + return; + } + } elsif ($op eq 'store_var_next_arg') { + return unless shift(@last_instr) eq $args[0]; + } elsif (defined $pos) { + return; + } + } +} + +sub tr_maybe_rename { + my($ref) = @_; + my $s = 'left'; + my $a = 0; + my $num_args = 0; + my $new_instr; + my $first; + my $i; + + for ($i = 1; $i < @$ref; $i++) { + my $instr = $$ref[$i]; + my($size, $instr_ref, $comment) = @$instr; + my($op, @args) = @$instr_ref; + + if ($s eq 'left') { + if ($op eq 'set_var_next_arg') { + if ($num_args == $a and $args[0] == $a) { + $num_args++; + } + $a++; + } elsif ($op eq 'next_arg') { + $a++; + } elsif ($op eq 'commit') { + $a = 0; + $first = $i; + $s = 'committed'; + } elsif ($op eq 'next_instr') { + return; + } + } elsif ($s eq 'committed') { + if ($op eq 'new_instr') { + $new_instr = $args[0]; + $a = 0; + $s = 'right'; + } else { + return; + } + } elsif ($s eq 'right') { + if ($op eq 'store_var_next_arg' && $args[0] == $a) { + $a++; + } elsif ($op eq 'end' && $a <= $num_args) { + my $name = $gen_opname[$new_instr]; + my $arity = $gen_arity[$new_instr]; + my $new_op = make_op("$name/$arity", 'rename', $new_instr); + splice @$ref, $first, $i-$first+1, ($new_op); + return; + } else { + return; + } + } + } +} + +sub tr_remove_unused { + my($ref) = @_; + my %used; + + # Collect all used variables. + for my $instr (@$ref) { + my $uref = $$instr[3]; + for my $slot (@$uref) { + $used{$slot} = 1; + } + } + + # Replace 'set_var_next_arg' with 'next_arg' if the variable + # is never used. + for my $instr (@$ref) { + my($size, $instr_ref, $comment) = @$instr; + my($op, @args) = @$instr_ref; + if ($op eq 'set_var_next_arg') { + my $var = $args[0]; + next if $used{$var}; + $instr = make_op("$comment (ignored)", 'next_arg'); + } + } + + # Delete a sequence of 'next_arg' instructions when they are + # redundant before instructions such as 'commit'. + my @opcode; + my %ending = (call_end => 1, + commit => 1, + next_instr => 1, + pred => 1, + rename => 1, + keep => 1); + for (my $i = 0; $i < @$ref; $i++) { + my $instr = $$ref[$i]; + my($size, $instr_ref, $comment) = @$instr; + my($opcode) = @$instr_ref; + + if ($ending{$opcode}) { + my $first = $i; + $first-- while $first > 0 and $opcode[$first-1] eq 'next_arg'; + my $n = $i - $first; + splice @$ref, $first, $n; + $i -= $n; + } + $opcode[$i] = $opcode; + } +} + sub tr_code_len { my($sum) = 0; my($ref); @@ -1783,7 +1869,12 @@ sub tr_code_len { sub make_op { my($comment, @op) = @_; - [scalar(@op), [@op], $comment]; + [scalar(@op), [@op], $comment, []]; +} + +sub op_slot_usage { + my($op_ref, @slots) = @_; + $$op_ref[3] = \@slots; } sub is_instr { diff --git a/lib/crypto/c_src/crypto.c b/lib/crypto/c_src/crypto.c index d1f620d892..74cdecdec6 100644 --- a/lib/crypto/c_src/crypto.c +++ b/lib/crypto/c_src/crypto.c @@ -378,86 +378,96 @@ struct hmac_context static void hmac_context_dtor(ErlNifEnv* env, struct hmac_context*); struct digest_type_t { - const char* type_str; - const EVP_MD* (*md_func)(void); /* NULL if notsup */ - ERL_NIF_TERM type_atom; + union { + const char* str; /* before init, NULL for end-of-table */ + ERL_NIF_TERM atom; /* after init, 'false' for end-of-table */ + }type; + union { + const EVP_MD* (*funcp)(void); /* before init, NULL if notsup */ + const EVP_MD* p; /* after init, NULL if notsup */ + }md; }; struct digest_type_t digest_types[] = { - {"md4", &EVP_md4}, - {"md5", &EVP_md5}, - {"ripemd160", &EVP_ripemd160}, - {"sha", &EVP_sha1}, - {"sha224", + {{"md4"}, {&EVP_md4}}, + {{"md5"}, {&EVP_md5}}, + {{"ripemd160"}, {&EVP_ripemd160}}, + {{"sha"}, {&EVP_sha1}}, + {{"sha224"}, #ifdef HAVE_SHA224 - &EVP_sha224 + {&EVP_sha224} #else - NULL + {NULL} #endif }, - {"sha256", + {{"sha256"}, #ifdef HAVE_SHA256 - &EVP_sha256 + {&EVP_sha256} #else - NULL + {NULL} #endif }, - {"sha384", + {{"sha384"}, #ifdef HAVE_SHA384 - &EVP_sha384 + {&EVP_sha384} #else - NULL + {NULL} #endif }, - {"sha512", + {{"sha512"}, #ifdef HAVE_SHA512 - &EVP_sha512 + {&EVP_sha512} #else - NULL + {NULL} #endif }, - {NULL} + {{NULL}} }; static struct digest_type_t* get_digest_type(ERL_NIF_TERM type); struct cipher_type_t { - const char* type_str; - const EVP_CIPHER* (*cipher_func)(void); /* NULL if notsup */ + union { + const char* str; /* before init */ + ERL_NIF_TERM atom; /* after init */ + }type; + union { + const EVP_CIPHER* (*funcp)(void); /* before init, NULL if notsup */ + const EVP_CIPHER* p; /* after init, NULL if notsup */ + }cipher; const size_t key_len; /* != 0 to also match on key_len */ - ERL_NIF_TERM type_atom; }; struct cipher_type_t cipher_types[] = { - {"rc2_cbc", &EVP_rc2_cbc}, - {"des_cbc", &EVP_des_cbc}, - {"des_cfb", &EVP_des_cfb8}, - {"des_ecb", &EVP_des_ecb}, - {"des_ede3_cbc", &EVP_des_ede3_cbc}, - {"des_ede3_cbf", + {{"rc2_cbc"}, {&EVP_rc2_cbc}}, + {{"des_cbc"}, {&EVP_des_cbc}}, + {{"des_cfb"}, {&EVP_des_cfb8}}, + {{"des_ecb"}, {&EVP_des_ecb}}, + {{"des_ede3_cbc"}, {&EVP_des_ede3_cbc}}, + {{"des_ede3_cbf"}, #ifdef HAVE_DES_ede3_cfb_encrypt - &EVP_des_ede3_cfb8 + {&EVP_des_ede3_cfb8} #else - NULL + {NULL} #endif }, - {"blowfish_cbc", &EVP_bf_cbc}, - {"blowfish_cfb64", &EVP_bf_cfb64}, - {"blowfish_ofb64", &EVP_bf_ofb}, - {"blowfish_ecb", &EVP_bf_ecb}, - {"aes_cbc", &EVP_aes_128_cbc, 16}, - {"aes_cbc", &EVP_aes_192_cbc, 24}, - {"aes_cbc", &EVP_aes_256_cbc, 32}, - {"aes_cbc128", &EVP_aes_128_cbc}, - {"aes_cbc256", &EVP_aes_256_cbc}, - {"aes_cfb8", &EVP_aes_128_cfb8}, - {"aes_cfb128", &EVP_aes_128_cfb128}, - {"aes_ecb", &EVP_aes_128_ecb, 16}, - {"aes_ecb", &EVP_aes_192_ecb, 24}, - {"aes_ecb", &EVP_aes_256_ecb, 32}, - {NULL} + {{"blowfish_cbc"}, {&EVP_bf_cbc}}, + {{"blowfish_cfb64"}, {&EVP_bf_cfb64}}, + {{"blowfish_ofb64"}, {&EVP_bf_ofb}}, + {{"blowfish_ecb"}, {&EVP_bf_ecb}}, + {{"aes_cbc"}, {&EVP_aes_128_cbc}, 16}, + {{"aes_cbc"}, {&EVP_aes_192_cbc}, 24}, + {{"aes_cbc"}, {&EVP_aes_256_cbc}, 32}, + {{"aes_cbc128"}, {&EVP_aes_128_cbc}}, + {{"aes_cbc256"}, {&EVP_aes_256_cbc}}, + {{"aes_cfb8"}, {&EVP_aes_128_cfb8}}, + {{"aes_cfb128"}, {&EVP_aes_128_cfb128}}, + {{"aes_ecb"}, {&EVP_aes_128_ecb}, 16}, + {{"aes_ecb"}, {&EVP_aes_192_ecb}, 24}, + {{"aes_ecb"}, {&EVP_aes_256_ecb}, 32}, + {{NULL}} }; static struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len); @@ -829,6 +839,15 @@ static ERL_NIF_TERM info_lib(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] ver_term)); } +static ERL_NIF_TERM make_badarg_maybe(ErlNifEnv* env) +{ + ERL_NIF_TERM reason; + if (enif_has_pending_exception(env, &reason)) + return reason; /* dummy return value ignored */ + else + return enif_make_badarg(env); +} + static ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[]) {/* (Type, Data) */ struct digest_type_t *digp = NULL; @@ -842,11 +861,11 @@ static ERL_NIF_TERM hash_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] !enif_inspect_iolist_as_binary(env, argv[1], &data)) { return enif_make_badarg(env); } - if (!digp->md_func) { + md = digp->md.p; + if (!md) { return atom_notsup; } - md = digp->md_func(); ret_size = (unsigned)EVP_MD_size(md); ASSERT(0 < ret_size && ret_size <= EVP_MAX_MD_SIZE); if (!EVP_Digest(data.data, data.size, @@ -872,12 +891,12 @@ static ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a if (!digp) { return enif_make_badarg(env); } - if (!digp->md_func) { + if (!digp->md.p) { return atom_notsup; } ctx = enif_alloc_resource(evp_md_ctx_rtype, sizeof(EVP_MD_CTX)); - if (!EVP_DigestInit(ctx, digp->md_func())) { + if (!EVP_DigestInit(ctx, digp->md.p)) { enif_release_resource(ctx); return atom_notsup; } @@ -946,11 +965,11 @@ static ERL_NIF_TERM hash_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a if (!digp) { return enif_make_badarg(env); } - if (!digp->md_func) { + if (!digp->md.p) { return atom_notsup; } - switch (EVP_MD_type(digp->md_func())) + switch (EVP_MD_type(digp->md.p)) { case NID_md4: ctx_size = MD4_CTX_LEN; @@ -1020,11 +1039,11 @@ static ERL_NIF_TERM hash_update_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM !enif_inspect_iolist_as_binary(env, argv[1], &data)) { return enif_make_badarg(env); } - if (!digp->md_func) { + if (!digp->md.p) { return atom_notsup; } - switch (EVP_MD_type(digp->md_func())) + switch (EVP_MD_type(digp->md.p)) { case NID_md4: ctx_size = MD4_CTX_LEN; @@ -1102,11 +1121,11 @@ static ERL_NIF_TERM hash_final_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM !enif_inspect_binary(env, tuple[1], &ctx)) { return enif_make_badarg(env); } - if (!digp->md_func) { + md = digp->md.p; + if (!md) { return atom_notsup; } - md = digp->md_func(); switch (EVP_MD_type(md)) { @@ -1186,8 +1205,8 @@ static ERL_NIF_TERM hmac_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM argv[] return enif_make_badarg(env); } - if (!digp->md_func || - !HMAC(digp->md_func(), + if (!digp->md.p || + !HMAC(digp->md.p, key.data, key.size, data.data, data.size, buff, &size)) { @@ -1229,7 +1248,7 @@ static ERL_NIF_TERM hmac_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a !enif_inspect_iolist_as_binary(env, argv[1], &key)) { return enif_make_badarg(env); } - if (!digp->md_func) { + if (!digp->md.p) { return atom_notsup; } @@ -1239,12 +1258,12 @@ static ERL_NIF_TERM hmac_init_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM a #if OPENSSL_VERSION_NUMBER >= 0x1000000fL // Check the return value of HMAC_Init: it may fail in FIPS mode // for disabled algorithms - if (!HMAC_Init(&obj->ctx, key.data, key.size, digp->md_func())) { + if (!HMAC_Init(&obj->ctx, key.data, key.size, digp->md.p)) { enif_release_resource(obj); return atom_notsup; } #else - HMAC_Init(&obj->ctx, key.data, key.size, digp->md_func()); + HMAC_Init(&obj->ctx, key.data, key.size, digp->md.p); #endif ret = enif_make_resource(env, obj); @@ -1323,7 +1342,8 @@ static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM || !enif_inspect_iolist_as_binary(env, argv[argc - 2], &text)) { return enif_make_badarg(env); } - if (!cipherp->cipher_func) { + cipher = cipherp->cipher.p; + if (!cipher) { return enif_raise_exception(env, atom_notsup); } @@ -1335,7 +1355,6 @@ static ERL_NIF_TERM block_crypt_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM return aes_cfb_8_crypt(env, argc-1, argv+1); } - cipher = cipherp->cipher_func(); ivec_size = EVP_CIPHER_iv_length(cipher); #ifdef HAVE_ECB_IVEC_BUG @@ -2110,27 +2129,31 @@ static void init_digest_types(ErlNifEnv* env) { struct digest_type_t* p = digest_types; - for (p = digest_types; p->type_str; p++) { - p->type_atom = enif_make_atom(env, p->type_str); + for (p = digest_types; p->type.str; p++) { + p->type.atom = enif_make_atom(env, p->type.str); + if (p->md.funcp) + p->md.p = p->md.funcp(); } - + p->type.atom = atom_false; /* end marker */ } static void init_cipher_types(ErlNifEnv* env) { struct cipher_type_t* p = cipher_types; - for (p = cipher_types; p->type_str; p++) { - p->type_atom = enif_make_atom(env, p->type_str); + for (p = cipher_types; p->type.str; p++) { + p->type.atom = enif_make_atom(env, p->type.str); + if (p->cipher.funcp) + p->cipher.p = p->cipher.funcp(); } - + p->type.atom = atom_false; /* end marker */ } static struct digest_type_t* get_digest_type(ERL_NIF_TERM type) { struct digest_type_t* p = NULL; - for (p = digest_types; p->type_str; p++) { - if (type == p->type_atom) { + for (p = digest_types; p->type.atom != atom_false; p++) { + if (type == p->type.atom) { return p; } } @@ -2140,8 +2163,8 @@ static struct digest_type_t* get_digest_type(ERL_NIF_TERM type) static struct cipher_type_t* get_cipher_type(ERL_NIF_TERM type, size_t key_len) { struct cipher_type_t* p = NULL; - for (p = cipher_types; p->type_str; p++) { - if (type == p->type_atom && (!p->key_len || key_len == p->key_len)) { + for (p = cipher_types; p->type.atom != atom_false; p++) { + if (type == p->type.atom && (!p->key_len || key_len == p->key_len)) { return p; } } @@ -2166,12 +2189,12 @@ static ERL_NIF_TERM rsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM if (!digp) { return enif_make_badarg(env); } - if (!digp->md_func) { + md = digp->md.p; + if (!md) { return atom_notsup; } rsa = RSA_new(); - md = digp->md_func(); if (!enif_inspect_binary(env, argv[1], &digest_bin) || digest_bin.size != EVP_MD_size(md) @@ -2329,10 +2352,10 @@ static ERL_NIF_TERM rsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM ar if (!digp) { return enif_make_badarg(env); } - if (!digp->md_func) { + md = digp->md.p; + if (!md) { return atom_notsup; } - md = digp->md_func(); if (!enif_inspect_binary(env,argv[1],&digest_bin) || digest_bin.size != EVP_MD_size(md)) { @@ -2904,8 +2927,7 @@ static EC_KEY* ec_key_new(ErlNifEnv* env, ERL_NIF_TERM curve_arg) EC_POINT *point = NULL; /* {Field, Prime, Point, Order, CoFactor} = Curve */ - if (enif_is_tuple(env, curve_arg) - && enif_get_tuple(env,curve_arg,&c_arity,&curve) + if (enif_get_tuple(env,curve_arg,&c_arity,&curve) && c_arity == 5 && get_bn_from_bin(env, curve[3], &bn_order) && (curve[4] != atom_none && get_bn_from_bin(env, curve[4], &cofactor))) { @@ -2942,9 +2964,11 @@ static EC_KEY* ec_key_new(ErlNifEnv* env, ERL_NIF_TERM curve_arg) /* create the EC_GROUP structure */ group = EC_GROUP_new_curve_GFp(p, a, b, NULL); -#if !defined(OPENSSL_NO_EC2M) - } else if (f_arity == 3 && field[0] == atom_characteristic_two_field) { +#if defined(OPENSSL_NO_EC2M) + enif_raise_exception(env, atom_notsup); + goto out_err; +#else /* {characteristic_two_field, M, Basis} */ int b_arity = -1; @@ -3221,7 +3245,7 @@ static ERL_NIF_TERM ec_key_generate(ErlNifEnv* env, int argc, const ERL_NIF_TERM badarg: if (key) EC_KEY_free(key); - return enif_make_badarg(env); + return make_badarg_maybe(env); #else return atom_notsup; #endif @@ -3241,10 +3265,10 @@ static ERL_NIF_TERM ecdsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM if (!digp) { return enif_make_badarg(env); } - if (!digp->md_func) { + md = digp->md.p; + if (!md) { return atom_notsup; } - md = digp->md_func(); len = EVP_MD_size(md); if (!enif_inspect_binary(env,argv[1],&digest_bin) @@ -3272,7 +3296,7 @@ static ERL_NIF_TERM ecdsa_sign_nif(ErlNifEnv* env, int argc, const ERL_NIF_TERM badarg: if (key) EC_KEY_free(key); - return enif_make_badarg(env); + return make_badarg_maybe(env); #else return atom_notsup; #endif @@ -3292,10 +3316,10 @@ static ERL_NIF_TERM ecdsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER if (!digp) { return enif_make_badarg(env); } - if (!digp->md_func) { + md = digp->md.p; + if (!md) { return atom_notsup; } - md = digp->md_func(); len = EVP_MD_size(md); if (!enif_inspect_binary(env, argv[1], &digest_bin) @@ -3314,7 +3338,7 @@ static ERL_NIF_TERM ecdsa_verify_nif(ErlNifEnv* env, int argc, const ERL_NIF_TER badarg: if (key) EC_KEY_free(key); - return enif_make_badarg(env); + return make_badarg_maybe(env); #else return atom_notsup; #endif @@ -3339,7 +3363,7 @@ static ERL_NIF_TERM ecdh_compute_key_nif(ErlNifEnv* env, int argc, const ERL_NIF EC_KEY *other_ecdh = NULL; if (!get_ec_key(env, argv[1], argv[2], atom_undefined, &key)) - return enif_make_badarg(env); + return make_badarg_maybe(env); group = EC_GROUP_dup(EC_KEY_get0_group(key)); priv_key = EC_KEY_get0_private_key(key); diff --git a/lib/kernel/doc/src/rpc.xml b/lib/kernel/doc/src/rpc.xml index be1641ffd9..f8d81d749d 100644 --- a/lib/kernel/doc/src/rpc.xml +++ b/lib/kernel/doc/src/rpc.xml @@ -325,7 +325,8 @@ </func> <func> - <name name="pinfo" arity="2"/> + <name name="pinfo" arity="2" clause_i="1"/> + <name name="pinfo" arity="2" clause_i="2"/> <fsummary>Information about a process.</fsummary> <desc> <p>Location transparent version of the BIF diff --git a/lib/kernel/src/rpc.erl b/lib/kernel/src/rpc.erl index 0e1e3f070c..5f83713cf7 100644 --- a/lib/kernel/src/rpc.erl +++ b/lib/kernel/src/rpc.erl @@ -727,6 +727,11 @@ pinfo(Pid) -> -spec pinfo(Pid, Item) -> {Item, Info} | undefined | [] when Pid :: pid(), Item :: atom(), + Info :: term(); + (Pid, ItemList) -> [{Item, Info}] | undefined | [] when + Pid :: pid(), + Item :: atom(), + ItemList :: [Item], Info :: term(). pinfo(Pid, Item) when node(Pid) =:= node() -> diff --git a/system/doc/design_principles/sup_princ.xml b/system/doc/design_principles/sup_princ.xml index 5e2f6ba9cb..08c4b7c59e 100644 --- a/system/doc/design_principles/sup_princ.xml +++ b/system/doc/design_principles/sup_princ.xml @@ -229,7 +229,7 @@ child_spec() = #{id => child_id(), % mandatory is <c>rest_for_one</c> or <c>one_for_all</c> and a sibling death causes the temporary process to be terminated).</item> <item>A <c>transient</c> child process is restarted only if it - terminates abnormally, that is, with another exit reason than + terminates abnormally, that is, with an exit reason other than <c>normal</c>, <c>shutdown</c>, or <c>{shutdown,Term}</c>.</item> </list> <p>The <c>restart</c> key is optional. If it is not given, the diff --git a/system/doc/programming_examples/funs.xmlsrc b/system/doc/programming_examples/funs.xmlsrc index 8469f0871c..1e1002ccf9 100644 --- a/system/doc/programming_examples/funs.xmlsrc +++ b/system/doc/programming_examples/funs.xmlsrc @@ -212,7 +212,7 @@ f(...) -> ... end, ...) ...</code> - <p>instead of writng the following code:</p> + <p>instead of writing the following code:</p> <code type="none"> f(...) -> Y = ... diff --git a/system/doc/top/templates/index.html.src b/system/doc/top/templates/index.html.src index bdac3895b0..ef2e2916a4 100644 --- a/system/doc/top/templates/index.html.src +++ b/system/doc/top/templates/index.html.src @@ -145,10 +145,10 @@ verification, comment support including paragraph filling, skeletons, tags support and more. See the <a href="#tools#/index.html"> Tools</a> application for details. <p> -There is also an -<a href="http://erlide.org/index.html"> -Erlang plugin (ErlIDE) for Eclipse</a> if you prefer a more graphical -environment. ErlIDE is under active development with new features in almost every release. +There are also Erlang plugins for +<a href="http://erlide.org/index.html">Eclipse (ErlIDE)</a> and +<a href="http://ignatov.github.io/intellij-erlang/">IntelliJ IDEA</a> +if you prefer a more graphical environment, which are both under active development. <li>When developing with Erlang/OTP you usually test your programs from the interactive shell (see <a href="getting_started/users_guide.html"> Getting Started With Erlang</a>) where you can call individual |