X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/a85d93d9d5c06911d843f281439a8d3e65aeb165..16073f159843070bc8b173d94704d3759febc9f1:/opcode.pl diff --git a/opcode.pl b/opcode.pl index ab98824..5a3beed 100755 --- a/opcode.pl +++ b/opcode.pl @@ -1,8 +1,13 @@ #!/usr/bin/perl +BEGIN { + # Get function prototypes + require 'regen_lib.pl'; +} -unlink "opcode.h", "opnames.h"; -open(OC, ">opcode.h") || die "Can't create opcode.h: $!\n"; -open(ON, ">opnames.h") || die "Can't create opnames.h: $!\n"; +$opcode_new = 'opcode.h-new'; +$opname_new = 'opnames.h-new'; +open(OC, ">$opcode_new") || die "Can't create $opcode_new: $!\n"; +open(ON, ">$opname_new") || die "Can't create $opname_new: $!\n"; select OC; # Read data. @@ -30,10 +35,19 @@ while () { $i = 0; print <<"END"; -/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! - This file is built by opcode.pl from its data. Any changes made here - will be lost! -*/ +/* + * opcode.h + * + * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 2003, 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. + * + * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! + * This file is built by opcode.pl from its data. Any changes made here + * will be lost! + */ #define Perl_pp_i_preinc Perl_pp_preinc #define Perl_pp_i_predec Perl_pp_predec @@ -43,10 +57,19 @@ print <<"END"; END print ON <<"END"; -/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! - This file is built by opcode.pl from its data. Any changes made here - will be lost! -*/ +/* + * opnames.h + * + * Copyright (C) 1999, 2000, 2001, 2002, 2003, 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. + * + * + * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! + * This file is built by opcode.pl from its data. Any changes made here + * will be lost! + */ typedef enum opcode { END @@ -56,7 +79,9 @@ for (@ops) { } print ON "\t", &tab(3,"OP_max"), "\n"; print ON "} opcode;\n"; -print ON "\n#define MAXO ", scalar @ops, "\n\n"; +print ON "\n#define MAXO ", scalar @ops, "\n"; +print ON "#define OP_phoney_INPUT_ONLY -1\n"; +print ON "#define OP_phoney_OUTPUT_ONLY -2\n\n"; # Emit op names and descriptions. @@ -64,6 +89,12 @@ 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[]; #else @@ -90,7 +121,7 @@ END for (@ops) { my($safe_desc) = $desc{$_}; - # Have to escape double quotes and escape characters. + # Have to escape double quotes and escape characters. $safe_desc =~ s/(^|[^\\])([\\"])/$1\\$2/g; print qq(\t"$safe_desc",\n); @@ -129,7 +160,7 @@ EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX) = { END for (@ops) { - print "\tMEMBER_TO_FPTR(Perl_pp_$_),\n"; + print "\tMEMBER_TO_FPTR(Perl_pp_$_),\n" unless $_ eq "custom"; } print <pp_proto.h' or die "Error creating pp_proto.h: $!"; -open PPSYM, '>pp.sym' or die "Error creating pp.sym: $!"; +foreach ('opcode.h', 'opnames.h') { + safer_rename_silent $_, "$_-old"; +} +safer_rename $opcode_new, 'opcode.h'; +safer_rename $opname_new, 'opnames.h'; + +$pp_proto_new = 'pp_proto.h-new'; +$pp_sym_new = 'pp.sym-new'; + +open PP, ">$pp_proto_new" or die "Error creating $pp_proto_new: $!"; +open PPSYM, ">$pp_sym_new" or die "Error creating $pp_sym_new: $!"; print PP <<"END"; -/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +/* !!!!!!! DO NOT EDIT THIS FILE !!!!!!! This file is built by opcode.pl from its data. Any changes made here will be lost! */ @@ -268,7 +305,7 @@ END print PPSYM <<"END"; # -# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! +# !!!!!!! DO NOT EDIT THIS FILE !!!!!!! # This file is built by opcode.pl from its data. Any changes made here # will be lost! # @@ -286,6 +323,7 @@ print PP "\n\n"; for (@ops) { next if /^i_(pre|post)(inc|dec)$/; + next if /^custom$/; print PP "PERL_PPDEF(Perl_pp_$_)\n"; print PPSYM "Perl_pp_$_\n"; } @@ -293,6 +331,18 @@ for (@ops) { close PP or die "Error closing pp_proto.h: $!"; close PPSYM or die "Error closing pp.sym: $!"; +foreach ('pp_proto.h', 'pp.sym') { + safer_rename_silent $_, "$_-old"; +} +safer_rename $pp_proto_new, 'pp_proto.h'; +safer_rename $pp_sym_new, 'pp.sym'; + +END { + foreach ('opcode.h', 'opnames.h', 'pp_proto.h', 'pp.sym') { + 1 while unlink "$_-old"; + } +} + ########################################################################### sub tab { local($l, $t) = @_; @@ -321,7 +371,7 @@ sub tab { # trans not OK (dTARG; TARG = sv_newmortal();) # ucfirst etc not OK: TMP arg processed inplace # quotemeta not OK (unsafe when TARG == arg) -# each repeat not OK too due to array context +# each repeat not OK too due to list context # pack split - unknown whether they are safe # sprintf: is calling do_sprintf(TARG,...) which can act on TARG # before other args are processed. @@ -359,7 +409,38 @@ sub tab { __END__ -# New ops always go at the very end +# New ops always go at the end, just before 'custom' + +# A recapitulation of the format of this file: +# The file consists of five columns: the name of the op, an English +# description, the name of the "check" routine used to optimize this +# operation, some flags, and a description of the operands. + +# The flags consist of options followed by a mandatory op class signifier + +# The classes are: +# baseop - 0 unop - 1 binop - 2 +# logop - | listop - @ pmop - / +# padop/svop - $ padop - # (unused) loop - { +# baseop/unop - % loopexop - } filestatop - - +# pvop/svop - " cop - ; + +# Other options are: +# needs stack mark - m +# needs constant folding - f +# produces a scalar - s +# produces an integer - i +# needs a target - t +# target can be in a pad - T +# has a corresponding integer version - I +# has side effects - d +# uses $_ if no argument given - u + +# Values for the operands are: +# scalar - S list - L array - A +# hash - H sub (CV) - C file - F +# socket - Fs filetest - F- reference - R +# "?" denotes an optional operand. # Nothing. @@ -402,8 +483,8 @@ bless bless ck_fun s@ S S? backtick quoted execution (``, qx) ck_open t% # glob defaults its first arg to $_ glob glob ck_glob t@ S? -readline ck_null t% -rcatline append I/O operator ck_null t% +readline ck_null t% F? +rcatline append I/O operator ck_null t$ # Bindable operators. @@ -477,13 +558,13 @@ i_ne integer ne (!=) ck_null ifs2 S S ncmp numeric comparison (<=>) ck_null Iifst2 S S i_ncmp integer comparison (<=>) ck_null ifst2 S S -slt string lt ck_scmp ifs2 S S -sgt string gt ck_scmp ifs2 S S -sle string le ck_scmp ifs2 S S -sge string ge ck_scmp ifs2 S S +slt string lt ck_null ifs2 S S +sgt string gt ck_null ifs2 S S +sle string le ck_null ifs2 S S +sge string ge ck_null ifs2 S S seq string eq ck_null ifs2 S S sne string ne ck_null ifs2 S S -scmp string comparison (cmp) ck_scmp ifst2 S S +scmp string comparison (cmp) ck_null ifst2 S S bit_and bitwise and (&) ck_bitop fst2 S S bit_xor bitwise xor (^) ck_bitop fst2 S S @@ -515,21 +596,21 @@ abs abs ck_fun fsTu% S? # String stuff. length length ck_lengthconst isTu% S? -substr substr ck_fun st@ S S S? S? +substr substr ck_substr st@ S S S? S? 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_locale mfst@ S L +sprintf sprintf ck_fun mfst@ S L formline formline ck_fun ms@ S L ord ord ck_fun ifsTu% S? chr chr ck_fun fsTu% S? crypt crypt ck_fun fsT@ S S -ucfirst ucfirst ck_fun_locale fstu% S? -lcfirst lcfirst ck_fun_locale fstu% S? -uc uc ck_fun_locale fstu% S? -lc lc ck_fun_locale fstu% S? +ucfirst ucfirst ck_fun fstu% S? +lcfirst lcfirst ck_fun fstu% S? +uc uc ck_fun fstu% S? +lc lc ck_fun fstu% S? quotemeta quotemeta ck_fun fstu% S? # Arrays. @@ -552,7 +633,7 @@ hslice hash slice ck_null m@ H L # Explosives and implosives. -unpack unpack ck_fun @ S S +unpack unpack ck_fun @ S S? pack pack ck_fun mst@ S L split split ck_split t@ S S S join join or string ck_join mst@ S L @@ -596,10 +677,10 @@ orassign logical or assignment (||=) ck_null s| method method lookup ck_method d1 entersub subroutine entry ck_subr dmt1 L leavesub subroutine exit ck_null 1 -leavesublv lvalue subroutine exit ck_null 1 +leavesublv lvalue subroutine return ck_null 1 caller caller ck_fun t% S? warn warn ck_fun imst@ L -die die ck_fun dimst@ L +die die ck_die dimst@ L reset symbol reset ck_fun is% S? lineseq line sequence ck_null @ @@ -613,7 +694,7 @@ enteriter foreach loop entry ck_null d{ iter foreach loop iterator ck_null 0 enterloop loop entry ck_null d{ leaveloop loop exit ck_null 2 -return return ck_null dm@ L +return return ck_return dm@ L last last ck_null ds} next next ck_null ds} redo redo ck_null ds} @@ -627,7 +708,7 @@ exit exit ck_exit ds% S? # I/O. -open open ck_open ist@ F S? L +open open ck_open ismt@ F S? L close close ck_fun is% F? pipe_op pipe ck_fun is@ F F @@ -839,9 +920,16 @@ getlogin getlogin ck_null st0 syscall syscall ck_fun imst@ S L # For multi-threading -lock lock ck_rfun s% S +lock lock ck_rfun s% R threadsv per-thread value ck_null ds0 # Control (contd.) setstate set statement info ck_null s; method_named method with known name ck_null d$ + +dor defined or (//) ck_null | +dorassign defined or assignment (//=) ck_null s| + +# Add new ops before this, the custom operator. + +custom unknown custom operator ck_null 0