Use them in various B::* rather than have local defs.
p4raw-id: //depot/perl@2551
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';
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;
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
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);
# 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;
# 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');
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);
# 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
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()");
}
#
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;
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();
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:
}
}
-sub OPf_KIDS () { 4 }
sub walk_tree {
my($op, $sub) = @_;
return join("\n", @lines);
}
-sub SVf_POK () {0x40000}
sub deparse_sub {
my $self = shift;
}
}
-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;
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;
}
}
-sub OPf_SPECIAL () { 128 }
sub unop {
my $self = shift;
$cx, 16);
}
-sub OPpSLICE () { 64 }
-
sub pp_delete {
my $self = shift;
my($op, $cx) = @_;
}
}
-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;
return (($self->{'curcv'}->PADLIST->ARRAY)[1]->ARRAY)[$targ];
}
-sub OPf_REF () { 16 }
-
sub pp_refgen {
my $self = shift;
my($op, $cx) = @_;
sub SWAP_CHILDREN () { 1 }
sub ASSIGN () { 2 } # has OP= variant
-sub OPf_STACKED () { 64 }
-
my(%left, %right);
sub assoc_class {
# 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;
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
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;
}
}
-sub SVf_IOK () {0x10000}
-sub SVf_NOK () {0x20000}
-sub SVf_ROK () {0x80000}
sub const {
my $sv = shift;
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);
return $str;
}
-sub OPpTRANS_SQUASH () { 16 }
-sub OPpTRANS_DELETE () { 32 }
-sub OPpTRANS_COMPLEMENT () { 64 }
-
sub pp_trans {
my $self = shift;
my($op, $cx) = @_;
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
=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
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;
}
# 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
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 }
=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 { ["?", "?", "?"] }
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;
--- /dev/null
+#!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
+}
projects / p5sagit/p5-mst-13.2.git / commitdiff