X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=opcode.pl;h=3316fd9a9f9c417b5040fb624d848ae0c4d5382b;hb=79522dd28c2cdf92c115561db038e46cd34e5073;hp=d9c81b3c81b1bdd703e5d898a029d6ee633cdf82;hpb=1cb0ed9b77e4ba2e0bcbeb9a897574a0fe3f3e52;p=p5sagit%2Fp5-mst-13.2.git diff --git a/opcode.pl b/opcode.pl index d9c81b3..3316fd9 100755 --- a/opcode.pl +++ b/opcode.pl @@ -33,15 +33,73 @@ while () { $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; print <<"END"; -/* +/* -*- buffer-read-only: t -*- + * * opcode.h * * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, 2004, 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. @@ -51,18 +109,24 @@ print <<"END"; * will be lost! */ +#ifndef PERL_GLOBAL_STRUCT_INIT + #define Perl_pp_i_preinc Perl_pp_preinc #define Perl_pp_i_predec Perl_pp_predec #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 + * 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. @@ -88,19 +152,17 @@ print ON "#define OP_phoney_OUTPUT_ONLY -2\n\n"; # Emit op names and descriptions. print <op_type == OP_CUSTOM ? custom_op_name(o) : \\ PL_op_name[(o)->op_type]) #define OP_DESC(o) ((o)->op_type == OP_CUSTOM ? custom_op_desc(o) : \\ PL_op_desc[(o)->op_type]) #ifndef DOINIT -EXT char *PL_op_name[]; +EXTCONST char* const PL_op_name[]; #else -EXT char *PL_op_name[] = { +EXTCONST char* const PL_op_name[] = { END for (@ops) { @@ -115,9 +177,9 @@ END print <$pp_sym_new" or die "Error creating $pp_sym_new: $!"; 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! */ @@ -308,6 +407,7 @@ print PP <<"END"; 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 @@ -331,6 +431,8 @@ for (@ops) { 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: $!"; @@ -606,7 +708,7 @@ vec vec ck_fun ist@ S S S 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? @@ -654,7 +756,7 @@ push push ck_fun imsT@ A L 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 @@ -783,8 +885,8 @@ fteread -r ck_ftst isu- F- 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- @@ -806,7 +908,8 @@ ftbinary -B ck_ftst isu- 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 @@ -816,7 +919,7 @@ rename rename ck_fun isT@ S S link link ck_fun isT@ S S symlink symlink ck_fun isT@ S S readlink readlink ck_fun stu% S? -mkdir mkdir ck_fun isT@ S S? +mkdir mkdir ck_fun isTu@ S? S? rmdir rmdir ck_fun isTu% S? # Directory calls. @@ -934,6 +1037,16 @@ method_named method with known name ck_null d$ 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