aboutsummaryrefslogtreecommitdiffstats
path: root/erts/emulator/utils/make_tables
diff options
context:
space:
mode:
Diffstat (limited to 'erts/emulator/utils/make_tables')
-rwxr-xr-xerts/emulator/utils/make_tables227
1 files changed, 195 insertions, 32 deletions
diff --git a/erts/emulator/utils/make_tables b/erts/emulator/utils/make_tables
index c158778f43..47e1528958 100755
--- a/erts/emulator/utils/make_tables
+++ b/erts/emulator/utils/make_tables
@@ -36,7 +36,10 @@ use File::Basename;
# <-src>/erl_am.c
# <-src>/erl_bif_table.c
# <-src>/erl_bif_wrap.c
-# <-src>/erl_pbifs.c
+# <-src>/erl_dirty_bif_wrap.c
+# <-src>/erl_guard_bifs.c
+# <-src>/hipe_nbif_impl.c
+# <-include>/hipe_nbif_impl.h
# <-include>/erl_atom_table.h
# <-include>/erl_bif_table.h
#
@@ -52,10 +55,13 @@ my %atom;
my %atom_alias;
my %aliases;
my $auto_alias_num = 0;
+my %dirty_bif_tab;
my @bif;
-my @implementation;
-my @pbif;
+my @bif_info;
+my $dirty_schedulers = 'no';
+my $dirty_schedulers_test = 'no';
+my $hipe = 'no';
while (@ARGV && $ARGV[0] =~ /^-(\w+)/) {
my $opt = shift;
@@ -67,6 +73,18 @@ while (@ARGV && $ARGV[0] =~ /^-(\w+)/) {
$include = shift;
die "No directory for -include argument specified"
unless defined $include;
+ } elsif($opt eq '-ds') {
+ $dirty_schedulers = shift;
+ die "No -ds argument specified"
+ unless defined $dirty_schedulers;
+ } elsif($opt eq '-dst') {
+ $dirty_schedulers_test = shift;
+ die "No -dst argument specified"
+ unless defined $dirty_schedulers_test;
+ } elsif($opt eq '-hipe') {
+ $hipe = shift;
+ die "No -hipe argument specified"
+ unless defined $hipe;
} else {
usage("bad option: $opt");
}
@@ -79,23 +97,64 @@ 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);
+ my $mfa = "$mod:$name/$arity";
save_atoms($mod, $name);
unless (defined $alias) {
$alias = "";
$alias = "${mod}_" unless $mod eq 'erlang';
$alias .= "${name}_$arity";
}
+ my $sched_type;
+ my $alias3 = $alias;
+
+ $sched_type = $dirty_bif_tab{$mfa};
+
+ if (!$sched_type or ($type eq 'ubif')) {
+ $sched_type = 'normal';
+ }
+ elsif ($sched_type eq 'dirty_cpu') {
+ $alias3 = "schedule_dirty_cpu_$alias"
+ }
+ elsif ($sched_type eq 'dirty_io') {
+ $alias3 = "schedule_dirty_io_$alias"
+ }
+ else {
+ error("invalid sched_type: $sched_type");
+ }
+
my $wrapper;
- $wrapper = "wrap_$alias" if $type eq 'bif';
- $wrapper = $alias if $type eq 'ubif';
+ if ($type eq 'bif') {
+ $wrapper = "wrap_$alias";
+ } else {
+ $wrapper = $alias;
+ }
push(@bif, ["am_$atom_alias{$mod}","am_$atom_alias{$name}",$arity,
- $alias,$wrapper]);
- push(@pbif, $bif =~ m/^'/ && $alias =~ m/^ebif_/);
- push(@implementation, $alias2);
+ $alias3,$wrapper,$alias]);
+ push(@bif_info, [$type, $sched_type, $alias3, $alias]);
+ } elsif ($type eq 'dirty-cpu' or $type eq 'dirty-io'
+ or $type eq 'dirty-cpu-test' or $type eq 'dirty-io-test') {
+ if ($dirty_schedulers eq 'yes') {
+ my($bif,$other) = (@args);
+ $bif =~ m@^([a-z_.'0-9]+):(.*)/(\d)$@ or error("invalid BIF");
+ my($mod,$name,$arity) = ($1,$2,$3);
+ my $mfa = "$mod:$name/$arity";
+ if (($type eq 'dirty-cpu')
+ or (($dirty_schedulers_test eq 'yes')
+ and ($type eq 'dirty-cpu-test'))) {
+ $dirty_bif_tab{$mfa} = 'dirty_cpu';
+ } elsif (($type eq 'dirty-io')
+ or (($dirty_schedulers_test eq 'yes')
+ and ($type eq 'dirty-io-test'))) {
+ $dirty_bif_tab{$mfa} = 'dirty_io';
+ }
+ }
} else {
error("invalid line");
}
@@ -144,7 +203,7 @@ open_file("$include/erl_bif_list.h");
my $i;
for ($i = 0; $i < @bif; $i++) {
# module atom, function atom, arity, C function, table index
- print "BIF_LIST($bif[$i]->[0],$bif[$i]->[1],$bif[$i]->[2],$bif[$i]->[3],$i)\n";
+ print "BIF_LIST($bif[$i]->[0],$bif[$i]->[1],$bif[$i]->[2],$bif[$i]->[3],$bif[$i]->[5],$i)\n";
}
#
@@ -164,10 +223,24 @@ typedef struct bif_entry {
int arity;
BifFunction f;
BifFunction traced;
+ BifFunction impl;
} BifEntry;
+typedef struct erts_gc_bif {
+ BifFunction bif;
+ BifFunction gc_bif;
+ int exp_ix;
+} ErtsGcBif;
+
+typedef struct erts_u_bif {
+ BifFunction bif;
+ int exp_ix;
+} ErtsUBif;
+
extern BifEntry bif_table[];
extern Export* bif_export[];
+extern const ErtsGcBif erts_gc_bifs[];
+extern const ErtsUBif erts_u_bifs[];
#define BIF_SIZE $bif_size
@@ -175,17 +248,28 @@ EOF
my $i;
for ($i = 0; $i < @bif; $i++) {
- print "#define BIF_$bif[$i]->[3] $i\n";
+ print "#define BIF_$bif_info[$i]->[3] $i\n";
}
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 $args = join(', ', 'Process*', 'Eterm*', 'UWord*');
+ my $name = $bif_info[$i]->[3];
+ print "Eterm $name($args);\n";
+ print "Eterm wrap_$name($args);\n";
+ print "Eterm erts_gc_$name(Process* p, Eterm* reg, Uint live);\n"
+ if $bif_info[$i]->[0] eq 'gcbif';
+ print "Eterm $bif_info[$i]->[2]($args);\n"
+ unless $bif_info[$i]->[1] eq 'normal';
+ print "\n";
+}
+
+if ($hipe eq 'yes') {
+ print "\n#include \"hipe_nbif_impl.h\"\n";
}
-print "#endif\n";
+
+print "\n#endif\n";
#
# Generate the bif table file.
@@ -216,7 +300,7 @@ includes("export.h", "sys.h", "erl_vm.h", "global.h", "erl_process.h", "bif.h",
for ($i = 0; $i < @bif; $i++) {
next if $bif[$i]->[3] eq $bif[$i]->[4]; # Skip unwrapped bifs
my $arity = $bif[$i]->[2];
- my $func = $bif[$i]->[3];
+ my $func = $bif_info[$i]->[3];
print "Eterm\n";
print "wrap_$func(Process* p, Eterm* args, UWord* I)\n";
print "{\n";
@@ -225,28 +309,107 @@ 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_guard_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++) {
- 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";
+ next unless $bif_info[$i]->[0] eq 'gcbif';
+ print " {$bif[$i]->[3], erts_gc_$bif[$i]->[3], BIF_$bif[$i]->[5]},\n";
+}
+print " {NULL, NULL, -1}\n";
+print "};\n";
+
+print "const ErtsUBif erts_u_bifs[] = {\n";
+for ($i = 0; $i < @bif; $i++) {
+ next unless $bif_info[$i]->[0] eq 'ubif';
+ print " {$bif[$i]->[3], BIF_$bif[$i]->[5]},\n";
+}
+print " {NULL, -1}\n";
+print "};\n";
+
+#
+# Generate the dirty bif wrappers file.
+#
+
+open_file("$src/erl_dirty_bif_wrap.c");
+my $i;
+includes("erl_process.h", "erl_nfunc_sched.h", "erl_bif_table.h", "erl_atom_table.h");
+for ($i = 0; $i < @bif_info; $i++) {
+ next if $bif_info[$i]->[1] eq 'normal';
+ my $dtype;
+ if ($bif_info[$i]->[1] eq 'dirty_cpu') {
+ $dtype = "ERTS_SCHED_DIRTY_CPU";
+ }
+ else {
+ $dtype = "ERTS_SCHED_DIRTY_IO";
+ }
+print <<EOF;
+Eterm $bif_info[$i]->[2](Process *c_p, Eterm *regs, BeamInstr *I)
+{
+ return erts_reschedule_bif(c_p, regs, I, $bif_info[$i]->[3], $dtype);
}
+EOF
+
+}
+
+if ($hipe eq 'yes') {
+
+ #
+ # Generate the nbif_impl bif wrappers file.
+ #
+
+ open_file("$src/hipe_nbif_impl.h");
+ print <<EOF;
+
+#ifndef HIPE_NBIF_IMPL_H__
+#define HIPE_NBIF_IMPL_H__
+
+EOF
+
+ my $i;
+ for ($i = 0; $i < @bif; $i++) {
+ print <<EOF;
+Eterm nbif_impl_$bif[$i]->[5](Process *c_p, Eterm *regs);
+EOF
+ }
+
+ print <<EOF;
+
+#endif /* ERL_HIPE_NBIF_IMPL_H__ */
+
+EOF
+
+ #
+ # Generate the nbif_impl bif wrappers file.
+ #
+
+ open_file("$src/hipe_nbif_impl.c");
+ my $i;
+ includes("erl_process.h", "erl_nfunc_sched.h", "erl_bif_table.h", "erl_atom_table.h");
+ for ($i = 0; $i < @bif; $i++) {
+
+ print <<EOF;
+Eterm nbif_impl_$bif[$i]->[5](Process *c_p, Eterm *regs)
+{
+ return $bif[$i]->[3](c_p, regs, (UWord *) bif_export\[BIF_$bif[$i]->[5]\]);
+}
+
+EOF
+
+ }
+
+} # hipe
+
+#
+# Utilities follow.
+#
+
sub open_file { # or die
my($name) = @_;
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-03 12:41:47 +0000