This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
We can use the C pre-processor to build a single, longer string
[perl5.git] / opcode.pl
index 4035cc6..571fa14 100755 (executable)
--- a/opcode.pl
+++ b/opcode.pl
@@ -7,7 +7,9 @@ BEGIN {
 $opcode_new = 'opcode.h-new';
 $opname_new = 'opnames.h-new';
 open(OC, ">$opcode_new") || die "Can't create $opcode_new: $!\n";
+binmode OC;
 open(ON, ">$opname_new") || die "Can't create $opname_new: $!\n";
+binmode ON;
 select OC;
 
 # Read data.
@@ -35,10 +37,12 @@ while (<DATA>) {
 
 $i = 0;
 print <<"END";
-/*
+/* -*- buffer-read-only: t -*-
+ *
  *    opcode.h
  *
- *    Copyright (c) 1997-2003, Larry Wall
+ *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ *    2000, 2001, 2002, 2003, 2004, 2005 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.
@@ -48,6 +52,8 @@ 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
@@ -56,10 +62,11 @@ print <<"END";
 END
 
 print ON <<"END";
-/*
+/* -*- buffer-read-only: t -*-
+ *
  *    opnames.h
  *
- *    Copyright (c) 1997-2003, Larry Wall
+ *    Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 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.
@@ -85,19 +92,17 @@ print ON "#define OP_phoney_OUTPUT_ONLY -2\n\n";
 # Emit op names and descriptions.
 
 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])
+#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[];
+EXTCONST char* const PL_op_name[];
 #else
-EXT char *PL_op_name[] = {
+EXTCONST char* const PL_op_name[] = {
 END
 
 for (@ops) {
@@ -112,9 +117,9 @@ END
 
 print <<END;
 #ifndef DOINIT
-EXT char *PL_op_desc[];
+EXTCONST char* const PL_op_desc[];
 #else
-EXT char *PL_op_desc[] = {
+EXTCONST char* const PL_op_desc[] = {
 END
 
 for (@ops) {
@@ -132,6 +137,7 @@ print <<END;
 
 END_EXTERN_C
 
+#endif /* !PERL_GLOBAL_STRUCT_INIT */
 END
 
 # Emit function declarations.
@@ -152,10 +158,15 @@ print <<END;
 
 START_EXTERN_C
 
-#ifndef DOINIT
-EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX);
+#ifdef PERL_GLOBAL_STRUCT_INIT
+static const Perl_ppaddr_t Gppaddr[]
 #else
-EXT OP * (CPERLscope(*PL_ppaddr)[])(pTHX) = {
+#  ifndef PERL_GLOBAL_STRUCT
+EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
+#  endif
+#endif /* PERL_GLOBAL_STRUCT */
+#if (defined(DOINIT) && !defined(PERL_GLOBAL_STRUCT)) || defined(PERL_GLOBAL_STRUCT_INIT)
+= {
 END
 
 for (@ops) {
@@ -163,18 +174,24 @@ for (@ops) {
 }
 
 print <<END;
-};
+}
 #endif
+;
 
 END
 
 # Emit check routines.
 
 print <<END;
-#ifndef DOINIT
-EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op);
+#ifdef PERL_GLOBAL_STRUCT_INIT
+static const Perl_check_t Gcheck[]
 #else
-EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = {
+#  ifndef PERL_GLOBAL_STRUCT
+EXT Perl_check_t PL_check[] /* or perlvars.h */
+#  endif
+#endif
+#if (defined(DOINIT) && !defined(PERL_GLOBAL_STRUCT)) || defined(PERL_GLOBAL_STRUCT_INIT)
+= {
 END
 
 for (@ops) {
@@ -182,18 +199,21 @@ for (@ops) {
 }
 
 print <<END;
-};
+}
 #endif
+;
 
 END
 
 # Emit allowed argument types.
 
 print <<END;
+#ifndef PERL_GLOBAL_STRUCT_INIT
+
 #ifndef DOINIT
-EXT U32 PL_opargs[];
+EXT const U32 PL_opargs[];
 #else
-EXT U32 PL_opargs[] = {
+EXT const U32 PL_opargs[] = {
 END
 
 %argnum = (
@@ -263,6 +283,8 @@ print <<END;
 #endif
 
 END_EXTERN_C
+
+#endif /* !PERL_GLOBAL_STRUCT_INIT */
 END
 
 if (keys %OP_IS_SOCKET) {
@@ -279,6 +301,9 @@ if (keys %OP_IS_FILETEST) {
     print ON ")\n\n";
 }
 
+print OC "/* ex: set ro: */\n";
+print ON "/* ex: set ro: */\n";
+
 close OC or die "Error closing opcode.h: $!";
 close ON or die "Error closing opnames.h: $!";
 
@@ -292,10 +317,13 @@ $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: $!";
+binmode PP;
 open PPSYM, ">$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!
 */
@@ -303,6 +331,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
@@ -326,6 +355,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: $!";
@@ -336,6 +367,12 @@ foreach ('pp_proto.h', 'pp.sym') {
 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) = @_;
@@ -486,9 +523,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
@@ -626,7 +663,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
@@ -640,8 +677,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
@@ -772,8 +809,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-
@@ -805,7 +842,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.