From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Sat, 2 Jan 1999 14:06:30 +0000 (+0000)
Subject: Export constant subs from B.xs for op.h, cop.h and a few others.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4c1f658f2c79575014c109439365f1a6c403e8c4;p=p5sagit%2Fp5-mst-13.2.git

Export constant subs from B.xs for op.h, cop.h and a few others.
Use them in various B::* rather than have local defs.

p4raw-id: //depot/perl@2551
---

diff --git a/ext/B/B.pm b/ext/B/B.pm
index 1599fe2..8fd3baf 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -14,7 +14,7 @@ require Exporter;
 		main_root main_start main_cv svref_2object opnumber
 		walkoptree walkoptree_slow walkoptree_exec walksymtable
 		parents comppadlist sv_undef compile_stats timing_info init_av);
-
+sub OPf_KIDS ();
 use strict;
 @B::SV::ISA = 'B::OBJECT';
 @B::NULL::ISA = 'B::SV';
@@ -65,10 +65,6 @@ sub debug {
     walkoptree_debug($value);
 }
 
-# sub OPf_KIDS;
-# add to .xs for perl5.002
-sub OPf_KIDS () { 4 }
-
 sub class {
     my $obj = shift;
     my $name = ref $obj;
diff --git a/ext/B/B.xs b/ext/B/B.xs
index 3e30024..e6b2f9d 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -435,7 +435,12 @@ MODULE = B	PACKAGE = B	PREFIX = B_
 PROTOTYPES: DISABLE
 
 BOOT:
+{
+    HV *stash = gv_stashpvn("B", 1, TRUE);
+    AV *export_ok = perl_get_av("B::EXPORT_OK",TRUE);
     INIT_SPECIALSV_LIST;
+#include "defsubs.h"
+}
 
 #define B_main_cv()	PL_main_cv
 #define B_init_av()	PL_initav
diff --git a/ext/B/B/Bytecode.pm b/ext/B/B/Bytecode.pm
index 0c5a58d..de2bf99 100644
--- a/ext/B/B/Bytecode.pm
+++ b/ext/B/B/Bytecode.pm
@@ -11,7 +11,9 @@ use Carp;
 use IO::File;
 
 use B qw(minus_c main_cv main_root main_start comppadlist
-	 class peekop walkoptree svref_2object cstring walksymtable);
+	 class peekop walkoptree svref_2object cstring walksymtable
+	 SVf_POK SVp_POK SVf_IOK SVp_IOK
+	);
 use B::Asmdata qw(@optype @specialsv_name);
 use B::Assembler qw(assemble_fh);
 
