X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/5a211162cd360449f2dbfb7ca9231c025909353f..46ca028deb3cc13562ec0bbb4e8c9453fb300ddc:/opcode.pl

diff --git a/opcode.pl b/opcode.pl
index 59b039b..61cd0e8 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -1,8 +1,9 @@
 #!/usr/bin/perl
 
-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 +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
@@ -43,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
@@ -56,7 +74,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 +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
@@ -90,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);
@@ -129,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;
@@ -193,6 +219,9 @@ END
     '}',  13,		# loopexop
 );
 
+my %OP_IS_SOCKET;
+my %OP_IS_FILETEST;
+
 for (@ops) {
     $argsum = 0;
     $flags = $flags{$_};
@@ -205,12 +234,16 @@ 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
     for $arg (split(' ',$args{$_})) {
+	if ($arg =~ /^F/) {
+           $OP_IS_SOCKET{$_}   = 1 if $arg =~ s/s//;
+           $OP_IS_FILETEST{$_} = 1 if $arg =~ s/-//;
+        }
 	$argnum = ($arg =~ s/\?//) ? 8 : 0;
+        die "op = $_, arg = $arg\n" unless length($arg) == 1;
 	$argnum += $argnum{$arg};
 	warn "# Conflicting bit 32 for '$_'.\n"
 	    if $argnum & 8 and $mul == 0x10000000;
@@ -228,16 +261,41 @@ print <<END;
 END_EXTERN_C
 END
 
+if (keys %OP_IS_SOCKET) {
+    print ON "\n#define OP_IS_SOCKET(op)	\\\n\t(";
+    print ON join(" || \\\n\t ",
+               map { "(op) == OP_" . uc() } sort keys %OP_IS_SOCKET);
+    print ON ")\n\n";
+}
+
+if (keys %OP_IS_FILETEST) {
+    print ON "\n#define OP_IS_FILETEST(op)	\\\n\t(";
+    print ON join(" || \\\n\t ",
+               map { "(op) == OP_" . uc() } sort keys %OP_IS_FILETEST);
+    print ON ")\n\n";
+}
+
 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: $!";
+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!
 */
@@ -246,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!
 #
@@ -264,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";
 }
@@ -271,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) = @_;
@@ -299,7 +368,7 @@ sub tab {
 #	trans not OK (dTARG; TARG = sv_newmortal();)
 #	ucfirst etc not OK: TMP arg processed inplace
 #	quotemeta not OK (unsafe when TARG == arg)
-#	each repeat not OK too due to array context
+#	each repeat not OK too due to list context
 #	pack split - unknown whether they are safe
 #	sprintf: is calling do_sprintf(TARG,...) which can act on TARG
 #	  before other args are processed.
@@ -339,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	
@@ -377,11 +477,11 @@ bless		bless			ck_fun		s@	S S?
 
 # Pushy I/O.
 
-backtick	quoted execution (``, qx)	ck_null		t%	
+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.
 
@@ -434,7 +534,7 @@ add		addition (+)		ck_null		IfsT2	S S
 i_add		integer addition (+)	ck_null		ifsT2	S S
 subtract	subtraction (-)		ck_null		IfsT2	S S
 i_subtract	integer subtraction (-)	ck_null		ifsT2	S S
-concat		concatenation (.)	ck_concat	fsT2	S S
+concat		concatenation (.) or string	ck_concat	fsT2	S S
 stringify	string			ck_fun		fsT@	S
 
 left_shift	left bitshift (<<)	ck_bitop	fsT2	S S
@@ -455,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
@@ -493,21 +593,21 @@ abs		abs			ck_fun		fsTu%	S?
 # String stuff.
 
 length		length			ck_lengthconst	isTu%	S?
-substr		substr			ck_fun		st@	S S S? S?
+substr		substr			ck_substr	st@	S S S? S?
 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.
@@ -533,7 +633,7 @@ hslice		hash slice		ck_null		m@	H L
 unpack		unpack			ck_fun		@	S S
 pack		pack			ck_fun		mst@	S L
 split		split			ck_split	t@	S S S
-join		join			ck_join		mst@	S L
+join		join or string		ck_join		mst@	S L
 
 # List operators.
 
@@ -574,10 +674,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		@	
@@ -591,13 +691,13 @@ 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}	
 dump		dump			ck_null		ds}	
 goto		goto			ck_null		ds}	
-exit		exit			ck_fun		ds%	S?
+exit		exit			ck_exit		ds%	S?
 # continued below
 
 #nswitch	numeric switch		ck_null		d	
@@ -605,13 +705,13 @@ exit		exit			ck_fun		ds%	S?
 
 # I/O.
 
-open		open			ck_fun		ist@	F S? S?
+open		open			ck_open		ismt@	F S? L
 close		close			ck_fun		is%	F?
 pipe_op		pipe			ck_fun		is@	F F
 
 fileno		fileno			ck_fun		ist%	F
 umask		umask			ck_fun		ist%	S?
