X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=opcode.pl;h=61cd0e8ba3a21bada105e254f87c5d2cab19d5bf;hb=6d4ed59b4cd79ae3d535d8eecbc937546e499c36;hp=2e6ae01a1da52cacb465e9c6239e9b53140fb044;hpb=78f9721bf0dc33981bedf125bcfa5c0c42b69eba;p=p5sagit%2Fp5-mst-13.2.git diff --git a/opcode.pl b/opcode.pl index 2e6ae01..61cd0e8 100755 --- a/opcode.pl +++ b/opcode.pl @@ -1,9 +1,9 @@ #!/usr/bin/perl -chmod 0666, "opcode.h", "opnames.h"; -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. @@ -31,10 +31,18 @@ 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) 1997-2002, Larry Wall + * + * 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 @@ -44,10 +52,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) 1997-2002, Larry Wall + * + * 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 @@ -67,6 +84,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 @@ -93,7 +116,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); @@ -132,7 +155,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: $!"; +chmod 0600, 'opcode.h'; # required by dosish filesystems +chmod 0600, 'opnames.h'; # required by dosish filesystems + +# Some dosish systems can't rename over an existing file: +unlink "$_-old" for qw(opcode.h opnames.h); +rename $_, "$_-old" for qw(opcode.h opnames.h); + +rename $opcode_new, 'opcode.h' or die "renaming opcode.h: $!\n"; +rename $opname_new, 'opnames.h' or die "renaming opnames.h: $!\n"; + +$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! */ @@ -271,7 +304,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! # @@ -289,6 +322,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"; } @@ -296,6 +330,16 @@ for (@ops) { close PP or die "Error closing pp_proto.h: $!"; close PPSYM or die "Error closing pp.sym: $!"; +chmod 0600, 'pp_proto.h'; # required by dosish filesystems +chmod 0600, 'pp.sym'; # required by dosish filesystems + +# Some dosish systems can't rename over an existing file: +unlink "$_-old" for qw(pp_proto.h pp.sym); +rename $_, "$_-old" for qw(pp_proto.h pp.sym); + +rename $pp_proto_new, 'pp_proto.h' or die "rename pp_proto.h: $!\n"; +rename $pp_sym_new, 'pp.sym' or die "rename pp.sym: $!\n"; + ########################################################################### sub tab { local($l, $t) = @_; @@ -364,6 +408,37 @@ __END__ # New ops always go at the very end +# 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 - " + +# 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. null null operation ck_null 0 @@ -405,8 +480,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. @@ -480,13 +555,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 @@ -524,15 +599,15 @@ 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. @@ -602,7 +677,7 @@ leavesub 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 @ @@ -630,7 +705,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 @@ -848,3 +923,5 @@ 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$ + +custom unknown custom operator ck_null 0