@@ -23,11 +25,11 @@ for ($i = 0; $i < @optype; $i++) {
 
 # Following is SVf_POK|SVp_POK
 # XXX Shouldn't be hardwired
-sub POK () { 0x04040000 }
+sub POK () { SVf_POK|SVp_POK }
 
-# Following is SVf_IOK|SVp_OK
+# Following is SVf_IOK|SVp_IOK
 # XXX Shouldn't be hardwired
-sub IOK () { 0x01010000 }
+sub IOK () { SVf_IOK|SVp_IOK }
 
 my ($verbose, $module_only, $no_assemble, $debug_bc, $debug_cv);
 my $assembler_pid;
diff --git a/ext/B/B/C.pm b/ext/B/B/C.pm
index 97e3a88..b742bc4 100644
--- a/ext/B/B/C.pm
+++ b/ext/B/B/C.pm
@@ -103,8 +103,6 @@ sub walk_and_save_optree {
 # to "know" that op_seq is a U16 and use 65535. Ugh.
 my $op_seq = 65535;
 
-sub AVf_REAL () { 1 }
-
 # Look this up here so we can do just a number compare
 # rather than looking up the name of every BASEOP in B::OP
 my $OP_THREADSV = opnumber('threadsv');
diff --git a/ext/B/B/CC.pm b/ext/B/B/CC.pm
index e4f8877..3de70c6 100644
--- a/ext/B/B/CC.pm
+++ b/ext/B/B/CC.pm
@@ -8,7 +8,12 @@
 package B::CC;
 use strict;
 use B qw(main_start main_root class comppadlist peekop svref_2object
-	timing_info init_av);
+	timing_info init_av  
+	OPf_WANT_LIST OPf_WANT OPf_MOD OPf_STACKED OPf_SPECIAL
+	OPpASSIGN_BACKWARDS OPpLVAL_INTRO OPpDEREF_AV OPpDEREF_HV
+	OPpDEREF OPpFLIP_LINENUM G_ARRAY     
+	CXt_NULL CXt_SUB CXt_EVAL CXt_LOOP CXt_SUBST CXt_BLOCK
+	);
 use B::C qw(save_unused_subs objsym init_sections mark_unused
 	    output_all output_boilerplate output_main);
 use B::Bblock qw(find_leaders);
@@ -16,26 +21,6 @@ use B::Stackobj qw(:types :flags);
 
 # These should probably be elsewhere
 # Flags for $op->flags
-sub OPf_LIST () { 1 }
-sub OPf_KNOW () { 2 }
-sub OPf_MOD () { 32 }
-sub OPf_STACKED () { 64 }
-sub OPf_SPECIAL () { 128 }
-# op-specific flags for $op->private 
-sub OPpASSIGN_BACKWARDS () { 64 }
-sub OPpLVAL_INTRO () { 128 }
-sub OPpDEREF_AV () { 32 }
-sub OPpDEREF_HV () { 64 }
-sub OPpDEREF () { OPpDEREF_AV|OPpDEREF_HV }
-sub OPpFLIP_LINENUM () { 64 }
-sub G_ARRAY () { 1 }
-# cop.h
-sub CXt_NULL () { 0 }
-sub CXt_SUB () { 1 }
-sub CXt_EVAL () { 2 }
-sub CXt_LOOP () { 3 }
-sub CXt_SUBST () { 4 }
-sub CXt_BLOCK () { 5 }
 
 my $module;		# module name (when compiled with -m)
 my %done;		# hash keyed by $$op of leaders of basic blocks
@@ -457,7 +442,7 @@ sub doop {
 sub gimme {
     my $op = shift;
     my $flags = $op->flags;
-    return (($flags & OPf_KNOW) ? ($flags & OPf_LIST) : "dowantarray()");
+    return (($flags & OPf_WANT) ? ($flags & OPf_WANT_LIST) : "dowantarray()");
 }
 
 #
@@ -1077,12 +1062,12 @@ sub nyi {
 sub pp_range {
     my $op = shift;
     my $flags = $op->flags;
-    if (!($flags & OPf_KNOW)) {
+    if (!($flags & OPf_WANT)) {
 	error("context of range unknown at compile-time");
     }
     write_back_lexicals();
     write_back_stack();
-    if (!($flags & OPf_LIST)) {
+    if (!($flags & OPf_WANT_LIST)) {
 	# We need to save our UNOP structure since pp_flop uses
 	# it to find and adjust out targ. We don't need it ourselves.
 	$op->save;
@@ -1096,10 +1081,10 @@ sub pp_range {
 sub pp_flip {
     my $op = shift;
     my $flags = $op->flags;
-    if (!($flags & OPf_KNOW)) {
+    if (!($flags & OPf_WANT)) {
 	error("context of flip unknown at compile-time");
     }
-    if ($flags & OPf_LIST) {
+    if ($flags & OPf_WANT_LIST) {
 	return $op->first->false;
     }
     write_back_lexicals();
diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index 60f6f0d..fd7e088 100644
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -8,8 +8,16 @@
 
 package B::Deparse;
 use Carp 'cluck';
-use B qw(class main_root main_start main_cv svref_2object);
-$VERSION = 0.56;
+use B qw(class main_root main_start main_cv svref_2object opnumber
+         OPf_WANT OPf_WANT_VOID OPf_WANT_SCALAR OPf_WANT_LIST
+         OPpENTERSUB_AMPER OPf_KIDS OPpLVAL_INTRO
+         OPf_SPECIAL OPpSLICE OPpCONST_BARE OPf_REF OPf_STACKED
+         OPpENTERSUB_AMPER OPpTRANS_SQUASH OPpTRANS_DELETE
+         OPpTRANS_COMPLEMENT SVf_IOK  SVf_NOK SVf_ROK SVf_POK
+	 PMf_ONCE PMf_SKIPWHITE PMf_CONST PMf_KEEP PMf_GLOBAL PMf_CONTINUE
+	 PMf_EVAL PMf_LOCALE PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED
+        );
+$VERSION = 0.561;
 use strict;
 
 # Changes between 0.50 and 0.51:
@@ -187,7 +195,6 @@ sub next_todo {
     }
 }
 
-sub OPf_KIDS () { 4 }
 
 sub walk_tree {
     my($op, $sub) = @_;
@@ -349,7 +356,6 @@ sub indent {
     return join("\n", @lines);
 }
 
-sub SVf_POK () {0x40000}
 
 sub deparse_sub {
     my $self = shift;
@@ -483,12 +489,11 @@ sub maybe_parens_func {
     }
 }
 
-sub OPp_LVAL_INTRO () { 128 }
 
 sub maybe_local {
     my $self = shift;
     my($op, $cx, $text) = @_;
-    if ($op->private & OPp_LVAL_INTRO and not $self->{'avoid_local'}{$$op}) {
+    if ($op->private & OPpLVAL_INTRO and not $self->{'avoid_local'}{$$op}) {
 	return $self->maybe_parens_func("local", $text, $cx, 16);
     } else {
 	return $text;
@@ -504,7 +509,7 @@ sub padname_sv {
 sub maybe_my {
     my $self = shift;
     my($op, $cx, $text) = @_;
-    if ($op->private & OPp_LVAL_INTRO and not $self->{'avoid_local'}{$$op}) {
+    if ($op->private & OPpLVAL_INTRO and not $self->{'avoid_local'}{$$op}) {
 	return $self->maybe_parens_func("my", $text, $cx, 16);
     } else {
 	return $text;
@@ -787,7 +792,6 @@ sub pp_not {
     }
 }
 
-sub OPf_SPECIAL () { 128 }
 
 sub unop {
     my $self = shift;
@@ -894,8 +898,6 @@ sub pp_exists {
 				    $cx, 16);
 }
 
-sub OPpSLICE () { 64 }
-
 sub pp_delete {
     my $self = shift;
     my($op, $cx) = @_;
@@ -911,13 +913,11 @@ sub pp_delete {
     }
 }
 
-sub OPp_CONST_BARE () { 64 }
-
 sub pp_require {
     my $self = shift;
     my($op, $cx) = @_;
     if (class($op) eq "UNOP" and $op->first->ppaddr eq "pp_const"
-	and $op->first->private & OPp_CONST_BARE)
+	and $op->first->private & OPpCONST_BARE)
     {
 	my $name = $op->first->sv->PV;
 	$name =~ s[/][::]g;
@@ -946,8 +946,6 @@ sub padval {
     return (($self->{'curcv'}->PADLIST->ARRAY)[1]->ARRAY)[$targ];
 }
 
-sub OPf_REF () { 16 }
-
 sub pp_refgen {
     my $self = shift;	
     my($op, $cx) = @_;
@@ -1059,8 +1057,6 @@ sub pp_ftbinary { ftst(@_, "-B") }
 sub SWAP_CHILDREN () { 1 }
 sub ASSIGN () { 2 } # has OP= variant
 
-sub OPf_STACKED () { 64 }
-
 my(%left, %right);
 
 sub assoc_class {
@@ -1523,7 +1519,7 @@ sub pp_list {
 	# This assumes that no other private flags equal 128, and that
 	# OPs that store things other than flags in their op_private,
 	# like OP_AELEMFAST, won't be immediate children of a list.
-	unless ($lop->private & OPp_LVAL_INTRO or $lop->ppaddr eq "pp_undef")
+	unless ($lop->private & OPpLVAL_INTRO or $lop->ppaddr eq "pp_undef")
 	{
 	    $local = ""; # or not
 	    last;
@@ -1706,23 +1702,22 @@ sub pp_leaveloop {
 sub pp_leavetry {
     my $self = shift;
     return "eval {\n\t" . $self->pp_leave(@_) . "\n\b}";
-}
+}                                       
 
-sub OP_CONST () { 5 }
+my $OP_CONST = opnumber("const");
+my $OP_STRINGIFY = opnumber("stringify");
 
 # XXX need a better way to do this
-sub OP_STRINGIFY () { $] > 5.004_72 ? 67 : 65 }
-
 sub pp_null {
     my $self = shift;
     my($op, $cx) = @_;
     if (class($op) eq "OP") {
-	return "'???'" if $op->targ == OP_CONST; # old value is lost
+	return "'???'" if $op->targ == $OP_CONST; # old value is lost
     } elsif ($op->first->ppaddr eq "pp_pushmark") {
 	return $self->pp_list($op, $cx);
     } elsif ($op->first->ppaddr eq "pp_enter") {
 	return $self->pp_leave($op, $cx);
-    } elsif ($op->targ == OP_STRINGIFY) {
+    } elsif ($op->targ == $OP_STRINGIFY) {
 	return $self->dquote($op);
     } elsif (!null($op->first->sibling) and
 	     $op->first->sibling->ppaddr eq "pp_readline" and
@@ -1926,13 +1921,6 @@ sub pp_lslice {
     return "($list)" . "[$idx]";
 }
 
-sub OPpENTERSUB_AMPER () { 8 }
-
-sub OPf_WANT () { 3 }
-sub OPf_WANT_VOID () { 1 }
-sub OPf_WANT_SCALAR () { 2 }
-sub OPf_WANT_LIST () { 2 }
-
 sub want_scalar {
     my $op = shift;
     return ($op->flags & OPf_WANT) == OPf_WANT_SCALAR;
@@ -2175,9 +2163,6 @@ sub single_delim {
     }
 }
 
-sub SVf_IOK () {0x10000}
-sub SVf_NOK () {0x20000}
-sub SVf_ROK () {0x80000}
 
 sub const {
     my $sv = shift;
@@ -2203,7 +2188,7 @@ sub const {
 sub pp_const {
     my $self = shift;
     my($op, $cx) = @_;
-#    if ($op->private & OPp_CONST_BARE) { # trouble with `=>' autoquoting 
+#    if ($op->private & OPpCONST_BARE) { # trouble with `=>' autoquoting 
 #	return $op->sv->PV;
 #    }
     return const($op->sv);
@@ -2324,10 +2309,6 @@ sub collapse {
     return $str;
 }
 
-sub OPpTRANS_SQUASH () { 16 }
-sub OPpTRANS_DELETE () { 32 }
-sub OPpTRANS_COMPLEMENT () { 64 }
-
 sub pp_trans {
     my $self = shift;
     my($op, $cx) = @_;
@@ -2413,20 +2394,6 @@ sub pp_regcomp {
     return $self->re_dq($kid);
 }
 
-sub OPp_RUNTIME () { 64 }
-
-sub PMf_ONCE () { 0x2 }
-sub PMf_SKIPWHITE () { 0x10 }
-sub PMf_CONST () { 0x40 }
-sub PMf_KEEP () { 0x80 }
-sub PMf_GLOBAL () { 0x100 }
-sub PMf_CONTINUE () { 0x200 }
-sub PMf_EVAL () { 0x400 }
-sub PMf_LOCALE () { 0x800 }
-sub PMf_MULTILINE () { 0x1000 }
-sub PMf_SINGLELINE () { 0x2000 }
-sub PMf_FOLD () { 0x4000 }
-sub PMf_EXTENDED () { 0x8000 }
 
 # osmic acid -- see osmium tetroxide
 
diff --git a/ext/B/B/Lint.pm b/ext/B/B/Lint.pm
index d34bd77..9d3b80a 100644
--- a/ext/B/B/Lint.pm
+++ b/ext/B/B/Lint.pm
@@ -116,13 +116,9 @@ Malcolm Beattie, mbeattie@sable.ox.ac.uk.
 =cut
 
 use strict;
-use B qw(walkoptree_slow main_root walksymtable svref_2object parents);
-
-# Constants (should probably be elsewhere)
-sub G_ARRAY () { 1 }
-sub OPf_LIST () { 1 }
-sub OPf_KNOW () { 2 }
-sub OPf_STACKED () { 64 }
+use B qw(walkoptree_slow main_root walksymtable svref_2object parents
+         OPf_WANT_LIST OPf_WANT OPf_STACKED G_ARRAY
+        );
 
 my $file = "unknown";		# shadows current filename
 my $line = 0;			# shadows current line number
@@ -165,8 +161,8 @@ sub warning {
 sub gimme {
     my $op = shift;
     my $flags = $op->flags;
-    if ($flags & OPf_KNOW) {
-	return(($flags & OPf_LIST) ? 1 : 0);
+    if ($flags & OPf_WANT) {
+	return(($flags & OPf_WANT_LIST) ? 1 : 0);
     }
     return undef;
 }
diff --git a/ext/B/B/Stackobj.pm b/ext/B/B/Stackobj.pm
index 09a3e90..35e04e2 100644
--- a/ext/B/B/Stackobj.pm
+++ b/ext/B/B/Stackobj.pm
@@ -5,7 +5,7 @@
 #      You may distribute under the terms of either the GNU General Public
 #      License or the Artistic License, as specified in the README file.
 #
-package B::Stackobj;
+package B::Stackobj;  
 use Exporter ();
 @ISA = qw(Exporter);
 @EXPORT_OK = qw(set_callback T_UNKNOWN T_DOUBLE T_INT
@@ -16,11 +16,7 @@ use Exporter ();
 
 use Carp qw(confess);
 use strict;
-use B qw(class);
-
-# Perl internal constants that I should probably define elsewhere.
-sub SVf_IOK () { 0x10000 }
-sub SVf_NOK () { 0x20000 }
+use B qw(class SVf_IOK SVf_NOK);
 
 # Types
 sub T_UNKNOWN () { 0 }
diff --git a/ext/B/B/Xref.pm b/ext/B/B/Xref.pm
index 0102856..15382aa 100644
--- a/ext/B/B/Xref.pm
+++ b/ext/B/B/Xref.pm
@@ -85,11 +85,9 @@ Malcolm Beattie, mbeattie@sable.ox.ac.uk.
 =cut
 
 use strict;
-use B qw(peekop class comppadlist main_start svref_2object walksymtable);
-
-# Constants (should probably be elsewhere)
-sub OPpLVAL_INTRO () { 128 }
-sub SVf_POK () { 0x40000 }
+use B qw(peekop class comppadlist main_start svref_2object walksymtable
+         OPpLVAL_INTRO SVf_POK
+        );
 
 sub UNKNOWN { ["?", "?", "?"] }
 
diff --git a/ext/B/Makefile.PL b/ext/B/Makefile.PL
index 80e5e1b..456e603 100644
--- a/ext/B/Makefile.PL
+++ b/ext/B/Makefile.PL
@@ -20,15 +20,24 @@ WriteMakefile(
     clean	=> {
 	FILES		=> "perl$e byteperl$e *$o B.c *~"
     }
-);
+);   
 
-sub MY::post_constants {
+package MY;
+
+sub post_constants {
     "\nLIBS = $Config{libs}\n"
+}    
+
+sub postamble {
+'
+B.o : defsubs.h 
+defsubs.h : defsubs.h.PL ../../op.h
+'
 }
 
 # Leave out doing byteperl for now. Probably should be built in the
 # core directory or somewhere else rather than here
-#sub MY::top_targets {
+#sub top_targets {
 #    my $self = shift;
 #    my $targets = $self->MM::top_targets();
 #    $targets =~ s/^(all ::.*)$/$1 byteperl$e/m;
diff --git a/ext/B/defsubs.h.PL b/ext/B/defsubs.h.PL
new file mode 100644
index 0000000..b07841a
--- /dev/null
+++ b/ext/B/defsubs.h.PL
@@ -0,0 +1,28 @@
+#!perl
+my ($out) = __FILE__ =~ /(^.*)\.PL/;
+open(OUT,">$out") || die "Cannot open $file:$!";
+foreach my $const (qw(AVf_REAL 
+                      SVf_IOK SVf_NOK SVf_POK SVf_ROK SVp_IOK SVp_POK ))
+ {
+  doconst($const);
+ }
+foreach my $file (qw(op.h cop.h))
+ {
+  open(OPH,"../../$file") || die "Cannot open ../../$file:$!";
+  while (<OPH>)
+   {  
+    doconst($1) if (/#define\s+(\w+)\s+([\(\)\|\dx]+)\s*(?:$|\/\*)/);
+   }  
+  close(OPH);
+ }
+close(OUT);
+               
+sub doconst
+{
+ my $sym = shift;
+ my $l = length($sym);
+ print OUT <<"END";
+ newCONSTSUB(stash,"$sym",newSViv($sym)); 
+ av_push(export_ok,newSVpv("$sym",$l));
+END
+}