X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=opcode.pl;h=2e086417dc036796052df6fdfdcf0d6a9c80068b;hb=1cc8b4c566f7901a54e4b576f09608beb4c81f86;hp=c435f425cb05ff7ec7dcc38a7b60ea858c67caae;hpb=64b9952718c70e7b464c05a106b504b63f157e6e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/opcode.pl b/opcode.pl
index c435f42..2e08641 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -1,9 +1,7 @@
 #!/usr/bin/perl
 
-chmod 0666, "opcode.h", "opnames.h";
-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";
+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";
 select OC;
 
 # Read data.
@@ -67,6 +65,16 @@ print <<END;
 
 START_EXTERN_C
 
+#ifdef PERL_CUSTOM_OPS
+#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])
+#else
+#define OP_NAME(o) PL_op_name[o->op_type]
+#define OP_DESC(o) PL_op_desc[o->op_type]
+#endif
+
 #ifndef DOINIT
 EXT char *PL_op_name[];
 #else
@@ -132,7 +140,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;
@@ -211,7 +219,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
@@ -256,10 +263,14 @@ 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: $!";
+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";
+
+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: $!";
 
 print PP <<"END";
 /* !!!!!!!   DO NOT EDIT THIS FILE   !!!!!!!
@@ -289,6 +300,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";
 }
@@ -296,6 +308,12 @@ 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
+
+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";
+
 ###########################################################################
 sub tab {
     local($l, $t) = @_;
@@ -436,7 +454,7 @@ 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%	
+readline	<HANDLE>		ck_null		t%	F?
 rcatline	append I/O operator	ck_null		t%	
 
 # Bindable operators.
@@ -511,13 +529,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
@@ -555,15 +573,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.
@@ -879,3 +897,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