diff options
author | Björn Gustavsson <[email protected]> | 2016-06-29 11:39:15 +0200 |
---|---|---|
committer | Björn Gustavsson <[email protected]> | 2016-06-29 11:39:15 +0200 |
commit | 04e9514bca9434676f6ee9548febb8d4d1a1a847 (patch) | |
tree | ba70a8d9f06c620d0643135a376f22de43e7d8b6 | |
parent | 1e0ef3f2285eae3bd00047c4f10c4a44084e1aa9 (diff) | |
parent | b23b3f903e2cfac2f9b9faac7c7fa19c0ec8f625 (diff) | |
download | otp-04e9514bca9434676f6ee9548febb8d4d1a1a847.tar.gz otp-04e9514bca9434676f6ee9548febb8d4d1a1a847.tar.bz2 otp-04e9514bca9434676f6ee9548febb8d4d1a1a847.zip |
Merge branch 'bjorn/gc-bifs'
* bjorn/gc-bifs:
compiler: Eliminate num_bif_SUITE
erl_internal: Eliminate duplication of guard tests
beam_debug: Improve the disassembly of gc_bif instructions
Simplify creation of new GC BIFs
make_tables: Remove broken automatic BIF aliasing
-rw-r--r-- | erts/emulator/Makefile.in | 5 | ||||
-rw-r--r-- | erts/emulator/beam/beam_debug.c | 55 | ||||
-rw-r--r-- | erts/emulator/beam/beam_emu.c | 31 | ||||
-rw-r--r-- | erts/emulator/beam/beam_load.c | 111 | ||||
-rw-r--r-- | erts/emulator/beam/bif.tab | 38 | ||||
-rw-r--r-- | erts/emulator/beam/global.h | 12 | ||||
-rwxr-xr-x | erts/emulator/utils/make_tables | 53 | ||||
-rw-r--r-- | lib/compiler/test/Makefile | 4 | ||||
-rw-r--r-- | lib/compiler/test/bif_SUITE.erl | 45 | ||||
-rw-r--r-- | lib/compiler/test/num_bif_SUITE.erl | 285 | ||||
-rw-r--r-- | lib/stdlib/src/erl_internal.erl | 47 |
11 files changed, 196 insertions, 490 deletions
diff --git a/erts/emulator/Makefile.in b/erts/emulator/Makefile.in index 2212aed5e0..6cbf22066c 100644 --- a/erts/emulator/Makefile.in +++ b/erts/emulator/Makefile.in @@ -562,9 +562,9 @@ $(TARGET)/erl_bif_table.c \ $(TARGET)/erl_bif_table.h \ $(TARGET)/erl_bif_wrap.c \ $(TARGET)/erl_bif_list.h \ +$(TARGET)/erl_gc_bifs.c \ $(TARGET)/erl_atom_table.c \ $(TARGET)/erl_atom_table.h \ -$(TARGET)/erl_pbifs.c \ : $(TARGET)/TABLES-GENERATED $(TARGET)/TABLES-GENERATED: $(ATOMS) $(BIFS) utils/make_tables $(gen_verbose)LANG=C $(PERL) utils/make_tables -src $(TARGET) -include $(TARGET)\ @@ -744,7 +744,7 @@ EMU_OBJS = \ $(OBJDIR)/beam_ranges.o RUN_OBJS = \ - $(OBJDIR)/erl_pbifs.o $(OBJDIR)/benchmark.o \ + $(OBJDIR)/benchmark.o \ $(OBJDIR)/erl_alloc.o $(OBJDIR)/erl_mtrace.o \ $(OBJDIR)/erl_alloc_util.o $(OBJDIR)/erl_goodfit_alloc.o \ $(OBJDIR)/erl_bestfit_alloc.o $(OBJDIR)/erl_afit_alloc.o \ @@ -755,6 +755,7 @@ RUN_OBJS = \ $(OBJDIR)/erl_bif_os.o $(OBJDIR)/erl_bif_lists.o \ $(OBJDIR)/erl_bif_trace.o $(OBJDIR)/erl_bif_unique.o \ $(OBJDIR)/erl_bif_wrap.o \ + $(OBJDIR)/erl_gc_bifs.o \ $(OBJDIR)/erl_trace.o $(OBJDIR)/copy.o \ $(OBJDIR)/utils.o $(OBJDIR)/bif.o \ $(OBJDIR)/io.o $(OBJDIR)/erl_printf_term.o\ diff --git a/erts/emulator/beam/beam_debug.c b/erts/emulator/beam/beam_debug.c index a4ad3e7886..8f47ed4d9d 100644 --- a/erts/emulator/beam/beam_debug.c +++ b/erts/emulator/beam/beam_debug.c @@ -51,6 +51,7 @@ void dbg_bt(Process* p, Eterm* sp); void dbg_where(BeamInstr* addr, Eterm x0, Eterm* reg); static int print_op(int to, void *to_arg, int op, int size, BeamInstr* addr); +static void print_bif_name(int to, void* to_arg, BifFunction bif); BIF_RETTYPE erts_debug_same_2(BIF_ALIST_2) @@ -520,7 +521,27 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) break; case 'I': /* Untagged integer. */ case 't': - erts_print(to, to_arg, "%d", *ap); + switch (op) { + case op_i_gc_bif1_jIsId: + case op_i_gc_bif2_jIIssd: + case op_i_gc_bif3_jIIssd: + { + const ErtsGcBif* p; + BifFunction gcf = (BifFunction) *ap; + for (p = erts_gc_bifs; p->bif != 0; p++) { + if (p->gc_bif == gcf) { + print_bif_name(to, to_arg, p->bif); + break; + } + } + if (p->bif == 0) { + erts_print(to, to_arg, "%d", (Uint)gcf); + } + break; + } + default: + erts_print(to, to_arg, "%d", *ap); + } ap++; break; case 'f': /* Destination label */ @@ -560,19 +581,7 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) case 'F': /* Function definition */ break; case 'b': - for (i = 0; i < BIF_SIZE; i++) { - BifFunction bif = (BifFunction) *ap; - if (bif == bif_table[i].f) { - break; - } - } - if (i == BIF_SIZE) { - erts_print(to, to_arg, "b(%d)", (Uint) *ap); - } else { - Eterm name = bif_table[i].name; - unsigned arity = bif_table[i].arity; - erts_print(to, to_arg, "%T/%u", name, arity); - } + print_bif_name(to, to_arg, (BifFunction) *ap); ap++; break; case 'P': /* Byte offset into tuple (see beam_load.c) */ @@ -731,3 +740,21 @@ print_op(int to, void *to_arg, int op, int size, BeamInstr* addr) return size; } + +static void print_bif_name(int to, void* to_arg, BifFunction bif) +{ + int i; + + for (i = 0; i < BIF_SIZE; i++) { + if (bif == bif_table[i].f) { + break; + } + } + if (i == BIF_SIZE) { + erts_print(to, to_arg, "b(%d)", (Uint) bif); + } else { + Eterm name = bif_table[i].name; + unsigned arity = bif_table[i].arity; + erts_print(to, to_arg, "%T/%u", name, arity); + } +} diff --git a/erts/emulator/beam/beam_emu.c b/erts/emulator/beam/beam_emu.c index 4716460a6b..c9fb5a3022 100644 --- a/erts/emulator/beam/beam_emu.c +++ b/erts/emulator/beam/beam_emu.c @@ -5428,31 +5428,14 @@ void erts_dirty_process_main(ErtsSchedulerData *esdp) static BifFunction translate_gc_bif(void* gcf) { - if (gcf == erts_gc_length_1) { - return length_1; - } else if (gcf == erts_gc_size_1) { - return size_1; - } else if (gcf == erts_gc_bit_size_1) { - return bit_size_1; - } else if (gcf == erts_gc_byte_size_1) { - return byte_size_1; - } else if (gcf == erts_gc_map_size_1) { - return map_size_1; - } else if (gcf == erts_gc_abs_1) { - return abs_1; - } else if (gcf == erts_gc_float_1) { - return float_1; - } else if (gcf == erts_gc_round_1) { - return round_1; - } else if (gcf == erts_gc_trunc_1) { - return round_1; - } else if (gcf == erts_gc_binary_part_2) { - return binary_part_2; - } else if (gcf == erts_gc_binary_part_3) { - return binary_part_3; - } else { - erts_exit(ERTS_ERROR_EXIT, "bad gc bif"); + const ErtsGcBif* p; + + for (p = erts_gc_bifs; p->bif != 0; p++) { + if (p->gc_bif == gcf) { + return p->bif; + } } + erts_exit(ERTS_ERROR_EXIT, "bad gc bif"); } /* diff --git a/erts/emulator/beam/beam_load.c b/erts/emulator/beam/beam_load.c index 4ca2c6a13f..517004d3a0 100644 --- a/erts/emulator/beam/beam_load.c +++ b/erts/emulator/beam/beam_load.c @@ -4013,60 +4013,52 @@ gen_make_fun2(LoaderState* stp, GenOpArg idx) op->next = NULL; return op; } + +static GenOp* +translate_gc_bif(LoaderState* stp, GenOp* op, GenOpArg Bif) +{ + const ErtsGcBif* p; + BifFunction bf; + + bf = stp->import[Bif.val].bf; + for (p = erts_gc_bifs; p->bif != 0; p++) { + if (p->bif == bf) { + op->a[1].type = TAG_u; + op->a[1].val = (BeamInstr) p->gc_bif; + return op; + } + } + + op->op = genop_unsupported_guard_bif_3; + op->arity = 3; + op->a[0].type = TAG_a; + op->a[0].val = stp->import[Bif.val].module; + op->a[1].type = TAG_a; + op->a[1].val = stp->import[Bif.val].function; + op->a[2].type = TAG_u; + op->a[2].val = stp->import[Bif.val].arity; + return op; +} + /* - * Rewrite gc_bifs with one parameter (the common case). Utilized - * in ops.tab to rewrite instructions calling bif's in guards - * to use a garbage collecting implementation. + * Rewrite gc_bifs with one parameter (the common case). */ static GenOp* gen_guard_bif1(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, GenOpArg Src, GenOpArg Dst) { GenOp* op; - BifFunction bf; NEW_GENOP(stp, op); op->next = NULL; - bf = stp->import[Bif.val].bf; - /* The translations here need to have a reverse counterpart in - beam_emu.c:translate_gc_bif for error handling to work properly. */ - if (bf == length_1) { - op->a[1].val = (BeamInstr) (void *) erts_gc_length_1; - } else if (bf == size_1) { - op->a[1].val = (BeamInstr) (void *) erts_gc_size_1; - } else if (bf == bit_size_1) { - op->a[1].val = (BeamInstr) (void *) erts_gc_bit_size_1; - } else if (bf == byte_size_1) { - op->a[1].val = (BeamInstr) (void *) erts_gc_byte_size_1; - } else if (bf == map_size_1) { - op->a[1].val = (BeamInstr) (void *) erts_gc_map_size_1; - } else if (bf == abs_1) { - op->a[1].val = (BeamInstr) (void *) erts_gc_abs_1; - } else if (bf == float_1) { - op->a[1].val = (BeamInstr) (void *) erts_gc_float_1; - } else if (bf == round_1) { - op->a[1].val = (BeamInstr) (void *) erts_gc_round_1; - } else if (bf == trunc_1) { - op->a[1].val = (BeamInstr) (void *) erts_gc_trunc_1; - } else { - op->op = genop_unsupported_guard_bif_3; - op->arity = 3; - op->a[0].type = TAG_a; - op->a[0].val = stp->import[Bif.val].module; - op->a[1].type = TAG_a; - op->a[1].val = stp->import[Bif.val].function; - op->a[2].type = TAG_u; - op->a[2].val = stp->import[Bif.val].arity; - return op; - } op->op = genop_i_gc_bif1_5; op->arity = 5; op->a[0] = Fail; - op->a[1].type = TAG_u; + /* op->a[1] is set by translate_gc_bif() */ op->a[2] = Src; op->a[3] = Live; op->a[4] = Dst; - return op; + return translate_gc_bif(stp, op, Bif); } /* @@ -4077,35 +4069,18 @@ gen_guard_bif2(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, GenOpArg S1, GenOpArg S2, GenOpArg Dst) { GenOp* op; - BifFunction bf; NEW_GENOP(stp, op); op->next = NULL; - bf = stp->import[Bif.val].bf; - /* The translations here need to have a reverse counterpart in - beam_emu.c:translate_gc_bif for error handling to work properly. */ - if (bf == binary_part_2) { - op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_2; - } else { - op->op = genop_unsupported_guard_bif_3; - op->arity = 3; - op->a[0].type = TAG_a; - op->a[0].val = stp->import[Bif.val].module; - op->a[1].type = TAG_a; - op->a[1].val = stp->import[Bif.val].function; - op->a[2].type = TAG_u; - op->a[2].val = stp->import[Bif.val].arity; - return op; - } op->op = genop_i_gc_bif2_6; op->arity = 6; op->a[0] = Fail; - op->a[1].type = TAG_u; + /* op->a[1] is set by translate_gc_bif() */ op->a[2] = Live; op->a[3] = S1; op->a[4] = S2; op->a[5] = Dst; - return op; + return translate_gc_bif(stp, op, Bif); } /* @@ -4116,37 +4091,19 @@ gen_guard_bif3(LoaderState* stp, GenOpArg Fail, GenOpArg Live, GenOpArg Bif, GenOpArg S1, GenOpArg S2, GenOpArg S3, GenOpArg Dst) { GenOp* op; - BifFunction bf; NEW_GENOP(stp, op); op->next = NULL; - bf = stp->import[Bif.val].bf; - /* The translations here need to have a reverse counterpart in - beam_emu.c:translate_gc_bif for error handling to work properly. */ - if (bf == binary_part_3) { - op->a[1].val = (BeamInstr) (void *) erts_gc_binary_part_3; - } else { - op->op = genop_unsupported_guard_bif_3; - op->arity = 3; - op->a[0].type = TAG_a; - op->a[0].val = stp->import[Bif.val].module; - op->a[1].type = TAG_a; - op->a[1].val = stp->import[Bif.val].function; - op->a[2].type = TAG_u; - op->a[2].val = stp->import[Bif.val].arity; - return op; - } op->op = genop_ii_gc_bif3_7; op->arity = 7; op->a[0] = Fail; - op->a[1].type = TAG_u; + /* op->a[1] is set by translate_gc_bif() */ op->a[2] = Live; op->a[3] = S1; op->a[4] = S2; op->a[5] = S3; op->a[6] = Dst; - op->next = NULL; - return op; + return translate_gc_bif(stp, op, Bif); } static GenOp* diff --git a/erts/emulator/beam/bif.tab b/erts/emulator/beam/bif.tab index 065018514a..978bcd4bba 100644 --- a/erts/emulator/beam/bif.tab +++ b/erts/emulator/beam/bif.tab @@ -23,22 +23,24 @@ # # Lines starting with '#' are ignored. # -# <bif-decl> ::= "bif" <bif> <C-name>* | "ubif" <bif> <C-name>* +# <bif-decl> ::= "bif" <bif> <C-name>* | +# "ubif" <bif> <C-name>* | +# "gcbif" <bif> <C-name>* # <bif> ::= <module> ":" <name> "/" <arity> # -# "ubif" is an unwrapped bif, i.e. a bif without a trace wrapper, -# or rather; the trace entry point in the export entry is the same -# as the normal entry point, and no trace wrapper is generated. +# ubif: Use for operators and guard BIFs that never build anything +# on the heap (such as tuple_size/1) and operators. # -# Important: Use "ubif" for guard BIFs and operators; use "bif" for ordinary BIFs. +# gcbif: Use for guard BIFs that may build on the heap (such as abs/1). +# +# bif: Use for all other BIFs. # # Add new BIFs to the end of the file. # -# Note: Guards BIFs require special support in the compiler (to be able to actually -# call them from within a guard). +# Note: Guards BIFs usually require special support in the compiler. # -ubif erlang:abs/1 +gcbif erlang:abs/1 bif erlang:adler32/1 bif erlang:adler32/2 bif erlang:adler32_combine/3 @@ -62,7 +64,7 @@ bif erlang:exit/1 bif erlang:exit/2 bif erlang:external_size/1 bif erlang:external_size/2 -ubif erlang:float/1 +gcbif erlang:float/1 bif erlang:float_to_list/1 bif erlang:float_to_list/2 bif erlang:fun_info/2 @@ -79,7 +81,7 @@ bif erlang:phash2/2 ubif erlang:hd/1 bif erlang:integer_to_list/1 bif erlang:is_alive/0 -ubif erlang:length/1 +gcbif erlang:length/1 bif erlang:link/1 bif erlang:list_to_atom/1 bif erlang:list_to_binary/1 @@ -126,10 +128,10 @@ bif erlang:processes/0 bif erlang:put/2 bif erlang:register/2 bif erlang:registered/0 -ubif erlang:round/1 +gcbif erlang:round/1 ubif erlang:self/0 bif erlang:setelement/3 -ubif erlang:size/1 +gcbif erlang:size/1 bif erlang:spawn/3 bif erlang:spawn_link/3 bif erlang:split_binary/2 @@ -139,7 +141,7 @@ bif erlang:term_to_binary/2 bif erlang:throw/1 bif erlang:time/0 ubif erlang:tl/1 -ubif erlang:trunc/1 +gcbif erlang:trunc/1 bif erlang:tuple_to_list/1 bif erlang:universaltime/0 bif erlang:universaltime_to_localtime/1 @@ -461,8 +463,8 @@ bif erlang:list_to_existing_atom/1 # ubif erlang:is_bitstring/1 ubif erlang:tuple_size/1 -ubif erlang:byte_size/1 -ubif erlang:bit_size/1 +gcbif erlang:byte_size/1 +gcbif erlang:bit_size/1 bif erlang:list_to_bitstring/1 bif erlang:bitstring_to_list/1 @@ -514,8 +516,8 @@ bif erlang:binary_to_term/2 # # The searching/splitting/substituting thingies # -ubif erlang:binary_part/2 -ubif erlang:binary_part/3 +gcbif erlang:binary_part/2 +gcbif erlang:binary_part/3 bif binary:compile_pattern/1 bif binary:match/2 @@ -607,7 +609,7 @@ bif os:unsetenv/1 bif re:inspect/2 ubif erlang:is_map/1 -ubif erlang:map_size/1 +gcbif erlang:map_size/1 bif maps:to_list/1 bif maps:find/2 bif maps:get/2 diff --git a/erts/emulator/beam/global.h b/erts/emulator/beam/global.h index f3d4ac56cd..961260041f 100644 --- a/erts/emulator/beam/global.h +++ b/erts/emulator/beam/global.h @@ -1427,18 +1427,6 @@ Eterm erts_gc_bor(Process* p, Eterm* reg, Uint live); Eterm erts_gc_bxor(Process* p, Eterm* reg, Uint live); Eterm erts_gc_bnot(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_length_1(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_size_1(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_bit_size_1(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_byte_size_1(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_map_size_1(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_abs_1(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_float_1(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_round_1(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_trunc_1(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_binary_part_3(Process* p, Eterm* reg, Uint live); -Eterm erts_gc_binary_part_2(Process* p, Eterm* reg, Uint live); - Uint erts_current_reductions(Process* current, Process *p); int erts_print_system_version(int to, void *arg, Process *c_p); diff --git a/erts/emulator/utils/make_tables b/erts/emulator/utils/make_tables index c158778f43..fc0500d77f 100755 --- a/erts/emulator/utils/make_tables +++ b/erts/emulator/utils/make_tables @@ -36,7 +36,6 @@ use File::Basename; # <-src>/erl_am.c # <-src>/erl_bif_table.c # <-src>/erl_bif_wrap.c -# <-src>/erl_pbifs.c # <-include>/erl_atom_table.h # <-include>/erl_bif_table.h # @@ -54,8 +53,7 @@ my %aliases; my $auto_alias_num = 0; my @bif; -my @implementation; -my @pbif; +my @bif_type; while (@ARGV && $ARGV[0] =~ /^-(\w+)/) { my $opt = shift; @@ -79,8 +77,11 @@ while (<>) { my($type, @args) = split; if ($type eq 'atom') { save_atoms(@args); - } elsif ($type eq 'bif' or $type eq 'ubif') { - my($bif,$alias,$alias2) = (@args); + } elsif ($type eq 'bif' or $type eq 'ubif' or $type eq 'gcbif') { + if (@args > 2) { + error("$type only allows two arguments"); + } + my($bif,$alias) = (@args); $bif =~ m@^([a-z_.'0-9]+):(.*)/(\d)$@ or error("invalid BIF"); my($mod,$name,$arity) = ($1,$2,$3); save_atoms($mod, $name); @@ -94,8 +95,7 @@ while (<>) { $wrapper = $alias if $type eq 'ubif'; push(@bif, ["am_$atom_alias{$mod}","am_$atom_alias{$name}",$arity, $alias,$wrapper]); - push(@pbif, $bif =~ m/^'/ && $alias =~ m/^ebif_/); - push(@implementation, $alias2); + push(@bif_type, $type); } else { error("invalid line"); } @@ -166,8 +166,14 @@ typedef struct bif_entry { BifFunction traced; } BifEntry; +typedef struct erts_gc_bif { + BifFunction bif; + BifFunction gc_bif; +} ErtsGcBif; + extern BifEntry bif_table[]; extern Export* bif_export[]; +extern const ErtsGcBif erts_gc_bifs[]; #define BIF_SIZE $bif_size @@ -182,8 +188,12 @@ print "\n"; for ($i = 0; $i < @bif; $i++) { my $args = join(', ', 'Process*', 'Eterm*'); - print "Eterm $bif[$i]->[3]($args);\n"; - print "Eterm wrap_$bif[$i]->[3]($args, UWord *I);\n"; + my $name = $bif[$i]->[3]; + print "Eterm $name($args);\n"; + print "Eterm wrap_$name($args, UWord *I);\n"; + print "Eterm erts_gc_$name(Process* p, Eterm* reg, Uint live);\n" + if $bif_type[$i] eq 'gcbif'; + print "\n"; } print "#endif\n"; @@ -225,27 +235,26 @@ for ($i = 0; $i < @bif; $i++) { } # -# Generate the package bif file. +# Generate erl_gc_bifs.c. # -open_file("$src/erl_pbifs.c"); +open_file("$src/erl_gc_bifs.c"); my $i; includes("export.h", "sys.h", "erl_vm.h", "global.h", "erl_process.h", "bif.h", - "erl_bif_table.h", "erl_atom_table.h"); + "erl_bif_table.h"); +print "const ErtsGcBif erts_gc_bifs[] = {\n"; for ($i = 0; $i < @bif; $i++) { + next unless $bif_type[$i] eq 'gcbif'; my $arity = $bif[$i]->[2]; my $func = $bif[$i]->[3]; - my $arg; - next unless $pbif[$i]; - next unless $func =~ m/^ebif_(.*)/; - my $orig_func = $1; - $orig_func = $implementation[$i] if $implementation[$i]; - print "Eterm\n"; - print "$func(Process* p, Eterm* BIF__ARGS)\n"; - print "{\n"; - print " return $orig_func(p, BIF__ARGS);\n"; - print "}\n\n"; + print " {$func, erts_gc_$func},\n"; } +print " {0, 0}\n"; +print "};\n"; + +# +# Utilities follow. +# sub open_file { # or die my($name) = @_; diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index f0185acbc7..365f4c295e 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -36,7 +36,6 @@ MODULES= \ map_SUITE \ match_SUITE \ misc_SUITE \ - num_bif_SUITE \ receive_SUITE \ record_SUITE \ regressions_SUITE \ @@ -67,7 +66,6 @@ NO_OPT= \ map \ match \ misc \ - num_bif \ receive \ record \ trycatch @@ -78,6 +76,7 @@ INLINE= \ beam_block \ beam_bool \ beam_utils \ + bif \ bs_bincomp \ bs_bit_binaries \ bs_construct \ @@ -91,7 +90,6 @@ INLINE= \ map \ match \ misc \ - num_bif \ receive \ record diff --git a/lib/compiler/test/bif_SUITE.erl b/lib/compiler/test/bif_SUITE.erl index 51bc71da81..6d7231b426 100644 --- a/lib/compiler/test/bif_SUITE.erl +++ b/lib/compiler/test/bif_SUITE.erl @@ -19,9 +19,11 @@ %% -module(bif_SUITE). +-include_lib("syntax_tools/include/merl.hrl"). + -export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, init_per_group/2,end_per_group/2, - beam_validator/1]). + beam_validator/1,trunc_and_friends/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -32,7 +34,8 @@ all() -> groups() -> [{p,[parallel], - [beam_validator + [beam_validator, + trunc_and_friends ]}]. init_per_suite(Config) -> @@ -63,3 +66,41 @@ food(Curriculum) -> catch _ -> 0 end, Curriculum]. + +%% Test trunc/1, round/1. +trunc_and_friends(_Config) -> + Bifs = [trunc,round], + Fs = trunc_and_friends_1(Bifs), + Mod = ?FUNCTION_NAME, + Calls = [begin + Atom = erl_syntax:function_name(N), + ?Q("'@Atom'()") + end || N <- Fs], + Tree = ?Q(["-module('@Mod@').", + "-export([test/0]).", + "test() -> _@Calls, ok.", + "id(I) -> I."]) ++ Fs, + merl:print(Tree), + Opts = test_lib:opt_opts(?MODULE), + {ok,_Bin} = merl:compile_and_load(Tree, Opts), + Mod:test(), + ok. + +trunc_and_friends_1([F|Fs]) -> + Func = list_to_atom("f"++integer_to_list(length(Fs))), + [trunc_template(Func, F)|trunc_and_friends_1(Fs)]; +trunc_and_friends_1([]) -> []. + +trunc_template(Func, Bif) -> + Val = 42.77, + Res = erlang:Bif(Val), + FloatRes = float(Res), + ?Q("'@Func@'() -> + Var = id(_@Val@), + if _@Bif@(Var) =:= _@Res@ -> ok end, + if _@Bif@(Var) == _@FloatRes@ -> ok end, + if _@Bif@(Var) == _@Res@ -> ok end, + _@Res@ = _@Bif@(Var), + try begin _@Bif@(a), ok end + catch error:badarg -> ok end, + ok."). diff --git a/lib/compiler/test/num_bif_SUITE.erl b/lib/compiler/test/num_bif_SUITE.erl deleted file mode 100644 index 7eac90bac3..0000000000 --- a/lib/compiler/test/num_bif_SUITE.erl +++ /dev/null @@ -1,285 +0,0 @@ -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2004-2016. All Rights Reserved. -%% -%% Licensed under the Apache License, Version 2.0 (the "License"); -%% you may not use this file except in compliance with the License. -%% You may obtain a copy of the License at -%% -%% http://www.apache.org/licenses/LICENSE-2.0 -%% -%% Unless required by applicable law or agreed to in writing, software -%% distributed under the License is distributed on an "AS IS" BASIS, -%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -%% See the License for the specific language governing permissions and -%% limitations under the License. -%% -%% %CopyrightEnd% -%% --module(num_bif_SUITE). - --include_lib("common_test/include/ct.hrl"). - -%% Tests optimization of the BIFs: -%% abs/1 -%% float/1 -%% float_to_list/1 -%% integer_to_list/1 -%% list_to_float/1 -%% list_to_integer/1 -%% round/1 -%% trunc/1 - --export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, - init_per_group/2,end_per_group/2, t_abs/1, t_float/1, - t_float_to_list/1, t_integer_to_list/1, - t_list_to_integer/1, - t_list_to_float_safe/1, t_list_to_float_risky/1, - t_round/1, t_trunc/1]). - -suite() -> [{ct_hooks,[ts_install_cth]}]. - -all() -> - test_lib:recompile(?MODULE), - [t_abs, t_float, t_float_to_list, t_integer_to_list, - {group, t_list_to_float}, t_list_to_integer, t_round, - t_trunc]. - -groups() -> - [{t_list_to_float, [], - [t_list_to_float_safe, t_list_to_float_risky]}]. - -init_per_suite(Config) -> - Config. - -end_per_suite(_Config) -> - ok. - -init_per_group(_GroupName, Config) -> - Config. - -end_per_group(_GroupName, Config) -> - Config. - - -t_abs(Config) when is_list(Config) -> - %% Floats. - 5.5 = abs(5.5), - 0.0 = abs(0.0), - 100.0 = abs(-100.0), - - %% Integers. - 5 = abs(5), - 0 = abs(0), - 100 = abs(-100), - - %% The largest smallnum. OTP-3190. - X = (1 bsl 27) - 1, - X = abs(X), - X = abs(X-1)+1, - X = abs(X+1)-1, - X = abs(-X), - X = abs(-X-1)-1, - X = abs(-X+1)+1, - - %% Bignums. - BigNum = 13984792374983749, - BigNum = abs(BigNum), - BigNum = abs(-BigNum), - ok. - -t_float(Config) when is_list(Config) -> - 0.0 = float(0), - 2.5 = float(2.5), - 0.0 = float(0.0), - -100.55 = float(-100.55), - 42.0 = float(42), - -100.0 = float(-100), - - %% Bignums. - 4294967305.0 = float(4294967305), - -4294967305.0 = float(-4294967305), - - %% Extremly big bignums. - Big = list_to_integer(lists:duplicate(2000, $1)), - {'EXIT', {badarg, _}} = (catch float(Big)), - - %% Invalid types and lists. - {'EXIT', {badarg, _}} = (catch list_to_integer(atom)), - {'EXIT', {badarg, _}} = (catch list_to_integer(123)), - {'EXIT', {badarg, _}} = (catch list_to_integer([$1, [$2]])), - {'EXIT', {badarg, _}} = (catch list_to_integer("1.2")), - {'EXIT', {badarg, _}} = (catch list_to_integer("a")), - {'EXIT', {badarg, _}} = (catch list_to_integer("")), - ok. - - -%% Tests float_to_list/1. - -t_float_to_list(Config) when is_list(Config) -> - test_ftl("0.0e+0", 0.0), - test_ftl("2.5e+1", 25.0), - test_ftl("2.5e+0", 2.5), - test_ftl("2.5e-1", 0.25), - test_ftl("-3.5e+17", -350.0e15), - ok. - -test_ftl(Expect, Float) -> - %% No on the next line -- we want the line number from t_float_to_list. - Expect = remove_zeros(lists:reverse(float_to_list(Float)), []). - -%% Removes any non-significant zeros in a floating point number. -%% Example: 2.500000e+01 -> 2.5e+1 - -remove_zeros([$+, $e|Rest], [$0, X|Result]) -> - remove_zeros([$+, $e|Rest], [X|Result]); -remove_zeros([$-, $e|Rest], [$0, X|Result]) -> - remove_zeros([$-, $e|Rest], [X|Result]); -remove_zeros([$0, $.|Rest], [$e|Result]) -> - remove_zeros(Rest, [$., $0, $e|Result]); -remove_zeros([$0|Rest], [$e|Result]) -> - remove_zeros(Rest, [$e|Result]); -remove_zeros([Char|Rest], Result) -> - remove_zeros(Rest, [Char|Result]); -remove_zeros([], Result) -> - Result. - -%% Tests integer_to_list/1. - -t_integer_to_list(Config) when is_list(Config) -> - "0" = integer_to_list(0), - "42" = integer_to_list(42), - "-42" = integer_to_list(-42), - "-42" = integer_to_list(-42), - "32768" = integer_to_list(32768), - "268435455" = integer_to_list(268435455), - "-268435455" = integer_to_list(-268435455), - "123456932798748738738" = integer_to_list(123456932798748738738), - Big_List = lists:duplicate(2000, $1), - Big = list_to_integer(Big_List), - Big_List = integer_to_list(Big), - ok. - -%% Tests list_to_float/1. - - -t_list_to_float_safe(Config) when is_list(Config) -> - 0.0 = list_to_float("0.0"), - 0.0 = list_to_float("-0.0"), - 0.5 = list_to_float("0.5"), - -0.5 = list_to_float("-0.5"), - 100.0 = list_to_float("1.0e2"), - 127.5 = list_to_float("127.5"), - -199.5 = list_to_float("-199.5"), - - {'EXIT', {badarg, _}} = (catch list_to_float("0")), - {'EXIT', {badarg, _}} = (catch list_to_float("0..0")), - {'EXIT', {badarg, _}} = (catch list_to_float("0e12")), - {'EXIT', {badarg, _}} = (catch list_to_float("--0.0")), -%% {'EXIT', {badarg, _}} = (catch list_to_float("0.0e+99999999")), - - ok. - -%% This might crash the emulator... -%% (Known to crash the Unix version of Erlang 4.4.1) - -t_list_to_float_risky(Config) when is_list(Config) -> - Many_Ones = lists:duplicate(25000, $1), - _ = list_to_float("2."++Many_Ones), - {'EXIT', {badarg, _}} = (catch list_to_float("2"++Many_Ones)), - ok. - -%% Tests list_to_integer/1. - -t_list_to_integer(Config) when is_list(Config) -> - 0 = list_to_integer("0"), - 0 = list_to_integer("00"), - 0 = list_to_integer("-0"), - 1 = list_to_integer("1"), - -1 = list_to_integer("-1"), - 42 = list_to_integer("42"), - -12 = list_to_integer("-12"), - 32768 = list_to_integer("32768"), - 268435455 = list_to_integer("268435455"), - -268435455 = list_to_integer("-268435455"), - - %% Bignums. - 123456932798748738738 = list_to_integer("123456932798748738738"), - _ = list_to_integer(lists:duplicate(2000, $1)), - ok. - -%% Tests round/1. - -t_round(Config) when is_list(Config) -> - 0 = round(0.0), - 0 = round(0.4), - 1 = round(0.5), - 0 = round(-0.4), - -1 = round(-0.5), - 255 = round(255.3), - 256 = round(255.6), - -1033 = round(-1033.3), - -1034 = round(-1033.6), - - % OTP-3722: - X = (1 bsl 27) - 1, - MX = -X, - MXm1 = -X-1, - MXp1 = -X+1, - F = X + 0.0, - X = round(F), - X = round(F+1)-1, - X = round(F-1)+1, - MX = round(-F), - MXm1 = round(-F-1), - MXp1 = round(-F+1), - - X = round(F+0.1), - X = round(F+1+0.1)-1, - X = round(F-1+0.1)+1, - MX = round(-F+0.1), - MXm1 = round(-F-1+0.1), - MXp1 = round(-F+1+0.1), - - X = round(F-0.1), - X = round(F+1-0.1)-1, - X = round(F-1-0.1)+1, - MX = round(-F-0.1), - MXm1 = round(-F-1-0.1), - MXp1 = round(-F+1-0.1), - - 0.5 = abs(round(F+0.5)-(F+0.5)), - 0.5 = abs(round(F-0.5)-(F-0.5)), - 0.5 = abs(round(-F-0.5)-(-F-0.5)), - 0.5 = abs(round(-F+0.5)-(-F+0.5)), - - %% Bignums. - 4294967296 = round(4294967296.1), - 4294967297 = round(4294967296.9), - -4294967296 = -round(4294967296.1), - -4294967297 = -round(4294967296.9), - ok. - -t_trunc(Config) when is_list(Config) -> - 0 = trunc(0.0), - 5 = trunc(5.3333), - -10 = trunc(-10.978987), - % The largest smallnum, converted to float (OTP-3722): - X = (1 bsl 27) - 1, - F = X + 0.0, - io:format("X = ~p/~w/~w, F = ~p/~w/~w, trunc(F) = ~p/~w/~w~n", - [X, X, binary_to_list(term_to_binary(X)), - F, F, binary_to_list(term_to_binary(F)), - trunc(F), trunc(F), binary_to_list(term_to_binary(trunc(F)))]), - X = trunc(F), - X = trunc(F+1)-1, - X = trunc(F-1)+1, - X = -trunc(-F), - X = -trunc(-F-1)-1, - X = -trunc(-F+1)+1, - - %% Bignums. - 4294967305 = trunc(4294967305.7), - -4294967305 = trunc(-4294967305.7), - ok. diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index c08328b4b7..46059f42a5 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -61,42 +61,26 @@ Name :: atom(), Arity :: arity(). +%% Please keep the alphabetical order. guard_bif(abs, 1) -> true; -guard_bif(float, 1) -> true; -guard_bif(trunc, 1) -> true; -guard_bif(round, 1) -> true; -guard_bif(length, 1) -> true; -guard_bif(hd, 1) -> true; -guard_bif(tl, 1) -> true; -guard_bif(size, 1) -> true; +guard_bif(binary_part, 2) -> true; +guard_bif(binary_part, 3) -> true; guard_bif(bit_size, 1) -> true; guard_bif(byte_size, 1) -> true; guard_bif(element, 2) -> true; -guard_bif(self, 0) -> true; +guard_bif(float, 1) -> true; +guard_bif(hd, 1) -> true; +guard_bif(length, 1) -> true; guard_bif(map_size, 1) -> true; guard_bif(node, 0) -> true; guard_bif(node, 1) -> true; +guard_bif(round, 1) -> true; +guard_bif(self, 0) -> true; +guard_bif(size, 1) -> true; +guard_bif(tl, 1) -> true; +guard_bif(trunc, 1) -> true; guard_bif(tuple_size, 1) -> true; -guard_bif(is_atom, 1) -> true; -guard_bif(is_binary, 1) -> true; -guard_bif(is_bitstring, 1) -> true; -guard_bif(is_boolean, 1) -> true; -guard_bif(is_float, 1) -> true; -guard_bif(is_function, 1) -> true; -guard_bif(is_function, 2) -> true; -guard_bif(is_integer, 1) -> true; -guard_bif(is_list, 1) -> true; -guard_bif(is_map, 1) -> true; -guard_bif(is_number, 1) -> true; -guard_bif(is_pid, 1) -> true; -guard_bif(is_port, 1) -> true; -guard_bif(is_reference, 1) -> true; -guard_bif(is_tuple, 1) -> true; -guard_bif(is_record, 2) -> true; -guard_bif(is_record, 3) -> true; -guard_bif(binary_part, 2) -> true; -guard_bif(binary_part, 3) -> true; -guard_bif(Name, A) when is_atom(Name), is_integer(A) -> false. +guard_bif(Name, A) -> new_type_test(Name, A). %% Erlang type tests. -spec type_test(Name, Arity) -> boolean() when @@ -109,10 +93,11 @@ type_test(Name, Arity) -> %% Erlang new-style type tests. -spec new_type_test(Name::atom(), Arity::arity()) -> boolean(). +%% Please keep the alphabetical order. new_type_test(is_atom, 1) -> true; -new_type_test(is_boolean, 1) -> true; new_type_test(is_binary, 1) -> true; new_type_test(is_bitstring, 1) -> true; +new_type_test(is_boolean, 1) -> true; new_type_test(is_float, 1) -> true; new_type_test(is_function, 1) -> true; new_type_test(is_function, 2) -> true; @@ -122,10 +107,10 @@ new_type_test(is_map, 1) -> true; new_type_test(is_number, 1) -> true; new_type_test(is_pid, 1) -> true; new_type_test(is_port, 1) -> true; -new_type_test(is_reference, 1) -> true; -new_type_test(is_tuple, 1) -> true; new_type_test(is_record, 2) -> true; new_type_test(is_record, 3) -> true; +new_type_test(is_reference, 1) -> true; +new_type_test(is_tuple, 1) -> true; new_type_test(Name, A) when is_atom(Name), is_integer(A) -> false. %% Erlang old-style type tests. |