X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=opcode.pl;h=6b0129490ffec395ead722174362279492b0ce8f;hb=e96b369dc61077fe31b75895167f55dbce4d7519;hp=10e252c2462a85976d8a2c1241571a55e4b74b7c;hpb=dc9aa44637d2171ba3efbf36c71e8591a7ce05d7;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/opcode.pl b/opcode.pl
index 10e252c..6b01294 100755
--- 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.
@@ -31,15 +33,54 @@ while (<DATA>) {
     $args{$key} = $args;
 }
 
+# Set up aliases
+
+my %alias;
+
+# Format is "this function" => "does these op names"
+my @raw_alias = (
+		 Perl_do_kv => [qw( keys values )],
+		 Perl_unimplemented_op => [qw(padany threadsv mapstart)],
+		 # All the ops with a body of { return NORMAL; }
+		 Perl_pp_null => [qw(scalar regcmaybe lineseq scope)],
+
+		 Perl_pp_goto => ['dump'],
+		 Perl_pp_require => ['dofile'],
+		 Perl_pp_untie => ['dbmclose'],
+		 Perl_pp_sysread => [qw(read recv)],
+		 Perl_pp_sysseek => ['seek'],
+		 Perl_pp_ioctl => ['fcntl'],
+		 Perl_pp_ssockopt => ['gsockopt'],
+		 Perl_pp_getpeername => ['getsockname'],
+		 Perl_pp_stat => ['lstat'],
+		 Perl_pp_ftrowned => ['fteowned'],
+		 Perl_pp_fttext => ['ftbinary'],
+		 Perl_pp_gmtime => ['localtime'],
+		 Perl_pp_semget => [qw(shmget msgget)],
+		 Perl_pp_semctl => [qw(shmctl msgctl)],
+		 Perl_pp_shmwrite => ['shmread'],
+		 Perl_pp_ghostent => [qw(ghbyname ghbyaddr)],
+		 Perl_pp_gnetent => [qw(gnbyname gnbyaddr)],
+		 Perl_pp_gprotoent => [qw(gpbyname gpbynumber)],
+		 Perl_pp_gservent => [qw(gsbyname gsbyport)],
+		 Perl_pp_gpwent => [qw(gpwnam gpwuid)],
+		 Perl_pp_ggrent => [qw(ggrnam ggrgid)],
+);
+
+while (my ($func, $names) = splice @raw_alias, 0, 2) {
+    $alias{$_} = $func for @$names;
+}
+
 # Emit defines.
 
 $i = 0;
 print <<"END";
-/*
+/* -*- buffer-read-only: t -*-
+ *
  *    opcode.h
  *
  *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, by Larry Wall and others
+ *    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.
@@ -49,18 +90,23 @@ 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
 #define Perl_pp_i_postdec Perl_pp_postdec
 
+PERL_PPDEF(Perl_unimplemented_op)
+
 END
 
 print ON <<"END";
-/*
+/* -*- buffer-read-only: t -*-
+ *
  *    opnames.h
  *
- *    Copyright (C) 1999, 2000, 2001, 2002, 2003, by Larry Wall and others
+ *    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.
@@ -86,19 +132,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])
 
 #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) {
@@ -113,9 +157,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) {
@@ -133,6 +177,7 @@ print <<END;
 
 END_EXTERN_C
 
+#endif /* !PERL_GLOBAL_STRUCT_INIT */
 END
 
 # Emit function declarations.
@@ -153,29 +198,46 @@ 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) {
-    print "\tMEMBER_TO_FPTR(Perl_pp_$_),\n" unless $_ eq "custom";
+    $_ eq "custom" and next;
+    if (my $name = $alias{$_}) {
+	print "\tMEMBER_TO_FPTR($name),\t/* Perl_pp_$_ */\n";
+    }
+    else {
+	print "\tMEMBER_TO_FPTR(Perl_pp_$_),\n";
+    }
 }
 
 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) {
@@ -183,18 +245,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 = (
@@ -264,6 +329,8 @@ print <<END;
 #endif
 
 END_EXTERN_C
+
+#endif /* !PERL_GLOBAL_STRUCT_INIT */
 END
 
 if (keys %OP_IS_SOCKET) {
@@ -280,6 +347,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: $!";
 
@@ -293,10 +363,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!
 */
@@ -304,6 +377,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
@@ -327,6 +401,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: $!";
@@ -684,8 +760,8 @@ die		die			ck_die		dimst@	L
 reset		symbol reset		ck_fun		is%	S?
 
 lineseq		line sequence		ck_null		@	
-nextstate	next statement		ck_state	s;	
-dbstate		debug next statement	ck_state	s;	
+nextstate	next statement		ck_null		s;	
+dbstate		debug next statement	ck_null		s;	
 unstack		iteration finalizer	ck_null		s0
 enter		block entry		ck_null		0	
 leave		block exit		ck_null		@	
@@ -779,8 +855,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-
@@ -812,7 +888,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.