This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Implement "my $_".
[perl5.git] / opcode.pl
index 43d98ae..1fe1f3c 100755 (executable)
--- 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 (<DATA>) {
 
 $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 <<END;
 
 START_EXTERN_C
 
+
+#define OP_NAME(o) ((o)->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 <<END;
@@ -208,7 +239,6 @@ for (@ops) {
     $argsum |= 32 if $flags =~ /I/;            # has corresponding int op
     $argsum |= 64 if $flags =~ /d/;            # danger, unknown side effects
     $argsum |= 128 if $flags =~ /u/;           # defaults to $_
-
     $flags =~ /([\W\d_])/ or die qq[Opcode "$_" has no class indicator];
     $argsum |= $opclass{$1} << 9;
     $mul = 0x2000;                             # 2 ^ OASHIFT
@@ -253,13 +283,20 @@ if (keys %OP_IS_FILETEST) {
 close OC or die "Error closing opcode.h: $!";
 close ON or die "Error closing opnames.h: $!";
 
-unlink "pp_proto.h";
-unlink "pp.sym";
-open PP, '>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) = @_;
@@ -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       <HANDLE>                ck_null         t%      
-rcatline       append I/O operator     ck_null         t%      
+readline       <HANDLE>                ck_null         t%      F?
+rcatline       append I/O operator     ck_null         t$
 
 # Bindable operators.
 
@@ -412,9 +493,9 @@ regcreset   regexp internal reset   ck_fun          s1      S
 regcomp                regexp compilation      ck_null         s|      S
 match          pattern match (m//)     ck_match        d/
 qr             pattern quote (qr//)    ck_match        s/
-subst          substitution (s///)     ck_null         dis/    S
+subst          substitution (s///)     ck_match        dis/    S
 substcont      substitution iterator   ck_null         dis|    
-trans          transliteration (tr///) ck_null         is"     S
+trans          transliteration (tr///) ck_match        is"     S
 
 # Lvalue operators.
 # sassign is special-cased for op class
@@ -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
@@ -521,15 +602,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.
@@ -552,7 +633,7 @@ hslice              hash slice              ck_null         m@      H L
 
 # Explosives and implosives.
 
-unpack         unpack                  ck_fun          @       S S
+unpack         unpack                  ck_unpack       @       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
@@ -566,8 +647,8 @@ anonhash    anonymous hash ({})     ck_fun          ms@     L
 
 splice         splice                  ck_fun          m@      A S? S? L
 push           push                    ck_fun          imsT@   A L
-pop            pop                     ck_shift        s%      A
-shift          shift                   ck_shift        s%      A
+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
 reverse                reverse                 ck_fun          mt@     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