$args{$key} = $args;
}
+# Set up aliases
+
+my %alias;
+
+# Format is "this function" => "does these op names"
+my @raw_alias = (
+ Perl_do_kv => [qw( keys values )],
+ Perl_unimplemented_op => [qw(padany threadsv mapstart)],
+ # All the ops with a body of { return NORMAL; }
+ Perl_pp_null => [qw(scalar regcmaybe lineseq scope)],
+
+ Perl_pp_goto => ['dump'],
+ Perl_pp_require => ['dofile'],
+ Perl_pp_untie => ['dbmclose'],
+ Perl_pp_sysread => [qw(read recv)],
+ Perl_pp_sysseek => ['seek'],
+ Perl_pp_ioctl => ['fcntl'],
+ Perl_pp_ssockopt => ['gsockopt'],
+ Perl_pp_getpeername => ['getsockname'],
+ Perl_pp_stat => ['lstat'],
+ Perl_pp_ftrowned => [qw(fteowned ftzero ftsock ftchr ftblk
+ ftfile ftdir ftpipe ftsuid ftsgid
+ ftsvtx)],
+ Perl_pp_fttext => ['ftbinary'],
+ Perl_pp_gmtime => ['localtime'],
+ Perl_pp_semget => [qw(shmget msgget)],
+ Perl_pp_semctl => [qw(shmctl msgctl)],
+ Perl_pp_ghostent => [qw(ghbyname ghbyaddr)],
+ Perl_pp_gnetent => [qw(gnbyname gnbyaddr)],
+ Perl_pp_gprotoent => [qw(gpbyname gpbynumber)],
+ Perl_pp_gservent => [qw(gsbyname gsbyport)],
+ Perl_pp_gpwent => [qw(gpwnam gpwuid)],
+ Perl_pp_ggrent => [qw(ggrnam ggrgid)],
+ Perl_pp_ftis => [qw(ftsize ftmtime ftatime ftctime)],
+ Perl_pp_chown => [qw(unlink chmod utime kill)],
+ Perl_pp_link => ['symlink'],
+ Perl_pp_ftrread => [qw(ftrwrite ftrexec fteread ftewrite
+ fteexec)],
+ Perl_pp_shmwrite => [qw(shmread msgsnd msgrcv semop)],
+ Perl_pp_send => ['syswrite'],
+ Perl_pp_defined => [qw(dor dorassign)],
+ Perl_pp_and => ['andassign'],
+ Perl_pp_or => ['orassign'],
+ Perl_pp_ucfirst => ['lcfirst'],
+ Perl_pp_sle => [qw(slt sgt sge)],
+ );
+
+while (my ($func, $names) = splice @raw_alias, 0, 2) {
+ $alias{$_} = $func for @$names;
+}
+
# Emit defines.
$i = 0;
print <<"END";
-/*
+/* -*- buffer-read-only: t -*-
+ *
* opcode.h
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
#define Perl_pp_i_postinc Perl_pp_postinc
#define Perl_pp_i_postdec Perl_pp_postdec
+PERL_PPDEF(Perl_unimplemented_op)
+
END
print ON <<"END";
-/*
+/* -*- buffer-read-only: t -*-
+ *
* opnames.h
*
* Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
END_EXTERN_C
#endif /* !PERL_GLOBAL_STRUCT_INIT */
-
END
# Emit function declarations.
END
for (@ops) {
- print "\tMEMBER_TO_FPTR(Perl_pp_$_),\n" unless $_ eq "custom";
+ $_ eq "custom" and next;
+ if (my $name = $alias{$_}) {
+ print "\tMEMBER_TO_FPTR($name),\t/* Perl_pp_$_ */\n";
+ }
+ else {
+ print "\tMEMBER_TO_FPTR(Perl_pp_$_),\n";
+ }
}
print <<END;
print ON ")\n\n";
}
+print OC "/* ex: set ro: */\n";
+print ON "/* ex: set ro: */\n";
+
close OC or die "Error closing opcode.h: $!";
close ON or die "Error closing opnames.h: $!";
binmode PPSYM;
print PP <<"END";
-/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
+/* -*- buffer-read-only: t -*-
+ !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
This file is built by opcode.pl from its data. Any changes made here
will be lost!
*/
END
print PPSYM <<"END";
+# -*- buffer-read-only: t -*-
#
# !!!!!!! DO NOT EDIT THIS FILE !!!!!!!
# This file is built by opcode.pl from its data. Any changes made here
print PP "PERL_PPDEF(Perl_pp_$_)\n";
print PPSYM "Perl_pp_$_\n";
}
+print PP "\n/* ex: set ro: */\n";
+print PPSYM "\n# ex: set ro:\n";
close PP or die "Error closing pp_proto.h: $!";
close PPSYM or die "Error closing pp.sym: $!";
index index ck_index isT@ S S S?
rindex rindex ck_index isT@ S S S?
-sprintf sprintf ck_fun mfst@ S L
+sprintf sprintf ck_fun mst@ S L
formline formline ck_fun ms@ S L
ord ord ck_fun ifsTu% S?
chr chr ck_fun fsTu% S?
pop pop ck_shift s% A?
shift shift ck_shift s% A?
unshift unshift ck_fun imsT@ A L
-sort sort ck_sort m@ C? L
+sort sort ck_sort dm@ C? L
reverse reverse ck_fun mt@ L
grepstart grep ck_grep dm@ C L
ftewrite -w ck_ftst isu- F-
fteexec -x ck_ftst isu- F-
ftis -e ck_ftst isu- F-
-fteowned -O ck_ftst isu- F-
-ftrowned -o ck_ftst isu- F-
+fteowned -o ck_ftst isu- F-
+ftrowned -O ck_ftst isu- F-
ftzero -z ck_ftst isu- F-
ftsize -s ck_ftst istu- F-
ftmtime -M ck_ftst stu- F-