$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)],
+ Perl_pp_print => ['say'],
+ Perl_pp_index => ['rindex'],
+ Perl_pp_oct => ['hex'],
+ Perl_pp_shift => ['pop'],
+ Perl_pp_sin => [qw(cos exp log sqrt)],
+ Perl_pp_bit_or => ['bit_xor'],
+ );
+
+while (my ($func, $names) = splice @raw_alias, 0, 2) {
+ $alias{$_} = $func for @$names;
+}
+
# Emit defines.
$i = 0;
* opcode.h
*
* Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005 by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
#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";
*
* opnames.h
*
- * Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
+ * Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
+ * by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
START_EXTERN_C
#ifdef PERL_GLOBAL_STRUCT_INIT
+# define PERL_PPADDR_INITED
static const Perl_ppaddr_t Gppaddr[]
#else
# ifndef PERL_GLOBAL_STRUCT
+# define PERL_PPADDR_INITED
EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
# endif
#endif /* PERL_GLOBAL_STRUCT */
#if (defined(DOINIT) && !defined(PERL_GLOBAL_STRUCT)) || defined(PERL_GLOBAL_STRUCT_INIT)
+# define PERL_PPADDR_INITED
= {
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;
}
#endif
+#ifdef PERL_PPADDR_INITED
;
+#endif
END
print <<END;
#ifdef PERL_GLOBAL_STRUCT_INIT
+# define PERL_CHECK_INITED
static const Perl_check_t Gcheck[]
#else
# ifndef PERL_GLOBAL_STRUCT
+# define PERL_CHECK_INITED
EXT Perl_check_t PL_check[] /* or perlvars.h */
# endif
#endif
#if (defined(DOINIT) && !defined(PERL_GLOBAL_STRUCT)) || defined(PERL_GLOBAL_STRUCT_INIT)
+# define PERL_CHECK_INITED
= {
END
print <<END;
}
#endif
+#ifdef PERL_CHECK_INITED
;
+#endif /* #ifdef PERL_CHECK_INITED */
END
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-
# File calls.
-chdir chdir ck_fun isT% S?
+# chdir really behaves as if it had both "S?" and "F?"
+chdir chdir ck_chdir isT% S?
chown chown ck_fun imsT@ L
chroot chroot ck_fun isTu% S?
unlink unlink ck_fun imsTu@ L
dor defined or (//) ck_null |
dorassign defined or assignment (//=) ck_null s|
+entergiven given() ck_null d|
+leavegiven leave given block ck_null 1
+enterwhen when() ck_null d|
+leavewhen leave when block ck_null 1
+break break ck_null 0
+continue continue ck_null 0
+smartmatch smart match ck_smartmatch s2
+
+say say ck_say ims@ F? L
+
# Add new ops before this, the custom operator.
custom unknown custom operator ck_null 0
https://perl5.git.perl.org / perl5.git / blobdiff