-binmode		binmode			ck_fun		s%	F
+binmode		binmode			ck_fun		s@	F S?
 
 tie		tie			ck_fun		idms@	R S L
 untie		untie			ck_fun		is%	R
@@ -635,8 +735,8 @@ sysseek		sysseek			ck_fun		s@	F S S
 sysread		sysread			ck_fun		imst@	F R S S?
 syswrite	syswrite		ck_fun		imst@	F S S? S?
 
-send		send			ck_fun		imst@	F S S S?
-recv		recv			ck_fun		imst@	F R S S
+send		send			ck_fun		imst@	Fs S S S?
+recv		recv			ck_fun		imst@	Fs R S S
 
 eof		eof			ck_eof		is%	F?
 tell		tell			ck_fun		st%	F?
@@ -650,52 +750,52 @@ flock		flock			ck_fun		isT@	F S
 
 # Sockets.
 
-socket		socket			ck_fun		is@	F S S S
-sockpair	socketpair		ck_fun		is@	F F S S S
+socket		socket			ck_fun		is@	Fs S S S
+sockpair	socketpair		ck_fun		is@	Fs Fs S S S
 
-bind		bind			ck_fun		is@	F S
-connect		connect			ck_fun		is@	F S
-listen		listen			ck_fun		is@	F S
-accept		accept			ck_fun		ist@	F F
-shutdown	shutdown		ck_fun		ist@	F S
+bind		bind			ck_fun		is@	Fs S
+connect		connect			ck_fun		is@	Fs S
+listen		listen			ck_fun		is@	Fs S
+accept		accept			ck_fun		ist@	Fs Fs
+shutdown	shutdown		ck_fun		ist@	Fs S
 
-gsockopt	getsockopt		ck_fun		is@	F S S
-ssockopt	setsockopt		ck_fun		is@	F S S S
+gsockopt	getsockopt		ck_fun		is@	Fs S S
+ssockopt	setsockopt		ck_fun		is@	Fs S S S
 
-getsockname	getsockname		ck_fun		is%	F
-getpeername	getpeername		ck_fun		is%	F
+getsockname	getsockname		ck_fun		is%	Fs
+getpeername	getpeername		ck_fun		is%	Fs
 
 # Stat calls.
 
 lstat		lstat			ck_ftst		u-	F
 stat		stat			ck_ftst		u-	F
-ftrread		-R			ck_ftst		isu-	F
-ftrwrite	-W			ck_ftst		isu-	F
-ftrexec		-X			ck_ftst		isu-	F
-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
-ftzero		-z			ck_ftst		isu-	F
-ftsize		-s			ck_ftst		istu-	F
-ftmtime		-M			ck_ftst		stu-	F
-ftatime		-A			ck_ftst		stu-	F
-ftctime		-C			ck_ftst		stu-	F
-ftsock		-S			ck_ftst		isu-	F
-ftchr		-c			ck_ftst		isu-	F
-ftblk		-b			ck_ftst		isu-	F
-ftfile		-f			ck_ftst		isu-	F
-ftdir		-d			ck_ftst		isu-	F
-ftpipe		-p			ck_ftst		isu-	F
-ftlink		-l			ck_ftst		isu-	F
-ftsuid		-u			ck_ftst		isu-	F
-ftsgid		-g			ck_ftst		isu-	F
-ftsvtx		-k			ck_ftst		isu-	F
-fttty		-t			ck_ftst		is-	F
-fttext		-T			ck_ftst		isu-	F
-ftbinary	-B			ck_ftst		isu-	F
+ftrread		-R			ck_ftst		isu-	F-
+ftrwrite	-W			ck_ftst		isu-	F-
+ftrexec		-X			ck_ftst		isu-	F-
+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-
+ftzero		-z			ck_ftst		isu-	F-
+ftsize		-s			ck_ftst		istu-	F-
+ftmtime		-M			ck_ftst		stu-	F-
+ftatime		-A			ck_ftst		stu-	F-
+ftctime		-C			ck_ftst		stu-	F-
+ftsock		-S			ck_ftst		isu-	F-
+ftchr		-c			ck_ftst		isu-	F-
+ftblk		-b			ck_ftst		isu-	F-
+ftfile		-f			ck_ftst		isu-	F-
+ftdir		-d			ck_ftst		isu-	F-
+ftpipe		-p			ck_ftst		isu-	F-
+ftlink		-l			ck_ftst		isu-	F-
+ftsuid		-u			ck_ftst		isu-	F-
+ftsgid		-g			ck_ftst		isu-	F-
+ftsvtx		-k			ck_ftst		isu-	F-
+fttty		-t			ck_ftst		is-	F-
+fttext		-T			ck_ftst		isu-	F-
+ftbinary	-B			ck_ftst		isu-	F-
 
 # File calls.
 
@@ -823,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