Bleadperl on Cygwin today

[perl5.git] / opcode.pl

diff --git a/opcode.pl b/opcode.pl
index 4053671..5feca27 100755 (executable)
--- a/opcode.pl
+++ b/opcode.pl
@@ -1,7 +1,9 @@
 #!/usr/bin/perl
 
-open(OC, ">opcode.h.new") || die "Can't create opcode.h.new: $!\n";
-open(ON, ">opnames.h.new") || die "Can't create opnames.h.new: $!\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.
@@ -29,10 +31,18 @@ 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) 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
@@ -42,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
@@ -65,6 +84,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
@@ -130,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 <<END;
@@ -209,7 +234,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
@@ -257,11 +281,14 @@ close ON or die "Error closing opnames.h: $!";
 chmod 0600, 'opcode.h';  # required by dosish filesystems
 chmod 0600, 'opnames.h'; # required by dosish filesystems
 
-rename 'opcode.h.new', 'opcode.h' or die "renaming opcode.h: $!\n";
-rename 'opnames.h.new', 'opnames.h' or die "renaming opnames.h: $!\n";
+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.h.new' or die "Error creating pp_proto.h.new: $!";
-open PPSYM, '>pp.sym.new' or die "Error creating 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   !!!!!!!
@@ -291,6 +318,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";
 }
@@ -301,8 +329,8 @@ 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
 
-rename 'pp_proto.h.new', 'pp_proto.h' or die "rename pp_proto.h: $!\n";
-rename 'pp.sym.new', 'pp.sym' or die "rename pp.sym: $!\n";
+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 {
@@ -445,7 +473,7 @@ backtick    quoted execution (``, qx)       ck_open         t%
 # glob defaults its first arg to $_
 glob           glob                    ck_glob         t@      S?
 readline       <HANDLE>                ck_null         t%      F?
-rcatline       append I/O operator     ck_null         t%      
+rcatline       append I/O operator     ck_null         t$
 
 # Bindable operators.
 
@@ -641,7 +669,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         @       
@@ -887,3 +915,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