[Jifty-commit] r5731 - in B-Utils: . lib/B/Utils t t/op t/utils
Jifty commits
jifty-commit at lists.jifty.org
Sat Aug 16 11:04:09 EDT 2008
Author: clkao
Date: Sat Aug 16 11:04:07 2008
New Revision: 5731
Added:
B-Utils/BUtils_op.h
B-Utils/OP.xs
B-Utils/lib/B/Utils/
B-Utils/lib/B/Utils/OP.pm
B-Utils/t/op/
B-Utils/t/utils/
B-Utils/t/utils/20all_starts.t
- copied unchanged from r5711, /B-Utils/t/20all_starts.t
B-Utils/t/utils/21all_roots.t
- copied unchanged from r5711, /B-Utils/t/21all_roots.t
B-Utils/t/utils/22anon_subs.t
- copied unchanged from r5711, /B-Utils/t/22anon_subs.t
B-Utils/t/utils/30parent.t
- copied unchanged from r5711, /B-Utils/t/30parent.t
B-Utils/t/utils/31oldname.t
- copied unchanged from r5711, /B-Utils/t/31oldname.t
B-Utils/t/utils/32kids.t
- copied unchanged from r5711, /B-Utils/t/32kids.t
B-Utils/t/utils/33ancestors.t
- copied unchanged from r5711, /B-Utils/t/33ancestors.t
B-Utils/t/utils/34descendants.t
- copied unchanged from r5711, /B-Utils/t/34descendants.t
B-Utils/t/utils/35siblings.t
- copied unchanged from r5711, /B-Utils/t/35siblings.t
B-Utils/t/utils/36previous.t
- copied unchanged from r5711, /B-Utils/t/36previous.t
B-Utils/t/utils/37stringify.t
- copied unchanged from r5711, /B-Utils/t/37stringify.t
B-Utils/t/utils/40walk.t
- copied unchanged from r5711, /B-Utils/t/40walk.t
B-Utils/t/utils/41walkfilt.t
- copied unchanged from r5711, /B-Utils/t/41walkfilt.t
B-Utils/t/utils/42all.t
- copied unchanged from r5711, /B-Utils/t/42all.t
B-Utils/t/utils/43allfilt.t
- copied unchanged from r5711, /B-Utils/t/43allfilt.t
B-Utils/t/utils/44optrep.t
- copied unchanged from r5711, /B-Utils/t/44optrep.t
B-Utils/t/utils/50carp.t
- copied unchanged from r5711, /B-Utils/t/50carp.t
B-Utils/t/utils/51croak.t
- copied unchanged from r5711, /B-Utils/t/51croak.t
Removed:
B-Utils/t/20all_starts.t
B-Utils/t/21all_roots.t
B-Utils/t/22anon_subs.t
B-Utils/t/30parent.t
B-Utils/t/31oldname.t
B-Utils/t/32kids.t
B-Utils/t/33ancestors.t
B-Utils/t/34descendants.t
B-Utils/t/35siblings.t
B-Utils/t/36previous.t
B-Utils/t/37stringify.t
B-Utils/t/40walk.t
B-Utils/t/41walkfilt.t
B-Utils/t/42all.t
B-Utils/t/43allfilt.t
B-Utils/t/44optrep.t
B-Utils/t/50carp.t
B-Utils/t/51croak.t
Modified:
B-Utils/MANIFEST
B-Utils/Makefile.PL
B-Utils/Utils.xs
B-Utils/lib/B/Utils.pm
Log:
- incorporate B::OP::Util stuff into B::Utils::OP.
- move tests
- document the usage for ExtUtils::Dpeneds.
Added: B-Utils/BUtils_op.h
==============================================================================
--- (empty file)
+++ B-Utils/BUtils_op.h Sat Aug 16 11:04:07 2008
@@ -0,0 +1,8 @@
+#ifndef _BUTILS_OP_H_
+#define _BUTILS__OP_H_
+
+extern PERL_CONTEXT *BUtils_op_upcontext
+(pTHX_ I32 count, COP **cop_p, PERL_CONTEXT **ccstack_p,
+ I32 *cxix_from_p, I32 *cxix_to_p);
+
+#endif
Modified: B-Utils/MANIFEST
==============================================================================
--- B-Utils/MANIFEST (original)
+++ B-Utils/MANIFEST Sat Aug 16 11:04:07 2008
@@ -1,29 +1,38 @@
+build/IFiles.pm
+BUtils.h
+BUtils_op.h
Changes
+inc/ExtUtils/Depends.pm
lib/B/Utils.pm
+lib/B/Utils/OP.pm
Makefile.PL
MANIFEST This list of files
+META.yml
+OP.xs
README
SIGNATURE
t/00signature.t
t/01pod.t
-t/03yaml.t
t/10use.t
t/11export.t
-t/20all_starts.t
-t/21all_roots.t
-t/22anon_subs.t
-t/30parent.t
-t/31oldname.t
-t/32kids.t
-t/33ancestors.t
-t/34descendants.t
-t/35siblings.t
-t/36previous.t
-t/37stringify.t
-t/40walk.t
-t/41walkfilt.t
-t/42all.t
-t/43allfilt.t
-t/44optrep.t
-t/50carp.t
-t/51croak.t
+t/new_cv.t
+t/utils/20all_starts.t
+t/utils/21all_roots.t
+t/utils/22anon_subs.t
+t/utils/30parent.t
+t/utils/31oldname.t
+t/utils/32kids.t
+t/utils/33ancestors.t
+t/utils/34descendants.t
+t/utils/35siblings.t
+t/utils/36previous.t
+t/utils/37stringify.t
+t/utils/40walk.t
+t/utils/41walkfilt.t
+t/utils/42all.t
+t/utils/43allfilt.t
+t/utils/44optrep.t
+t/utils/50carp.t
+t/utils/51croak.t
+typemap
+Utils.xs
Modified: B-Utils/Makefile.PL
==============================================================================
--- B-Utils/Makefile.PL (original)
+++ B-Utils/Makefile.PL Sat Aug 16 11:04:07 2008
@@ -4,7 +4,14 @@
my $pkg = ExtUtils::Depends->new('B::Utils');
$pkg->install('BUtils.h');
+
+$pkg->add_xs("Utils.xs", "OP.xs");
+
+$pkg->add_pm( 'lib/B/Utils.pm' => '$(INST_LIB)/B/Utils.pm',
+ 'lib/B/Utils/OP.pm' => '$(INST_LIB)/B/Utils/OP.pm' );
+
$pkg->add_typemaps("typemap");
+
$pkg->save_config('build/IFiles.pm');
use ExtUtils::MakeMaker;
@@ -15,6 +22,7 @@
PREREQ_PM => {},
ABSTRACT_FROM => 'lib/B/Utils.pm',
AUTHOR => 'Joshua b. Jore <jjore at cpan.org>',
- LICENSE => 'perl',
+ LICENSE => 'perl',
+ test => { TESTS => 't/*.t t/*/*.t' },
$pkg->get_makefile_vars,
);
Added: B-Utils/OP.xs
==============================================================================
--- (empty file)
+++ B-Utils/OP.xs Sat Aug 16 11:04:07 2008
@@ -0,0 +1,129 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "BUtils.h"
+
+/* Stolen from pp_ctl.c (with modifications) */
+
+static I32
+dopoptosub_at(pTHX_ PERL_CONTEXT *cxstk, I32 startingblock)
+{
+ dTHR;
+ I32 i;
+ PERL_CONTEXT *cx;
+ for (i = startingblock; i >= 0; i--) {
+ cx = &cxstk[i];
+ switch (CxTYPE(cx)) {
+ default:
+ continue;
+ /*case CXt_EVAL:*/
+ case CXt_SUB:
+ /* In Perl 5.005, formats just used CXt_SUB */
+#ifdef CXt_FORMAT
+ case CXt_FORMAT:
+#endif
+ DEBUG_l( Perl_deb(aTHX_ "(Found sub #%ld)\n", (long)i));
+ return i;
+ }
+ }
+ return i;
+}
+
+static I32
+dopoptosub(pTHX_ I32 startingblock)
+{
+ dTHR;
+ return dopoptosub_at(aTHX_ cxstack, startingblock);
+}
+
+/* This function is based on the code of pp_caller */
+PERL_CONTEXT*
+BUtils_op_upcontext(pTHX_ I32 count, COP **cop_p, PERL_CONTEXT **ccstack_p,
+ I32 *cxix_from_p, I32 *cxix_to_p)
+{
+ PERL_SI *top_si = PL_curstackinfo;
+ I32 cxix = dopoptosub(aTHX_ cxstack_ix);
+ PERL_CONTEXT *ccstack = cxstack;
+
+ if (cxix_from_p) *cxix_from_p = cxstack_ix+1;
+ if (cxix_to_p) *cxix_to_p = cxix;
+ for (;;) {
+ /* we may be in a higher stacklevel, so dig down deeper */
+ while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
+ top_si = top_si->si_prev;
+ ccstack = top_si->si_cxstack;
+ cxix = dopoptosub_at(aTHX_ ccstack, top_si->si_cxix);
+ if (cxix_to_p && cxix_from_p) *cxix_from_p = *cxix_to_p;
+ if (cxix_to_p) *cxix_to_p = cxix;
+ }
+ if (cxix < 0 && count == 0) {
+ if (ccstack_p) *ccstack_p = ccstack;
+ return (PERL_CONTEXT *)0;
+ }
+ else if (cxix < 0)
+ return (PERL_CONTEXT *)-1;
+ if (PL_DBsub && cxix >= 0 &&
+ ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
+ count++;
+ if (!count--)
+ break;
+
+ if (cop_p) *cop_p = ccstack[cxix].blk_oldcop;
+ cxix = dopoptosub_at(aTHX_ ccstack, cxix - 1);
+ if (cxix_to_p && cxix_from_p) *cxix_from_p = *cxix_to_p;
+ if (cxix_to_p) *cxix_to_p = cxix;
+ }
+ if (ccstack_p) *ccstack_p = ccstack;
+ return &ccstack[cxix];
+}
+
+/* The most popular error message */
+#define TOO_FAR \
+ croak("want: Called from outside a subroutine")
+
+/* Between 5.9.1 and 5.9.2 the retstack was removed, and the
+ return op is now stored on the cxstack. */
+#define HAS_RETSTACK (\
+ PERL_REVISION < 5 || \
+ (PERL_REVISION == 5 && PERL_VERSION < 9) || \
+ (PERL_REVISION == 5 && PERL_VERSION == 9 && PERL_SUBVERSION < 2) \
+)
+
+OP*
+find_return_op(pTHX_ I32 uplevel)
+{
+ PERL_CONTEXT *cx = BUtils_op_upcontext(aTHX_ uplevel, 0, 0, 0, 0);
+ if (!cx) TOO_FAR;
+#if HAS_RETSTACK
+ return PL_retstack[cx->blk_oldretsp - 1];
+#else
+ return cx->blk_sub.retop;
+#endif
+}
+
+OP*
+find_oldcop(pTHX_ I32 uplevel)
+{
+ PERL_CONTEXT *cx = BUtils_op_upcontext(aTHX_ uplevel, 0, 0, 0, 0);
+ if (!cx) TOO_FAR;
+ return (OP*) cx->blk_oldcop;
+}
+
+
+MODULE = B::Utils::OP PACKAGE = B::Utils::OP PREFIX = BUtils_OP_
+PROTOTYPES: DISABLE
+
+B::OP
+parent_op(I32 uplevel)
+ CODE:
+ RETVAL = find_oldcop(aTHX_ uplevel);
+ OUTPUT:
+ RETVAL
+
+B::OP
+return_op(I32 uplevel)
+ CODE:
+ RETVAL = find_return_op(aTHX_ uplevel);
+ OUTPUT:
+ RETVAL
+
Modified: B-Utils/Utils.xs
==============================================================================
--- B-Utils/Utils.xs (original)
+++ B-Utils/Utils.xs Sat Aug 16 11:04:07 2008
@@ -255,4 +255,29 @@
return arg;
}
+/* XXX: this actually belongs to B::Generate */
MODULE = B::Utils PACKAGE = B::Utils
+
+#define PERL_CORE
+#include "embed.h"
+
+#define newSV_type(a) Perl_newSV_type(aTHX_ a)
+
+B::CV
+CvNEW_with_start(cv, root, start)
+ B::CV cv
+ B::OP root
+ B::OP start
+ PREINIT:
+ CV *new;
+ CODE:
+ new = cv_clone(cv);
+ CvROOT(new) = root;
+ CvSTART(new) = start;
+ CvDEPTH(new) = 0;
+ SvREFCNT_inc(new);
+ RETVAL = new;
+ OUTPUT:
+ RETVAL
+
+#undef PERL_CORE
Modified: B-Utils/lib/B/Utils.pm
==============================================================================
--- B-Utils/lib/B/Utils.pm (original)
+++ B-Utils/lib/B/Utils.pm Sat Aug 16 11:04:07 2008
@@ -33,7 +33,8 @@
use base 'DynaLoader';
bootstrap B::Utils $VERSION;
-
+#bootstrap B::Utils::OP $VERSION;
+#B::Utils::OP::boot_B__Utils__OP();
sub dl_load_flags {0x01}
=head1 SYNOPSIS
@@ -1071,18 +1072,38 @@
return $args;
}
+*B::CV::NEW_with_start = *CvNEW_with_start;
+
=back
=head2 EXPORT
None by default.
+=head2 XS EXPORT
+
+This modules uses L<ExtUtils::Depends> to export some useful functions
+for XS modules to use. To use those, include in your Makefile.PL:
+
+ my $pkg = ExtUtils::Depends->new("Your::XSModule", "B::Utils");
+ WriteMakefile(
+ ... # your normal makefile flags
+ $pkg->get_makefile_vars,
+ );
+
+Your XS module can now include F<BUtils.h> and F<BUtils_op.h>. To see
+document for the functions provided, use:
+
+ perldoc -m B::Utils::Install::BUtils.h
+ perldoc -m B::Utils::Install::BUtils_op.h
+
=head1 AUTHOR
Originally written by Simon Cozens, C<simon at cpan.org>
Maintained by Joshua ben Jore, C<jjore at cpan.org>
-Contributions from Mattia Barbon, Jim Cromie, and Steffen Mueller.
+Contributions from Mattia Barbon, Jim Cromie, Steffen Mueller, and
+Chia-liang Kao.
=head1 LICENSE
Added: B-Utils/lib/B/Utils/OP.pm
==============================================================================
--- (empty file)
+++ B-Utils/lib/B/Utils/OP.pm Sat Aug 16 11:04:07 2008
@@ -0,0 +1,110 @@
+package B::Utils::OP;
+
+require 5.006;
+use Carp 'croak';
+use strict;
+use warnings;
+use B::Utils ();
+
+use base 'Exporter';
+our $VERSION = '0.06';
+our @EXPORT = qw(parent_op return_op);
+
+use base 'DynaLoader';
+
+# the boot symbol is in B::Utils. bootstrap doesn't like it, so we
+# need to load it manually.
+my $bootname = 'boot_B__Utils__OP';
+if (my $boot_symbol_ref = DynaLoader::dl_find_symbol_anywhere($bootname)) {
+ DynaLoader::dl_install_xsub(__PACKAGE__."::bootstrap", $boot_symbol_ref, __FILE__)->(__PACKAGE__, $VERSION);
+}
+
+=head1 NAME
+
+B::Utils - op related utility functions for perl
+
+=head1 SYNOPSIS
+
+ use B::OP::Util qw(parent_op return_op);
+ sub foo {
+ my $pop = parent_op(0);
+ my $rop = return_op(0);
+ }
+
+=head1 DESCRIPTION
+
+ sub foo {
+ dothis(1);
+ find_things();
+ return;
+ }
+
+has the following optree:
+
+ d <1> leavesub[1 ref] K/REFC,1 ->(end)
+ - <@> lineseq KP ->d
+ 1 <;> nextstate(main -371 bah.pl:8) v/2 ->2
+ 5 <1> entersub[t2] vKS/TARG,3 ->6
+ - <1> ex-list K ->5
+ 2 <0> pushmark s ->3
+ 3 <$> const[IV 1] sM ->4
+ - <1> ex-rv2cv sK/3 ->-
+ 4 <#> gv[*dothis] s ->5
+ 6 <;> nextstate(main -371 bah.pl:9) v/2 ->7
+
+ 9 <1> entersub[t4] vKS/TARG,3 ->a
+ - <1> ex-list K ->9
+ 7 <0> pushmark s ->8
+ - <1> ex-rv2cv sK/3 ->-
+ 8 <#> gv[*find_things] s/EARLYCV ->9
+
+ a <;> nextstate(main -371 bah.pl:10) v/2 ->b
+ c <@> return K ->d
+ b <0> pushmark s ->c
+
+The C<find_things> in C<foo> is called in the C<entersub> in #9. If
+you call C<parent_op> function with level 0, you get the C<nextstate>
+op that is before the entersub, which is #6. And C<return_op> gives
+you the next op that the caller is returning to, in this case, the
+C<nextstate> in #a.
+
+=head2 EXPORTED PERL FUNCTIONS
+
+=over
+
+=item parent_op($lv)
+
+In runtime, returns the L<B::OP> object whose next is the C<entersub> of the current context up level C<$lv>
+
+=item return_op($lv)
+
+In runtime, returns the L<B::OP> object that the current context is returning to at level C<$lv>
+
+=back
+
+=head2 B::CV METHODS
+
+=over
+
+=item $cv->NEW_with_start($root, $start)
+
+Clone the C<$cv> but with different C<$root> and C<$start>
+
+=back
+
+=head1 AUTHORS
+
+Chia-liang Kao E<lt>clkao at clkao.orgE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2008 by Chia-liang Kao
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
+
+1;
More information about the Jifty-commit
mailing list