[Jifty-commit] r5464 - in B-Generate/vendor: . lib t
Jifty commits
jifty-commit at lists.jifty.org
Fri May 16 03:11:44 EDT 2008
Author: clkao
Date: Fri May 16 03:11:44 2008
New Revision: 5464
Added:
B-Generate/vendor/Artistic
B-Generate/vendor/Build.PL
B-Generate/vendor/Changes
B-Generate/vendor/Copying
B-Generate/vendor/MANIFEST
B-Generate/vendor/META.yml
B-Generate/vendor/Makefile.PL
B-Generate/vendor/lib/
B-Generate/vendor/lib/B/
B-Generate/vendor/lib/B/Generate.pm
B-Generate/vendor/lib/B/Generate.xs
B-Generate/vendor/t/
B-Generate/vendor/t/basic.t
B-Generate/vendor/typemap
Log:
import B::Generate 1.11
Added: B-Generate/vendor/Artistic
==============================================================================
--- (empty file)
+++ B-Generate/vendor/Artistic Fri May 16 03:11:44 2008
@@ -0,0 +1,131 @@
+
+
+
+
+ The "Artistic License"
+
+ Preamble
+
+The intent of this document is to state the conditions under which a
+Package may be copied, such that the Copyright Holder maintains some
+semblance of artistic control over the development of the package,
+while giving the users of the package the right to use and distribute
+the Package in a more-or-less customary fashion, plus the right to make
+reasonable modifications.
+
+Definitions:
+
+ "Package" refers to the collection of files distributed by the
+ Copyright Holder, and derivatives of that collection of files
+ created through textual modification.
+
+ "Standard Version" refers to such a Package if it has not been
+ modified, or has been modified in accordance with the wishes
+ of the Copyright Holder as specified below.
+
+ "Copyright Holder" is whoever is named in the copyright or
+ copyrights for the package.
+
+ "You" is you, if you're thinking about copying or distributing
+ this Package.
+
+ "Reasonable copying fee" is whatever you can justify on the
+ basis of media cost, duplication charges, time of people involved,
+ and so on. (You will not be required to justify it to the
+ Copyright Holder, but only to the computing community at large
+ as a market that must bear the fee.)
+
+ "Freely Available" means that no fee is charged for the item
+ itself, though there may be fees involved in handling the item.
+ It also means that recipients of the item may redistribute it
+ under the same conditions they received it.
+
+1. You may make and give away verbatim copies of the source form of the
+Standard Version of this Package without restriction, provided that you
+duplicate all of the original copyright notices and associated disclaimers.
+
+2. You may apply bug fixes, portability fixes and other modifications
+derived from the Public Domain or from the Copyright Holder. A Package
+modified in such a way shall still be considered the Standard Version.
+
+3. You may otherwise modify your copy of this Package in any way, provided
+that you insert a prominent notice in each changed file stating how and
+when you changed that file, and provided that you do at least ONE of the
+following:
+
+ a) place your modifications in the Public Domain or otherwise make them
+ Freely Available, such as by posting said modifications to Usenet or
+ an equivalent medium, or placing the modifications on a major archive
+ site such as uunet.uu.net, or by allowing the Copyright Holder to include
+ your modifications in the Standard Version of the Package.
+
+ b) use the modified Package only within your corporation or organization.
+
+ c) rename any non-standard executables so the names do not conflict
+ with standard executables, which must also be provided, and provide
+ a separate manual page for each non-standard executable that clearly
+ documents how it differs from the Standard Version.
+
+ d) make other distribution arrangements with the Copyright Holder.
+
+4. You may distribute the programs of this Package in object code or
+executable form, provided that you do at least ONE of the following:
+
+ a) distribute a Standard Version of the executables and library files,
+ together with instructions (in the manual page or equivalent) on where
+ to get the Standard Version.
+
+ b) accompany the distribution with the machine-readable source of
+ the Package with your modifications.
+
+ c) give non-standard executables non-standard names, and clearly
+ document the differences in manual pages (or equivalent), together
+ with instructions on where to get the Standard Version.
+
+ d) make other distribution arrangements with the Copyright Holder.
+
+5. You may charge a reasonable copying fee for any distribution of this
+Package. You may charge any fee you choose for support of this
+Package. You may not charge a fee for this Package itself. However,
+you may distribute this Package in aggregate with other (possibly
+commercial) programs as part of a larger (possibly commercial) software
+distribution provided that you do not advertise this Package as a
+product of your own. You may embed this Package's interpreter within
+an executable of yours (by linking); this shall be construed as a mere
+form of aggregation, provided that the complete Standard Version of the
+interpreter is so embedded.
+
+6. The scripts and library files supplied as input to or produced as
+output from the programs of this Package do not automatically fall
+under the copyright of this Package, but belong to whoever generated
+them, and may be sold commercially, and may be aggregated with this
+Package. If such scripts or library files are aggregated with this
+Package via the so-called "undump" or "unexec" methods of producing a
+binary executable image, then distribution of such an image shall
+neither be construed as a distribution of this Package nor shall it
+fall under the restrictions of Paragraphs 3 and 4, provided that you do
+not represent such an executable image as a Standard Version of this
+Package.
+
+7. C subroutines (or comparably compiled subroutines in other
+languages) supplied by you and linked into this Package in order to
+emulate subroutines and variables of the language defined by this
+Package shall not be considered part of this Package, but are the
+equivalent of input as in Paragraph 6, provided these subroutines do
+not change the language in any way that would cause it to fail the
+regression tests for the language.
+
+8. Aggregation of this Package with a commercial distribution is always
+permitted provided that the use of this Package is embedded; that is,
+when no overt attempt is made to make this Package's interfaces visible
+to the end user of the commercial distribution. Such use shall not be
+construed as a distribution of this Package.
+
+9. The name of the Copyright Holder may not be used to endorse or promote
+products derived from this software without specific prior written permission.
+
+10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
+IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
+WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+
+ The End
Added: B-Generate/vendor/Build.PL
==============================================================================
--- (empty file)
+++ B-Generate/vendor/Build.PL Fri May 16 03:11:44 2008
@@ -0,0 +1,37 @@
+use strict;
+use Module::Build;
+
+my %newTweaks;
+if ( $] >= 5.008 ) {
+ $newTweaks{extra_compiler_flags}
+ = '-DPERL_CUSTOM_OPS -DPERL_CUSTOM_OPCODES -g';
+}
+
+my $class = Module::Build->subclass(
+ class => 'My::Builder',
+ code => q{
+sub compile_c {
+ my($self, $file) = @_;
+ $self->SUPER::compile_c($file);
+ return unless $^O eq 'darwin';
+ $self->{config}->{lddlflags} =~ s/-flat_namespace/-twolevel_namespace/;
+ $self->{config}->{lddlflags} =~ s/-undefined suppress/-undefined error/;
+ $self->{config}->{lddlflags} .= " $self->{config}->{archlibexp}/CORE/$self->{config}->{libperl}";
+}
+ },
+);
+
+my $build = $class->new(
+ module_name => 'B::Generate',
+ license => 'perl',
+ dynamic_config => 0,
+ no_index => { package => 'B::OP', },
+ requires => {
+ perl => '5.5.62',
+ 'ExtUtils::CBuilder' => 0,
+ 'Module::Build' => 0,
+ },
+ %newTweaks,
+);
+$build->create_build_script;
+
Added: B-Generate/vendor/Changes
==============================================================================
--- (empty file)
+++ B-Generate/vendor/Changes Fri May 16 03:11:44 2008
@@ -0,0 +1,89 @@
+Revision history for Perl extension B::Generate.
+
+1.10
+ - License clarification. B::Generate is available under the same
+ terms as perl. Dist now includes copy of Artistic and GPL licenses.
+
+1.09
+ - Merged distributions:
+ - S/SW/SWALTERS/B-Generate-1.06_1.tar.gz
+ - Removed ppaddr setting for OP_LIST
+ - Call Perl_fold_constants instead of fold_constants
+ - M/MS/MSCHWERN/B-Generate-1.06_2.tar.gz
+ - Awesome!
+ - fold_constants is called w/ thread context
+ - J/JJ/JJORE/B-Generate-1.07.tar.gz
+ - Populates specialsv_list
+ - J/JJ/JJORE/B-Generate-1.08.tar.gz
+ - Nothing interesting, apparently.
+ - RT #4747:
+ - changes to compile for 5.8.1+ by Jim Cromie <jcromie at cpan.org>
+ - altered Build.PL to add extra_compiler_flags when building for 5.8.x,
+ ie: -DPERL_CUSTOM_OPS -DPERL_CUSTOM_OPCODES
+ these didnt work for me under 5.6.x
+ - silenced redefined warnings with $SIG{__WARN__}
+ - various XS tweaks: casts, aTHX_, and Perl_ prefix on symbols
+ - various pm tweaks to silence warnings
+
+1.06 Sun Jul 28 18:43:06 CEST 2002
+ - Added support for changing PV in SvPV
+
+1.06 Tue Jul 2 14:37:43 CEST 2002
+ - If PL_compcv is set, we will return that cv instead
+ of trying to find the root. PL_compcv is only set
+ during compilation when we only can safely work with ops
+ during that compilation, and the next approach won't work
+ since optree isn't complete.
+
+1.05 Thu Jun 27 23:57:02 CEST 2002
+ - Apperently we the previous release was a bit too quick.
+ Sometimes the CV for the PL_eval_root doesn't have a real
+ CvROOT set so we create a new fake temporary CV.
+
+1.04 Thu Jun 27 22:41:07 CEST 2002
+ - Made find_cv support working in an existing eval ""
+
+1.00 Wed Aug 29 00:24:30 BST 2001
+ - It's time for a 1.0 release, this has been tested thoroughly
+ enough.
+ - Support for custom ops. Oh yes.
+
+0.07 Mon Jun 4 11:10:02 BST 2001
+ - Oh, all sorts. Mainly undocumented. Added documentation about the
+ undocumentation.
+ - append_elem has been fixed up, and prepend_elem has been added.
+ - convert and scope
+ - assignment
+ - constructor for conditional (if/then/else) ops. (B::LOGOP->newcond)
+ - constructor for subroutines. (B::CV->newsub_simple)
+ - lots of field testing with the bytecode compiler. (Shiny-Byte)
+
+0.06 Mon May 28 18:08:12 BST 2001
+ - Backed out disastrous context compilation fix
+ - Fixed B::LOGOP->new and B::LISTOP->new - it was creating binops and
+ blessing them as B::BINOP. Oops!
+ - Added the undocumented "append_elem" method; this is enough for
+ you to create subroutine calls if you know how. I should probably
+ make a "gimme a sub call" utility function.
+
+0.05 Wed Apr 18 08:50:33 2001
+ - The bastards took op_children away!
+ - Fixed interpret context compilation bug
+
+0.04 Wed Mar 21 00:18:27 2001
+ - Urgh. Fixed *nasty* segfault bug. (PL_op==0x0 after ->new)
+ - Added "linklist" and undocumented "clean" method
+ - Added "newstate" method
+ - Documentation nits
+
+0.03 Wed Jan 10 00:21:08 2001
+ - Test script needed a fix to stop ->targ pointing into never-never
+ land. Not *exactly* sure why.
+
+0.02 Fri Jan 5 13:14:29 2001
+ - Added a couple more methods and tests, mainly SVOP and SV methods.
+
+0.01 Sat Dec 23 18:00:08 2000
+ - original version; created by h2xs 1.20 with options
+ -A -n B::Generate
+
Added: B-Generate/vendor/Copying
==============================================================================
--- (empty file)
+++ B-Generate/vendor/Copying Fri May 16 03:11:44 2008
@@ -0,0 +1,248 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 1, February 1989
+
+ Copyright (C) 1989 Free Software Foundation, Inc.
+ 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The license agreements of most software companies try to keep users
+at the mercy of those companies. By contrast, our General Public
+License is intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. The
+General Public License applies to the Free Software Foundation's
+software and to any other program whose authors commit to using it.
+You can use it for your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Specifically, the General Public License is designed to make
+sure that you have the freedom to give away or sell copies of free
+software, that you receive source code or can get it if you want it,
+that you can change the software or use pieces of it in new free
+programs; and that you know you can do these things.
+
+ To protect your rights, we need to make restrictions that forbid
+anyone to deny you these rights or to ask you to surrender the rights.
+These restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+ For example, if you distribute copies of a such a program, whether
+gratis or for a fee, you must give the recipients all the rights that
+you have. You must make sure that they, too, receive or can get the
+source code. And you must tell them their rights.
+
+ We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+ Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ GNU GENERAL PUBLIC LICENSE
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License Agreement applies to any program or other work which
+contains a notice placed by the copyright holder saying it may be
+distributed under the terms of this General Public License. The
+"Program", below, refers to any such program or work, and a "work based
+on the Program" means either the Program or any work containing the
+Program or a portion of it, either verbatim or with modifications. Each
+licensee is addressed as "you".
+
+ 1. You may copy and distribute verbatim copies of the Program's source
+code as you receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice and
+disclaimer of warranty; keep intact all the notices that refer to this
+General Public License and to the absence of any warranty; and give any
+other recipients of the Program a copy of this General Public License
+along with the Program. You may charge a fee for the physical act of
+transferring a copy.
+
+ 2. You may modify your copy or copies of the Program or any portion of
+it, and copy and distribute such modifications under the terms of Paragraph
+1 above, provided that you also do the following:
+
+ a) cause the modified files to carry prominent notices stating that
+ you changed the files and the date of any change; and
+
+ b) cause the whole of any work that you distribute or publish, that
+ in whole or in part contains the Program or any part thereof, either
+ with or without modifications, to be licensed at no charge to all
+ third parties under the terms of this General Public License (except
+ that you may choose to grant warranty protection to some or all
+ third parties, at your option).
+
+ c) If the modified program normally reads commands interactively when
+ run, you must cause it, when started running for such interactive use
+ in the simplest and most usual way, to print or display an
+ announcement including an appropriate copyright notice and a notice
+ that there is no warranty (or else, saying that you provide a
+ warranty) and that users may redistribute the program under these
+ conditions, and telling the user how to view a copy of this General
+ Public License.
+
+ d) You may charge a fee for the physical act of transferring a
+ copy, and you may at your option offer warranty protection in
+ exchange for a fee.
+
+Mere aggregation of another independent work with the Program (or its
+derivative) on a volume of a storage or distribution medium does not bring
+the other work under the scope of these terms.
+
+ 3. You may copy and distribute the Program (or a portion or derivative of
+it, under Paragraph 2) in object code or executable form under the terms of
+Paragraphs 1 and 2 above provided that you also do one of the following:
+
+ a) accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of
+ Paragraphs 1 and 2 above; or,
+
+ b) accompany it with a written offer, valid for at least three
+ years, to give any third party free (except for a nominal charge
+ for the cost of distribution) a complete machine-readable copy of the
+ corresponding source code, to be distributed under the terms of
+ Paragraphs 1 and 2 above; or,
+
+ c) accompany it with the information you received as to where the
+ corresponding source code may be obtained. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form alone.)
+
+Source code for a work means the preferred form of the work for making
+modifications to it. For an executable file, complete source code means
+all the source code for all modules it contains; but, as a special
+exception, it need not include source code for modules which are standard
+libraries that accompany the operating system on which the executable
+file runs, or for standard header files or definitions files that
+accompany that operating system.
+
+ 4. You may not copy, modify, sublicense, distribute or transfer the
+Program except as expressly provided under this General Public License.
+Any attempt otherwise to copy, modify, sublicense, distribute or transfer
+the Program is void, and will automatically terminate your rights to use
+the Program under this License. However, parties who have received
+copies, or rights to use copies, from you under this General Public
+License will not have their licenses terminated so long as such parties
+remain in full compliance.
+
+ 5. By copying, distributing or modifying the Program (or any work based
+on the Program) you indicate your acceptance of this license to do so,
+and all its terms and conditions.
+
+ 6. Each time you redistribute the Program (or any work based on the
+Program), the recipient automatically receives a license from the original
+licensor to copy, distribute or modify the Program subject to these
+terms and conditions. You may not impose any further restrictions on the
+recipients' exercise of the rights granted herein.
+
+ 7. The Free Software Foundation may publish revised and/or new versions
+of the General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+Each version is given a distinguishing version number. If the Program
+specifies a version number of the license which applies to it and "any
+later version", you have the option of following the terms and conditions
+either of that version or of any later version published by the Free
+Software Foundation. If the Program does not specify a version number of
+the license, you may choose any version ever published by the Free Software
+Foundation.
+
+ 8. If you wish to incorporate parts of the Program into other free
+programs whose distribution conditions are different, write to the author
+to ask for permission. For software which is copyrighted by the Free
+Software Foundation, write to the Free Software Foundation; we sometimes
+make exceptions for this. Our decision will be guided by the two goals
+of preserving the free status of all derivatives of our free software and
+of promoting the sharing and reuse of software generally.
+
+ NO WARRANTY
+
+ 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
+REPAIR OR CORRECTION.
+
+ 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+
+ Appendix: How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to humanity, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these
+terms.
+
+ To do so, attach the following notices to the program. It is safest to
+attach them to the start of each source file to most effectively convey
+the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+ <one line to give the program's name and a brief idea of what it does.>
+ Copyright (C) 19yy <name of author>
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 1, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software Foundation,
+ Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) 19xx name of author
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the
+appropriate parts of the General Public License. Of course, the
+commands you use may be called something other than `show w' and `show
+c'; they could even be mouse-clicks or menu items--whatever suits your
+program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the
+ program `Gnomovision' (a program to direct compilers to make passes
+ at assemblers) written by James Hacker.
+
+ <signature of Ty Coon>, 1 April 1989
+ Ty Coon, President of Vice
+
+That's all there is to it!
Added: B-Generate/vendor/MANIFEST
==============================================================================
--- (empty file)
+++ B-Generate/vendor/MANIFEST Fri May 16 03:11:44 2008
@@ -0,0 +1,11 @@
+Artistic
+Build.PL
+Changes
+Copying
+lib/B/Generate.pm
+lib/B/Generate.xs
+Makefile.PL
+MANIFEST
+META.yml
+t/basic.t
+typemap
Added: B-Generate/vendor/META.yml
==============================================================================
--- (empty file)
+++ B-Generate/vendor/META.yml Fri May 16 03:11:44 2008
@@ -0,0 +1,28 @@
+---
+name: B-Generate
+version: 1.11
+author:
+ - |-
+ Simon Cozens, C<simon at cpan.org>
+ (Who else?)
+abstract: Create your own op trees.
+license: perl
+resources:
+ license: http://dev.perl.org/licenses/
+requires:
+ ExtUtils::CBuilder: 0
+ Module::Build: 0
+ perl: 5.5.62
+dynamic_config: 0
+provides:
+ B::Generate:
+ file: lib/B/Generate.pm
+ version: 1.11
+ B::OP:
+ file: lib/B/Generate.pm
+no_index:
+ package: B::OP
+generated_by: Module::Build version 0.280801
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
Added: B-Generate/vendor/Makefile.PL
==============================================================================
--- (empty file)
+++ B-Generate/vendor/Makefile.PL Fri May 16 03:11:44 2008
@@ -0,0 +1,4 @@
+
+use Module::Build::Compat;
+ Module::Build::Compat->run_build_pl(args => \@ARGV);
+ Module::Build::Compat->write_makefile();
Added: B-Generate/vendor/lib/B/Generate.pm
==============================================================================
--- (empty file)
+++ B-Generate/vendor/lib/B/Generate.pm Fri May 16 03:11:44 2008
@@ -0,0 +1,281 @@
+package B::Generate;
+
+require 5.005_62;
+use strict;
+use warnings;
+use B;
+
+require DynaLoader;
+use vars qw( @ISA $VERSION );
+ at ISA = qw(DynaLoader);
+$VERSION = '1.11';
+
+{
+ # 'no warnings' does not work.
+ local $SIG{__WARN__} = sub {
+ return if $_[0] =~ /Subroutine B(?:::\w+)+ redefined/;
+ warn $_[0];
+ };
+ B::Generate->bootstrap($VERSION);
+}
+
+package B::OP;
+use constant OP_LIST => 141; # MUST FIX CONSTANTS.
+use constant OPf_PARENS => 8; # *MUST* *FIX* *CONSTANTS*.
+use constant OPf_KIDS => 4;
+
+# This is where we implement op.c in Perl. Sssh.
+sub linklist {
+ my $o = shift;
+ if ( $o->can("first") and $o->first and ${ $o->first } ) {
+ $o->next( $o->first->linklist );
+ for ( my $kid = $o->first; $$kid; $kid = $kid->sibling ) {
+ if ( ${ $kid->sibling } ) {
+ $kid->next( $kid->sibling->linklist );
+ }
+ else {
+ $kid->next($o);
+ }
+ }
+ }
+ else {
+ $o->next($o);
+ }
+ $o->clean;
+ return $o->next;
+}
+
+sub append_elem {
+ my ( $class, $type, $first, $last ) = @_;
+ return $last unless $first and $$first;
+ return $first unless $last and $$last;
+
+ if ( $first->type() != $type
+ or ( $type == OP_LIST and ( $first->flags & OPf_PARENS ) ) )
+ {
+ return B::LISTOP->new( $type, 0, $first, $last );
+ }
+
+ if ( $first->flags() & OPf_KIDS ) {
+
+ $first->last->sibling($last);
+ }
+ else {
+ $first->flags( $first->flags | OPf_KIDS );
+ $first->first($last);
+ }
+ $first->last($last);
+ return $first;
+}
+
+sub prepend_elem {
+ my ( $class, $type, $first, $last ) = @_;
+ if ( $last->type() != $type ) {
+ return B::LISTOP->new( $type, 0, $first, $last );
+ }
+
+ if ( $type == OP_LIST ) {
+ $first->sibling( $last->first->sibling );
+ $last->first->sibling($first);
+ $last->flags( $last->flags & ~OPf_PARENS )
+ unless ( $first->flags & OPf_PARENS );
+ }
+ else {
+ unless ( $last->flags & OPf_KIDS ) {
+ $last->last($first);
+ $last->flags( $last->flags | OPf_KIDS );
+ }
+ $first->sibling( $last->first );
+ $last->first($first);
+ }
+ $last->flags( $last->flags | OPf_KIDS );
+ return $last; # I cannot believe this works.
+}
+
+sub scope {
+ my $o = shift;
+ return unless $o and $$o;
+ if ( $o->flags & OPf_PARENS ) {
+ $o = B::OP->prepend_elem( B::opnumber("lineseq"),
+ B::OP->new( "enter", 0 ), $o );
+ $o->type( B::opnumber("leave") );
+ }
+ else {
+ if ( $o->type == B::opnumber("lineseq") ) {
+ my $kid;
+ $o->type( B::opnumber("scope") );
+ $kid = $o->first;
+ die "This probably shouldn't happen (\$kid->null)\n"
+ if ( $kid->type == B::opnumber("nextstate")
+ or $kid->type == B::opnumber("dbstate") );
+ }
+ else {
+ $o = B::LISTOP->new( "scope", 0, $o, undef );
+ }
+ }
+ return ($o);
+}
+
+1;
+__END__
+# Below is stub documentation for your module. You better edit it!
+
+=head1 NAME
+
+B::Generate - Create your own op trees.
+
+=head1 SYNOPSIS
+
+ use B::Generate;
+ # Do nothing, slowly.
+ CHECK {
+ my $null = new B::OP("null",0);
+ my $enter = new B::OP("enter",0);
+ my $cop = new B::COP(0, "hiya", 0);
+ my $leave = new B::LISTOP("leave", 0, $enter, $null);
+ $leave->children(3);
+ $enter->sibling($cop);
+ $enter->next($cop);
+ $cop->sibling($null);
+ $null->next($leave);
+ $cop->next($leave);
+
+ # Tell Perl where to find our tree.
+ B::main_root($leave);
+ B::main_start($enter);
+ }
+
+=head1 WARNING
+
+This module will create segmentation faults if you don't know how to
+use it properly. Further warning: sometimes B<I> don't know how to use
+it properly.
+
+There B<are> lots of other methods and utility functions, but they are
+not documented here. This is deliberate, rather than just through
+laziness. You are expected to have read the Perl and XS sources to this
+module before attempting to do anything with it.
+
+Patches welcome.
+
+=head1 DESCRIPTION
+
+Malcolm Beattie's C<B> module allows you to examine the Perl op tree at
+runtime, in Perl space; it's the basis of the Perl compiler. But what it
+doesn't let you do is manipulate that op tree: it won't let you create
+new ops, or modify old ones. Now you can.
+
+Well, if you're intimately familiar with Perl's internals, you can.
+
+C<B::Generate> turns C<B>'s accessor methods into get-set methods.
+Hence, instead of merely saying
+
+ $op2 = $op->next;
+
+you can now say
+
+ $op->next($op2);
+
+to set the next op in the chain. It also adds constructor methods to
+create new ops. This is where it gets really hairy.
+
+ new B::OP ( type, flags )
+ new B::UNOP ( type, flags, first )
+ new B::BINOP ( type, flags, first, last )
+ new B::LOGOP ( type, flags, first, other )
+ new B::LISTOP ( type, flags, first, last )
+ new B::COP ( flags, name, first )
+
+In all of the above constructors, C<type> is either a numeric value
+representing the op type (C<62> is the addition operator, for instance)
+or the name of the op. (C<"add">)
+
+(Incidentally, if you know about custom ops and have registed them
+properly with the interpreter, you can create custom ops by name:
+C<new B::OP("mycustomop",0)>, or whatever.)
+
+C<first>, C<last> and C<other> are ops to be attached to the current op;
+these should be C<B::OP> objects. If you haven't created the ops yet,
+don't worry; give a false value, and fill them in later:
+
+ $x = new B::UNOP("negate", 0, undef);
+ # ... create some more ops ...
+ $x->first($y);
+
+In addition, one may create a new C<nextstate> operator with
+
+ newstate B::op ( flags, label, op)
+
+in the same manner as C<B::COP::new> - this will also, however, add the
+C<lineseq> op.
+
+Finally, you can set the main root and the starting op by passing ops
+to the C<B::main_root> and C<B::main_start> functions.
+
+This module can obviously be used for all sorts of fun purposes. The
+best one will be in conjuction with source filters; have your source
+filter parse an input file in a foreign language, create an op tree for
+it and get Perl to execute it. Then email me and tell me how you did it.
+And why.
+
+=head2 OTHER METHODS
+
+=over 3
+
+=item $b_sv->sv
+
+Returns a real SV instead of a C<B::SV>. For instance:
+
+ $b_sv = $svop->sv;
+ if ($b_sv->sv == 3) {
+ print "SVOP's SV has an IV of 3\n"
+ }
+
+You can't use this to set the SV. That would be scary.
+
+=item $op->dump
+
+Runs C<Perl_op_dump> on an op; this is roughly equivalent to
+C<B::Debug>, but not quite.
+
+=item $b_sv->dump
+
+Runs C<Perl_sv_dump> on an SV; this is exactly equivalent to
+C<< Devel::Peek::dump($b_sv->sv) >>
+
+=item $b_op->linklist
+
+Sets the C<op_next> pointers in the tree in correct execution order,
+overwriting the old C<next> pointers. You B<need> to do this once you've
+created an op tree for execution, unless you've carefully threaded it
+together yourself.
+
+=back
+
+=head2 EXPORT
+
+None.
+
+=head1 AUTHOR
+
+Simon Cozens, C<simon at cpan.org>
+(Who else?)
+
+=head1 MAINTAINERS
+
+This is just a list of people who have submitted patches to the
+module. To find someone to actually maintain this, please try
+contacting perl5-porters.
+
+Josh Jore, Michael Schwern, Jim Cromie, Scott Walters.
+
+=head1 LICENSE
+
+This module is available under the same licences as perl, the Artistic
+license and the GPL.
+
+=head1 SEE ALSO
+
+L<B>, F<perlguts>, F<op.c>
+
+=cut
Added: B-Generate/vendor/lib/B/Generate.xs
==============================================================================
--- (empty file)
+++ B-Generate/vendor/lib/B/Generate.xs Fri May 16 03:11:44 2008
@@ -0,0 +1,1408 @@
+#define PERL_NO_GET_CONTEXT
+#include "EXTERN.h"
+#include "perl.h"
+#include "perlapi.h"
+#include "XSUB.h"
+
+#ifdef PERL_OBJECT
+#undef PL_op_name
+#undef PL_opargs
+#undef PL_op_desc
+#define PL_op_name (get_op_names())
+#define PL_opargs (get_opargs())
+#define PL_op_desc (get_op_descs())
+#endif
+
+static char *svclassnames[] = {
+ "B::NULL",
+ "B::IV",
+ "B::NV",
+ "B::RV",
+ "B::PV",
+ "B::PVIV",
+ "B::PVNV",
+ "B::PVMG",
+ "B::BM",
+ "B::PVLV",
+ "B::AV",
+ "B::HV",
+ "B::CV",
+ "B::GV",
+ "B::FM",
+ "B::IO",
+};
+
+typedef enum {
+ OPc_NULL, /* 0 */
+ OPc_BASEOP, /* 1 */
+ OPc_UNOP, /* 2 */
+ OPc_BINOP, /* 3 */
+ OPc_LOGOP, /* 4 */
+ OPc_LISTOP, /* 5 */
+ OPc_PMOP, /* 6 */
+ OPc_SVOP, /* 7 */
+ OPc_PADOP, /* 8 */
+ OPc_PVOP, /* 9 */
+ OPc_CVOP, /* 10 */
+ OPc_LOOP, /* 11 */
+ OPc_COP /* 12 */
+} opclass;
+
+static char *opclassnames[] = {
+ "B::NULL",
+ "B::OP",
+ "B::UNOP",
+ "B::BINOP",
+ "B::LOGOP",
+ "B::LISTOP",
+ "B::PMOP",
+ "B::SVOP",
+ "B::PADOP",
+ "B::PVOP",
+ "B::CVOP",
+ "B::LOOP",
+ "B::COP"
+};
+
+static int walkoptree_debug = 0; /* Flag for walkoptree debug hook */
+
+static SV *specialsv_list[6];
+
+SV** my_current_pad;
+SV** tmp_pad;
+
+HV* root_cache;
+
+#define GEN_PAD { set_active_sub(find_cv_by_root((OP*)o));tmp_pad = PL_curpad;PL_curpad = my_current_pad; }
+#define OLD_PAD (PL_curpad = tmp_pad)
+/* #define GEN_PAD */
+/* #define OLD_PAD */
+
+void
+set_active_sub(SV *sv)
+{
+ AV* padlist;
+ SV** svp;
+ /* dTHX; */
+ // sv_dump(SvRV(sv));
+ padlist = CvPADLIST(SvRV(sv));
+ if(!padlist) {
+ dTHX;
+ sv_dump(sv);
+ sv_dump((SV*)padlist);
+ }
+ svp = AvARRAY(padlist);
+ my_current_pad = AvARRAY((AV*)svp[1]);
+}
+
+static SV *
+find_cv_by_root(OP* o) {
+ dTHX;
+ OP* root = o;
+ SV* key;
+ SV* val;
+ HE* cached;
+
+ if(PL_compcv && SvTYPE(PL_compcv) == SVt_PVCV &&
+ !PL_eval_root) {
+ // printf("Compcv\n");
+ if(SvROK(PL_compcv))
+ sv_dump(SvRV(PL_compcv));
+ return newRV((SV*)PL_compcv);
+ }
+
+
+ if(!root_cache)
+ root_cache = newHV();
+
+ while(root->op_next)
+ root = root->op_next;
+
+ key = newSViv(PTR2IV(root));
+
+ cached = hv_fetch_ent(root_cache, key, 0, 0);
+ if(cached) {
+ return HeVAL(cached);
+ }
+
+
+ if(PL_main_root == root) {
+ /* Special case, this is the main root */
+ cached = hv_store_ent(root_cache, key, newRV((SV*)PL_main_cv), 0);
+ } else if(PL_eval_root == root && PL_compcv) {
+ SV* tmpcv = (SV*)NEWSV(1104,0);
+ sv_upgrade((SV *)tmpcv, SVt_PVCV);
+ CvPADLIST(tmpcv) = CvPADLIST(PL_compcv);
+ SvREFCNT_inc(CvPADLIST(tmpcv));
+ CvROOT(tmpcv) = root;
+ OP_REFCNT_LOCK;
+ OpREFCNT_inc(root);
+ OP_REFCNT_UNLOCK;
+ cached = hv_store_ent(root_cache, key, newRV((SV*)tmpcv), 0);
+ } else {
+ /* Need to walk the symbol table, yay */
+ CV* cv = 0;
+ SV* sva;
+ SV* sv;
+ register SV* svend;
+
+ for (sva = PL_sv_arenaroot; sva; sva = (SV*)SvANY(sva)) {
+ svend = &sva[SvREFCNT(sva)];
+ for (sv = sva + 1; sv < svend; ++sv) {
+ if (SvTYPE(sv) != SVTYPEMASK && SvREFCNT(sv)) {
+ if(SvTYPE(sv) == SVt_PVCV &&
+ CvROOT(sv) == root
+ ) {
+ cv = (CV*) sv;
+ } else if( SvTYPE(sv) == SVt_PVGV && GvGP(sv) &&
+ GvCV(sv) && !SvVALID(sv) && !CvXSUB(GvCV(sv)) &&
+ CvROOT(GvCV(sv)) == root)
+ {
+ cv = (CV*) GvCV(sv);
+ }
+ }
+ }
+ }
+
+ if(!cv) {
+ Perl_die(aTHX_ "I am sorry but we couldn't find this root!\n");
+ }
+
+ cached = hv_store_ent(root_cache, key, newRV((SV*)cv), 0);
+ }
+
+ return (SV*) HeVAL(cached);
+}
+
+
+static SV *
+make_sv_object(pTHX_ SV *arg, SV *sv)
+{
+ char *type = 0;
+ IV iv;
+
+ for (iv = 0; iv < sizeof(specialsv_list)/sizeof(SV*); iv++) {
+ if (sv == specialsv_list[iv]) {
+ type = "B::SPECIAL";
+ break;
+ }
+ }
+ if (!type) {
+ type = svclassnames[SvTYPE(sv)];
+ iv = PTR2IV(sv);
+ }
+ sv_setiv(newSVrv(arg, type), iv);
+ return arg;
+}
+
+
+/*
+ #define PERL_CUSTOM_OPS
+ now defined by Build.PL, if building for 5.8.x
+ */
+static I32
+op_name_to_num(SV * name)
+{
+ dTHX;
+ char const *s;
+ char *wanted = SvPV_nolen(name);
+ int i =0;
+ int topop = OP_max;
+
+#ifdef PERL_CUSTOM_OPS
+ topop--;
+#endif
+
+ if (SvIOK(name) && SvIV(name) >= 0 && SvIV(name) < topop)
+ return SvIV(name);
+
+ for (s = PL_op_name[i]; s; s = PL_op_name[++i]) {
+ if (strEQ(s, wanted))
+ return i;
+ }
+#ifdef PERL_CUSTOM_OPS
+ if (PL_custom_op_names) {
+ HE* ent;
+ SV* value;
+ /* This is sort of a hv_exists, backwards */
+ (void)hv_iterinit(PL_custom_op_names);
+ while ((ent = hv_iternext(PL_custom_op_names))) {
+ if (strEQ(SvPV_nolen(hv_iterval(PL_custom_op_names,ent)),wanted))
+ return OP_CUSTOM;
+ }
+ }
+#endif
+
+ croak("No such op \"%s\"", SvPV_nolen(name));
+
+ return -1;
+}
+
+#ifdef PERL_CUSTOM_OPS
+static void*
+custom_op_ppaddr(char *name)
+{
+ dTHX;
+ HE *ent;
+ SV *value;
+ if (!PL_custom_op_names)
+ return 0;
+
+ /* This is sort of a hv_fetch, backwards */
+ (void)hv_iterinit(PL_custom_op_names);
+ while ((ent = hv_iternext(PL_custom_op_names))) {
+ if (strEQ(SvPV_nolen(hv_iterval(PL_custom_op_names,ent)),name))
+ return (void*)SvIV(hv_iterkeysv(ent));
+ }
+
+ return 0;
+}
+#endif
+
+static opclass
+cc_opclass(pTHX_ OP *o)
+{
+ if (!o)
+ return OPc_NULL;
+ // op_dump(o);
+ if (o->op_type == 0)
+ return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
+
+ if (o->op_type == OP_SASSIGN)
+ return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
+
+#ifdef USE_ITHREADS
+ if (o->op_type == OP_GV || o->op_type == OP_GVSV || o->op_type == OP_AELEMFAST)
+ return OPc_PADOP;
+#endif
+
+ switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
+ case OA_BASEOP:
+ return OPc_BASEOP;
+
+ case OA_UNOP:
+ return OPc_UNOP;
+
+ case OA_BINOP:
+ return OPc_BINOP;
+
+ case OA_LOGOP:
+ return OPc_LOGOP;
+
+ case OA_LISTOP:
+ return OPc_LISTOP;
+
+ case OA_PMOP:
+ return OPc_PMOP;
+
+ case OA_SVOP:
+ return OPc_SVOP;
+
+ case OA_PADOP:
+ return OPc_PADOP;
+
+ case OA_PVOP_OR_SVOP:
+ /*
+ * Character translations (tr///) are usually a PVOP, keeping a
+ * pointer to a table of shorts used to look up translations.
+ * Under utf8, however, a simple table isn't practical; instead,
+ * the OP is an SVOP, and the SV is a reference to a swash
+ * (i.e., an RV pointing to an HV).
+ */
+ return (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
+ ? OPc_SVOP : OPc_PVOP;
+
+ case OA_LOOP:
+ return OPc_LOOP;
+
+ case OA_COP:
+ return OPc_COP;
+
+ case OA_BASEOP_OR_UNOP:
+ /*
+ * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
+ * whether parens were seen. perly.y uses OPf_SPECIAL to
+ * signal whether a BASEOP had empty parens or none.
+ * Some other UNOPs are created later, though, so the best
+ * test is OPf_KIDS, which is set in newUNOP.
+ */
+ return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
+
+ case OA_FILESTATOP:
+ /*
+ * The file stat OPs are created via UNI(OP_foo) in toke.c but use
+ * the OPf_REF flag to distinguish between OP types instead of the
+ * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
+ * return OPc_UNOP so that walkoptree can find our children. If
+ * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
+ * (no argument to the operator) it's an OP; with OPf_REF set it's
+ * an SVOP (and op_sv is the GV for the filehandle argument).
+ */
+ return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
+#ifdef USE_ITHREADS
+ (o->op_flags & OPf_REF) ? OPc_PADOP : OPc_BASEOP);
+#else
+ (o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP);
+#endif
+ case OA_LOOPEXOP:
+ /*
+ * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
+ * label was omitted (in which case it's a BASEOP) or else a term was
+ * seen. In this last case, all except goto are definitely PVOP but
+ * goto is either a PVOP (with an ordinary constant label), an UNOP
+ * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
+ * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
+ * get set.
+ */
+ if (o->op_flags & OPf_STACKED)
+ return OPc_UNOP;
+ else if (o->op_flags & OPf_SPECIAL)
+ return OPc_BASEOP;
+ else
+ return OPc_PVOP;
+ }
+ warn("can't determine class of operator %s, assuming BASEOP\n",
+ PL_op_name[o->op_type]);
+ return OPc_BASEOP;
+}
+
+static char *
+cc_opclassname(pTHX_ OP *o)
+{
+ return opclassnames[cc_opclass(aTHX_ o)];
+}
+
+static OP *
+SVtoO(SV* sv) {
+ dTHX;
+ if (SvROK(sv)) {
+ IV tmp = SvIV((SV*)SvRV(sv));
+ return INT2PTR(OP*,tmp);
+ }
+ else {
+ return 0;
+ }
+ croak("Argument is not a reference");
+ return 0; /* Not reached */
+}
+
+/* Pre-5.7 compatibility */
+#ifndef op_clear
+void op_clear(OP* o) {
+ /* Fake it, I'm bored */
+ croak("This operation requires a newer version of Perl");
+}
+#endif
+#ifndef op_null
+#define op_null croak("This operation requires a newer version of Perl");
+#endif
+
+#ifndef PM_GETRE
+#define PM_GETRE(o) ((o)->op_pmregexp)
+#endif
+
+typedef OP *B__OP;
+typedef UNOP *B__UNOP;
+typedef BINOP *B__BINOP;
+typedef LOGOP *B__LOGOP;
+typedef LISTOP *B__LISTOP;
+typedef PMOP *B__PMOP;
+typedef SVOP *B__SVOP;
+typedef PADOP *B__PADOP;
+typedef PVOP *B__PVOP;
+typedef LOOP *B__LOOP;
+typedef COP *B__COP;
+
+typedef SV *B__SV;
+typedef SV *B__IV;
+typedef SV *B__PV;
+typedef SV *B__NV;
+typedef SV *B__PVMG;
+typedef SV *B__PVLV;
+typedef SV *B__BM;
+typedef SV *B__RV;
+typedef AV *B__AV;
+typedef HV *B__HV;
+typedef CV *B__CV;
+typedef GV *B__GV;
+typedef IO *B__IO;
+
+typedef MAGIC *B__MAGIC;
+
+MODULE = B::Generate PACKAGE = B PREFIX = B_
+
+void
+B_fudge()
+ CODE:
+ SSCHECK(2);
+ SSPUSHPTR((SV*)PL_comppad);
+ SSPUSHINT(SAVEt_COMPPAD);
+
+B::OP
+B_main_root(...)
+ PROTOTYPE: ;$
+ CODE:
+ if (items > 0)
+ PL_main_root = SVtoO(ST(0));
+ RETVAL = PL_main_root;
+ OUTPUT:
+ RETVAL
+
+B::OP
+B_main_start(...)
+ PROTOTYPE: ;$
+ CODE:
+ if (items > 0)
+ PL_main_start = SVtoO(ST(0));
+ RETVAL = PL_main_start;
+ OUTPUT:
+ RETVAL
+
+#define OP_desc(o) PL_op_desc[o->op_type]
+
+MODULE = B::Generate PACKAGE = B::OP PREFIX = OP_
+
+B::CV
+OP_find_cv(o)
+ B::OP o
+ CODE:
+ RETVAL = (CV*)SvRV(find_cv_by_root((OP*)o));
+ OUTPUT:
+ RETVAL
+
+B::OP
+OP_next(o, ...)
+ B::OP o
+ CODE:
+ if (items > 1)
+ o->op_next = SVtoO(ST(1));
+ RETVAL = o->op_next;
+ OUTPUT:
+ RETVAL
+
+B::OP
+OP_sibling(o, ...)
+ B::OP o
+ CODE:
+ if (items > 1)
+ o->op_sibling = SVtoO(ST(1));
+ RETVAL = o->op_sibling;
+ OUTPUT:
+ RETVAL
+
+IV
+OP_ppaddr(o, ...)
+ B::OP o
+ CODE:
+ if (items > 1)
+ o->op_ppaddr = (void*)SvIV(ST(1));
+ RETVAL = PTR2IV((void*)(o->op_ppaddr));
+ OUTPUT:
+ RETVAL
+
+char *
+OP_desc(o)
+ B::OP o
+
+PADOFFSET
+OP_targ(o, ...)
+ B::OP o
+ CODE:
+ if (items > 1)
+ o->op_targ = (PADOFFSET)SvIV(ST(1));
+
+ /* begin highly experimental */
+ if (items > 1 && (SvIV(ST(1)) > 1000 || SvIV(ST(1)) & 0x80000000)) {
+
+ AV *padlist = INT2PTR(AV*,SvIV(ST(1)));
+
+ I32 old_padix = PL_padix;
+ I32 old_comppad_name_fill = PL_comppad_name_fill;
+ I32 old_min_intro_pending = PL_min_intro_pending;
+ I32 old_max_intro_pending = PL_max_intro_pending;
+ // int old_cv_has_eval = PL_cv_has_eval;
+ I32 old_pad_reset_pending = PL_pad_reset_pending;
+ SV **old_curpad = PL_curpad;
+ AV *old_comppad = PL_comppad;
+ AV *old_comppad_name = PL_comppad_name;
+
+ // PTR2UV
+
+ PL_comppad_name = (AV*)(*av_fetch(padlist, 0, FALSE));
+ PL_comppad = (AV*)(*av_fetch(padlist, 1, FALSE));
+ PL_curpad = AvARRAY(PL_comppad);
+
+ PL_padix = AvFILLp(PL_comppad_name);
+ PL_pad_reset_pending = 0;
+ // <medwards> PL_comppad_name_fill appears irrelevant as long as you stick to pad_alloc, pad_swipe, pad_free.
+ // PL_comppad_name_fill = 0;
+ // PL_min_intro_pending = 0;
+ // PL_cv_has_eval = 0;
+
+ o->op_targ = Perl_pad_alloc(aTHX_ 0, SVs_PADTMP);
+
+ PL_padix = old_padix;
+ PL_comppad_name_fill = old_comppad_name_fill;
+ PL_min_intro_pending = old_min_intro_pending;
+ PL_max_intro_pending = old_max_intro_pending;
+ // PL_cv_has_eval = old_cv_has_eval;
+ PL_pad_reset_pending = old_pad_reset_pending;
+ PL_curpad = old_curpad;
+ PL_comppad = old_comppad;
+ PL_comppad_name = old_comppad_name;
+
+ }
+ /* end highly experimental */
+
+ RETVAL = o->op_targ;
+ OUTPUT:
+ RETVAL
+
+U16
+OP_type(o, ...)
+ B::OP o
+ CODE:
+ if (items > 1) {
+ o->op_type = (U16)SvIV(ST(1));
+ o->op_ppaddr = PL_ppaddr[o->op_type];
+ }
+ RETVAL = o->op_type;
+ OUTPUT:
+ RETVAL
+
+#if PERL_VERSION < 10
+
+U16
+OP_seq(o, ...)
+ B::OP o
+ CODE:
+ if (items > 1)
+ o->op_seq = (U16)SvIV(ST(1));
+ RETVAL = o->op_seq;
+ OUTPUT:
+ RETVAL
+
+#endif
+
+U8
+OP_flags(o, ...)
+ B::OP o
+ CODE:
+ if (items > 1)
+ o->op_flags = (U8)SvIV(ST(1));
+ RETVAL = o->op_flags;
+ OUTPUT:
+ RETVAL
+
+U8
+OP_private(o, ...)
+ B::OP o
+ CODE:
+ if (items > 1)
+ o->op_private = (U8)SvIV(ST(1));
+ RETVAL = o->op_private;
+ OUTPUT:
+ RETVAL
+
+void
+OP_dump(o)
+ B::OP o
+ CODE:
+ op_dump(o);
+
+void
+OP_clean(o)
+ B::OP o
+ CODE:
+ if (o == PL_main_root)
+ o->op_next = Nullop;
+
+void
+OP_new(class, type, flags)
+ SV * class
+ SV * type
+ I32 flags
+ SV** sparepad = NO_INIT
+ OP *o = NO_INIT
+ OP *saveop = NO_INIT
+ I32 typenum = NO_INIT
+ CODE:
+ sparepad = PL_curpad;
+ saveop = PL_op;
+ PL_curpad = AvARRAY(PL_comppad);
+ typenum = op_name_to_num(type);
+ o = newOP(typenum, flags);
+#ifdef PERL_CUSTOM_OPS
+ if (typenum == OP_CUSTOM)
+ o->op_ppaddr = custom_op_ppaddr(SvPV_nolen(type));
+#endif
+ PL_curpad = sparepad;
+ PL_op = saveop;
+ ST(0) = sv_newmortal();
+ sv_setiv(newSVrv(ST(0), "B::OP"), PTR2IV(o));
+
+void
+OP_newstate(class, flags, label, oldo)
+ SV * class
+ I32 flags
+ char * label
+ B::OP oldo
+ SV** sparepad = NO_INIT
+ OP *o = NO_INIT
+ OP *saveop = NO_INIT
+ CODE:
+ sparepad = PL_curpad;
+ saveop = PL_op;
+ PL_curpad = AvARRAY(PL_comppad);
+ o = newSTATEOP(flags, label, oldo);
+ PL_curpad = sparepad;
+ PL_op = saveop;
+ ST(0) = sv_newmortal();
+ sv_setiv(newSVrv(ST(0), "B::LISTOP"), PTR2IV(o));
+
+B::OP
+OP_mutate(o, type)
+ B::OP o
+ SV* type
+ I32 rtype = NO_INIT
+ CODE:
+ rtype = op_name_to_num(type);
+ o->op_ppaddr = PL_ppaddr[rtype];
+ o->op_type = rtype;
+
+ OUTPUT:
+ o
+
+B::OP
+OP_convert(o, type, flags)
+ B::OP o
+ I32 flags
+ I32 type
+ CODE:
+ if (!o || o->op_type != OP_LIST)
+ o = newLISTOP(OP_LIST, 0, o, Nullop);
+ else
+ o->op_flags &= ~OPf_WANT;
+
+ if (!(PL_opargs[type] & OA_MARK) && o->op_type != OP_NULL) {
+ op_clear(o);
+ o->op_targ = o->op_type;
+ }
+
+ o->op_type = type;
+ o->op_ppaddr = PL_ppaddr[type];
+ o->op_flags |= flags;
+
+ o = CALL_FPTR(PL_check[type])(aTHX_ (OP*)o);
+
+ if (o->op_type == type)
+ o = Perl_fold_constants(aTHX_ o);
+
+ OUTPUT:
+ o
+
+MODULE = B::Generate PACKAGE = B::UNOP PREFIX = UNOP_
+
+B::OP
+UNOP_first(o, ...)
+ B::UNOP o
+ CODE:
+ if (items > 1)
+ o->op_first = SVtoO(ST(1));
+ RETVAL = o->op_first;
+ OUTPUT:
+ RETVAL
+
+void
+UNOP_new(class, type, flags, sv_first)
+ SV * class
+ SV * type
+ I32 flags
+ SV * sv_first
+ OP *first = NO_INIT
+ OP *o = NO_INIT
+ I32 typenum = NO_INIT
+ CODE:
+ if (SvROK(sv_first)) {
+ if (!sv_derived_from(sv_first, "B::OP"))
+ Perl_croak(aTHX_ "Reference 'first' was not a B::OP object");
+ else {
+ IV tmp = SvIV((SV*)SvRV(sv_first));
+ first = INT2PTR(OP*, tmp);
+ }
+ } else if (SvTRUE(sv_first))
+ Perl_croak(aTHX_
+ "'first' argument to B::UNOP->new should be a B::OP object or a false value");
+ else
+ first = Nullop;
+ {
+ I32 padflag = 0;
+ SV**sparepad = PL_curpad;
+ OP* saveop = PL_op;
+
+ PL_curpad = AvARRAY(PL_comppad);
+ typenum = op_name_to_num(type);
+ o = newUNOP(typenum, flags, first);
+#ifdef PERL_CUSTOM_OPS
+ if (typenum == OP_CUSTOM)
+ o->op_ppaddr = custom_op_ppaddr(SvPV_nolen(type));
+#endif
+ PL_curpad = sparepad;
+ PL_op = saveop;
+ }
+ ST(0) = sv_newmortal();
+ sv_setiv(newSVrv(ST(0), "B::UNOP"), PTR2IV(o));
+
+MODULE = B::Generate PACKAGE = B::BINOP PREFIX = BINOP_
+
+void
+BINOP_null(o)
+ B::BINOP o
+ CODE:
+ op_null((OP*)o);
+
+B::OP
+BINOP_last(o,...)
+ B::BINOP o
+ CODE:
+ if (items > 1)
+ o->op_last = SVtoO(ST(1));
+ RETVAL = o->op_last;
+ OUTPUT:
+ RETVAL
+
+void
+BINOP_new(class, type, flags, sv_first, sv_last)
+ SV * class
+ SV * type
+ I32 flags
+ SV * sv_first
+ SV * sv_last
+ OP *first = NO_INIT
+ OP *last = NO_INIT
+ OP *o = NO_INIT
+ CODE:
+ if (SvROK(sv_first)) {
+ if (!sv_derived_from(sv_first, "B::OP"))
+ Perl_croak(aTHX_ "Reference 'first' was not a B::OP object");
+ else {
+ IV tmp = SvIV((SV*)SvRV(sv_first));
+ first = INT2PTR(OP*, tmp);
+ }
+ } else if (SvTRUE(sv_first))
+ Perl_croak(aTHX_
+ "'first' argument to B::UNOP->new should be a B::OP object or a false value");
+ else
+ first = Nullop;
+
+ if (SvROK(sv_last)) {
+ if (!sv_derived_from(sv_last, "B::OP"))
+ Perl_croak(aTHX_ "Reference 'last' was not a B::OP object");
+ else {
+ IV tmp = SvIV((SV*)SvRV(sv_last));
+ last = INT2PTR(OP*, tmp);
+ }
+ } else if (SvTRUE(sv_last))
+ Perl_croak(aTHX_
+ "'last' argument to B::BINOP->new should be a B::OP object or a false value");
+ else
+ last = Nullop;
+
+ {
+ SV**sparepad = PL_curpad;
+ OP* saveop = PL_op;
+ I32 typenum = op_name_to_num(type);
+
+ PL_curpad = AvARRAY(PL_comppad);
+
+ if (typenum == OP_SASSIGN || typenum == OP_AASSIGN)
+ o = newASSIGNOP(flags, first, 0, last);
+ else {
+ o = newBINOP(typenum, flags, first, last);
+#ifdef PERL_CUSTOM_OPS
+ if (typenum == OP_CUSTOM)
+ o->op_ppaddr = custom_op_ppaddr(SvPV_nolen(type));
+#endif
+ }
+
+ PL_curpad = sparepad;
+ PL_op = saveop;
+ }
+ ST(0) = sv_newmortal();
+ sv_setiv(newSVrv(ST(0), "B::BINOP"), PTR2IV(o));
+
+MODULE = B::Generate PACKAGE = B::LISTOP PREFIX = LISTOP_
+
+void
+LISTOP_new(class, type, flags, sv_first, sv_last)
+ SV * class
+ SV * type
+ I32 flags
+ SV * sv_first
+ SV * sv_last
+ OP *first = NO_INIT
+ OP *last = NO_INIT
+ OP *o = NO_INIT
+ CODE:
+ if (SvROK(sv_first)) {
+ if (!sv_derived_from(sv_first, "B::OP"))
+ Perl_croak(aTHX_ "Reference 'first' was not a B::OP object");
+ else {
+ IV tmp = SvIV((SV*)SvRV(sv_first));
+ first = INT2PTR(OP*, tmp);
+ }
+ } else if (SvTRUE(sv_first))
+ Perl_croak(aTHX_
+ "'first' argument to B::UNOP->new should be a B::OP object or a false value");
+ else
+ first = Nullop;
+
+ if (SvROK(sv_last)) {
+ if (!sv_derived_from(sv_last, "B::OP"))
+ Perl_croak(aTHX_ "Reference 'last' was not a B::OP object");
+ else {
+ IV tmp = SvIV((SV*)SvRV(sv_last));
+ last = INT2PTR(OP*, tmp);
+ }
+ } else if (SvTRUE(sv_last))
+ Perl_croak(aTHX_
+ "'last' argument to B::BINOP->new should be a B::OP object or a false value");
+ else
+ last = Nullop;
+
+ {
+ SV**sparepad = PL_curpad;
+ OP* saveop = PL_op;
+ I32 typenum = op_name_to_num(type);
+
+ PL_curpad = AvARRAY(PL_comppad);
+ o = newLISTOP(typenum, flags, first, last);
+#ifdef PERL_CUSTOM_OPS
+ if (typenum == OP_CUSTOM)
+ o->op_ppaddr = custom_op_ppaddr(SvPV_nolen(type));
+#endif
+ PL_curpad = sparepad;
+ PL_op = saveop;
+ }
+ ST(0) = sv_newmortal();
+ sv_setiv(newSVrv(ST(0), "B::LISTOP"), PTR2IV(o));
+
+MODULE = B::Generate PACKAGE = B::LOGOP PREFIX = LOGOP_
+
+void
+LOGOP_new(class, type, flags, sv_first, sv_last)
+ SV * class
+ SV * type
+ I32 flags
+ SV * sv_first
+ SV * sv_last
+ OP *first = NO_INIT
+ OP *last = NO_INIT
+ OP *o = NO_INIT
+ CODE:
+ if (SvROK(sv_first)) {
+ if (!sv_derived_from(sv_first, "B::OP"))
+ Perl_croak(aTHX_ "Reference 'first' was not a B::OP object");
+ else {
+ IV tmp = SvIV((SV*)SvRV(sv_first));
+ first = INT2PTR(OP*, tmp);
+ }
+ } else if (SvTRUE(sv_first))
+ Perl_croak(aTHX_
+ "'first' argument to B::UNOP->new should be a B::OP object or a false value");
+ else
+ first = Nullop;
+
+ if (SvROK(sv_last)) {
+ if (!sv_derived_from(sv_last, "B::OP"))
+ Perl_croak(aTHX_ "Reference 'last' was not a B::OP object");
+ else {
+ IV tmp = SvIV((SV*)SvRV(sv_last));
+ last = INT2PTR(OP*, tmp);
+ }
+ } else if (SvTRUE(sv_last))
+ Perl_croak(aTHX_
+ "'last' argument to B::BINOP->new should be a B::OP object or a false value");
+ else
+ last = Nullop;
+
+ {
+ SV**sparepad = PL_curpad;
+ OP* saveop = PL_op;
+ I32 typenum = op_name_to_num(type);
+ PL_curpad = AvARRAY(PL_comppad);
+ o = newLOGOP(typenum, flags, first, last);
+#ifdef PERL_CUSTOM_OPS
+ if (typenum == OP_CUSTOM)
+ o->op_ppaddr = custom_op_ppaddr(SvPV_nolen(type));
+#endif
+ PL_curpad = sparepad;
+ PL_op = saveop;
+ }
+ ST(0) = sv_newmortal();
+ sv_setiv(newSVrv(ST(0), "B::LOGOP"), PTR2IV(o));
+
+void
+LOGOP_newcond(class, flags, sv_first, sv_last, sv_else)
+ SV * class
+ I32 flags
+ SV * sv_first
+ SV * sv_last
+ SV * sv_else
+ OP *first = NO_INIT
+ OP *last = NO_INIT
+ OP *elseo = NO_INIT
+ OP *o = NO_INIT
+ CODE:
+ if (SvROK(sv_first)) {
+ if (!sv_derived_from(sv_first, "B::OP"))
+ Perl_croak(aTHX_ "Reference 'first' was not a B::OP object");
+ else {
+ IV tmp = SvIV((SV*)SvRV(sv_first));
+ first = INT2PTR(OP*, tmp);
+ }
+ } else if (SvTRUE(sv_first))
+ Perl_croak(aTHX_
+ "'first' argument to B::UNOP->new should be a B::OP object or a false value");
+ else
+ first = Nullop;
+
+ if (SvROK(sv_last)) {
+ if (!sv_derived_from(sv_last, "B::OP"))
+ Perl_croak(aTHX_ "Reference 'last' was not a B::OP object");
+ else {
+ IV tmp = SvIV((SV*)SvRV(sv_last));
+ last = INT2PTR(OP*, tmp);
+ }
+ } else if (SvTRUE(sv_last))
+ Perl_croak(aTHX_
+ "'last' argument to B::BINOP->new should be a B::OP object or a false value");
+ else
+ last = Nullop;
+
+ if (SvROK(sv_else)) {
+ if (!sv_derived_from(sv_else, "B::OP"))
+ Perl_croak(aTHX_ "Reference 'else' was not a B::OP object");
+ else {
+ IV tmp = SvIV((SV*)SvRV(sv_else));
+ elseo = INT2PTR(OP*, tmp);
+ }
+ } else if (SvTRUE(sv_else))
+ Perl_croak(aTHX_
+ "'last' argument to B::BINOP->new should be a B::OP object or a false value");
+ else
+ elseo = Nullop;
+
+ {
+ SV**sparepad = PL_curpad;
+ OP* saveop = PL_op;
+ PL_curpad = AvARRAY(PL_comppad);
+ o = newCONDOP(flags, first, last, elseo);
+ PL_curpad = sparepad;
+ PL_op = saveop;
+ }
+ ST(0) = sv_newmortal();
+ sv_setiv(newSVrv(ST(0), "B::LOGOP"), PTR2IV(o));
+
+B::OP
+LOGOP_other(o,...)
+ B::LOGOP o
+ CODE:
+ if (items > 1)
+ o->op_other = SVtoO(ST(1));
+ RETVAL = o->op_other;
+ OUTPUT:
+ RETVAL
+
+#if PERL_VERSION < 10
+
+#define PMOP_pmreplroot(o) o->op_pmreplroot
+#define PMOP_pmnext(o) o->op_pmnext
+#define PMOP_pmpermflags(o) o->op_pmpermflags
+
+#endif
+
+#define PMOP_pmregexp(o) o->op_pmregexp
+#define PMOP_pmflags(o) o->op_pmflags
+
+MODULE = B::Generate PACKAGE = B::PMOP PREFIX = PMOP_
+
+#if PERL_VERSION < 10
+
+void
+PMOP_pmreplroot(o)
+ B::PMOP o
+ OP * root = NO_INIT
+ CODE:
+ ST(0) = sv_newmortal();
+ root = o->op_pmreplroot;
+ /* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */
+ if (o->op_type == OP_PUSHRE) {
+ sv_setiv(newSVrv(ST(0), root ?
+ svclassnames[SvTYPE((SV*)root)] : "B::SV"),
+ PTR2IV(root));
+ }
+ else {
+ sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), PTR2IV(root));
+ }
+
+B::OP
+PMOP_pmreplstart(o, ...)
+ B::PMOP o
+ CODE:
+ if (items > 1)
+ o->op_pmreplstart = SVtoO(ST(1));
+ RETVAL = o->op_pmreplstart;
+ OUTPUT:
+ RETVAL
+
+B::PMOP
+PMOP_pmnext(o, ...)
+ B::PMOP o
+ CODE:
+ if (items > 1)
+ o->op_pmnext = (PMOP*)SVtoO(ST(1));
+ RETVAL = o->op_pmnext;
+ OUTPUT:
+ RETVAL
+
+U16
+PMOP_pmpermflags(o)
+ B::PMOP o
+
+#endif
+
+U16
+PMOP_pmflags(o)
+ B::PMOP o
+
+void
+PMOP_precomp(o)
+ B::PMOP o
+ REGEXP * rx = NO_INIT
+ CODE:
+ ST(0) = sv_newmortal();
+ rx = PM_GETRE(o);
+ if (rx)
+ sv_setpvn(ST(0), rx->precomp, rx->prelen);
+
+#define SVOP_sv(o) (cSVOPo_sv)
+#define SVOP_gv(o) ((GV*)cSVOPo_sv)
+
+MODULE = B::Generate PACKAGE = B::SVOP PREFIX = SVOP_
+
+B::SV
+SVOP_sv(o, ...)
+ B::SVOP o
+ PREINIT:
+ SV *sv;
+ CODE:
+ GEN_PAD;
+ if (items > 1) {
+ sv = newSVsv(ST(1));
+#ifdef USE_ITHREADS
+ if ( cSVOPx(o)->op_sv ) {
+ cSVOPx(o)->op_sv = sv;
+ }
+ else {
+ PAD_SVl(o->op_targ) = sv;
+ }
+#else
+ cSVOPx(o)->op_sv = sv;
+#endif
+ }
+ RETVAL = cSVOPo_sv;
+ OLD_PAD;
+ OUTPUT:
+ RETVAL
+
+B::GV
+SVOP_gv(o)
+ B::SVOP o
+
+void
+SVOP_new(class, type, flags, sv)
+ SV * class
+ SV * type
+ I32 flags
+ SV * sv
+ SV** sparepad = NO_INIT
+ OP *o = NO_INIT
+ OP *saveop = NO_INIT
+ SV* param = NO_INIT
+ I32 typenum = NO_INIT
+ CODE:
+ sparepad = PL_curpad;
+ PL_curpad = AvARRAY(PL_comppad);
+ saveop = PL_op;
+ typenum = op_name_to_num(type); /* XXX More classes here! */
+ if (typenum == OP_GVSV) {
+ if (*(SvPV_nolen(sv)) == '$')
+ param = (SV*)gv_fetchpv(SvPVX(sv)+1, TRUE, SVt_PV);
+ else
+ Perl_croak(aTHX_
+ "First character to GVSV was not dollar");
+ } else
+ param = newSVsv(sv);
+ o = newSVOP(typenum, flags, param);
+#ifdef PERL_CUSTOM_OPS
+ if (typenum == OP_CUSTOM)
+ o->op_ppaddr = custom_op_ppaddr(SvPV_nolen(type));
+#endif
+ //PL_curpad = sparepad;
+ ST(0) = sv_newmortal();
+ sv_setiv(newSVrv(ST(0), "B::SVOP"), PTR2IV(o));
+ PL_op = saveop;
+
+#define PADOP_padix(o) o->op_padix
+#define PADOP_sv(o) (o->op_padix ? PL_curpad[o->op_padix] : Nullsv)
+#define PADOP_gv(o) ((o->op_padix \
+ && SvTYPE(PL_curpad[o->op_padix]) == SVt_PVGV) \
+ ? (GV*)PL_curpad[o->op_padix] : Nullgv)
+
+MODULE = B::Generate PACKAGE = B::PADOP PREFIX = PADOP_
+
+PADOFFSET
+PADOP_padix(o, ...)
+ B::PADOP o
+ CODE:
+ if (items > 1)
+ o->op_padix = (PADOFFSET)SvIV(ST(1));
+ RETVAL = o->op_padix;
+ OUTPUT:
+ RETVAL
+
+B::SV
+PADOP_sv(o)
+ B::PADOP o
+
+B::GV
+PADOP_gv(o)
+ B::PADOP o
+
+MODULE = B::Generate PACKAGE = B::PVOP PREFIX = PVOP_
+
+void
+PVOP_pv(o)
+ B::PVOP o
+ CODE:
+ /*
+ * OP_TRANS uses op_pv to point to a table of 256 shorts
+ * whereas other PVOPs point to a null terminated string.
+ */
+ ST(0) = sv_2mortal(newSVpv(o->op_pv, (o->op_type == OP_TRANS) ?
+ 256 * sizeof(short) : 0));
+
+MODULE = B::Generate PACKAGE = B::LOOP PREFIX = LOOP_
+
+B::OP
+LOOP_redoop(o, ...)
+ B::LOOP o
+ CODE:
+ if (items > 1)
+ o->op_redoop = SVtoO(ST(1));
+ RETVAL = o->op_redoop;
+ OUTPUT:
+ RETVAL
+
+B::OP
+LOOP_nextop(o, ...)
+ B::LOOP o
+ CODE:
+ if (items > 1)
+ o->op_nextop = SVtoO(ST(1));
+ RETVAL = o->op_nextop;
+ OUTPUT:
+ RETVAL
+
+B::OP
+LOOP_lastop(o, ...)
+ B::LOOP o
+ CODE:
+ if (items > 1)
+ o->op_lastop = SVtoO(ST(1));
+ RETVAL = o->op_lastop;
+ OUTPUT:
+ RETVAL
+
+#define COP_label(o) o->cop_label
+#define COP_stashpv(o) CopSTASHPV(o)
+#define COP_stash(o) CopSTASH(o)
+#define COP_file(o) CopFILE(o)
+#define COP_cop_seq(o) o->cop_seq
+#if PERL_VERSION < 10
+#define COP_arybase(o) o->cop_arybase
+#endif
+#define COP_line(o) CopLINE(o)
+#define COP_warnings(o) o->cop_warnings
+
+MODULE = B::Generate PACKAGE = B::COP PREFIX = COP_
+
+
+char *
+COP_label(o)
+ B::COP o
+
+char *
+COP_stashpv(o)
+ B::COP o
+
+B::HV
+COP_stash(o)
+ B::COP o
+
+char *
+COP_file(o)
+ B::COP o
+
+U32
+COP_cop_seq(o)
+ B::COP o
+
+#if PERL_VERSION < 10
+
+I32
+COP_arybase(o)
+ B::COP o
+
+#endif
+
+U16
+COP_line(o)
+ B::COP o
+
+=pod
+
+/* TODO: This throws a warning that cop_warnings is (STRLEN*)
+ while I am casting to (SV*). The typedef converts special
+ values of (STRLEN*) into SV objects. Hope the initial pointer
+ casting isn't a problem. */
+
+=cut
+
+B::SV
+COP_warnings(o)
+ B::COP o
+
+B::COP
+COP_new(class, flags, name, sv_first)
+ SV * class
+ char * name
+ I32 flags
+ SV * sv_first
+ OP *first = NO_INIT
+ OP *o = NO_INIT
+ CODE:
+ if (SvROK(sv_first)) {
+ if (!sv_derived_from(sv_first, "B::OP"))
+ Perl_croak(aTHX_ "Reference 'first' was not a B::OP object");
+ else {
+ IV tmp = SvIV((SV*)SvRV(sv_first));
+ first = INT2PTR(OP*, tmp);
+ }
+ } else if (SvTRUE(sv_first))
+ Perl_croak(aTHX_
+ "'first' argument to B::COP->new should be a B::OP object or a false value");
+ else
+ first = Nullop;
+
+ {
+ SV**sparepad = PL_curpad;
+ OP* saveop = PL_op;
+ PL_curpad = AvARRAY(PL_comppad);
+ o = newSTATEOP(flags, name, first);
+ PL_curpad = sparepad;
+ PL_op = saveop;
+ }
+ ST(0) = sv_newmortal();
+ sv_setiv(newSVrv(ST(0), "B::COP"), PTR2IV(o));
+
+MODULE = B::Generate PACKAGE = B::SV PREFIX = Sv
+
+SV*
+Svsv(sv)
+ B::SV sv
+ CODE:
+ RETVAL = newSVsv(sv);
+ OUTPUT:
+ RETVAL
+
+void*
+Svdump(sv)
+ B::SV sv
+ CODE:
+ sv_dump(sv);
+
+U32
+SvFLAGS(sv, ...)
+ B::SV sv
+ CODE:
+ if (items > 1)
+ sv->sv_flags = SvIV(ST(1));
+ RETVAL = SvFLAGS(sv);
+ OUTPUT:
+ RETVAL
+
+MODULE = B::Generate PACKAGE = B::CV PREFIX = CV_
+
+B::OP
+CV_ROOT(cv)
+ B::CV cv
+ CODE:
+ if(cv == PL_main_cv) {
+ RETVAL = PL_main_root;
+ } else {
+ RETVAL = CvROOT(cv);
+ }
+ OUTPUT:
+ RETVAL
+
+B::CV
+CV_newsub_simple(class, name, block)
+ SV* class
+ SV* name
+ B::OP block
+ CV* mycv = NO_INIT
+ OP* o = NO_INIT
+
+ CODE:
+ o = newSVOP(OP_CONST, 0, name);
+ mycv = newSUB(start_subparse(FALSE, 0), o, Nullop, block);
+ /*op_free(o); */
+ RETVAL = mycv;
+ OUTPUT:
+ RETVAL
+
+
+MODULE = B::Generate PACKAGE = B::PV PREFIX = Sv
+
+void
+SvPV(sv,...)
+ B::PV sv
+ CODE:
+{
+ if(items > 1) {
+ sv_setpv(sv, SvPV_nolen(ST(1)));
+ }
+ ST(0) = sv_newmortal();
+ if( SvPOK(sv) ) {
+ sv_setpvn(ST(0), SvPVX(sv), SvCUR(sv));
+ SvFLAGS(ST(0)) |= SvUTF8(sv);
+ }
+ else {
+ /* XXX for backward compatibility, but should fail */
+ /* croak( "argument is not SvPOK" ); */
+ sv_setpvn(ST(0), NULL, 0);
+ }
+}
+
+BOOT:
+ specialsv_list[0] = Nullsv;
+ specialsv_list[1] = &PL_sv_undef;
+ specialsv_list[2] = &PL_sv_yes;
+ specialsv_list[3] = &PL_sv_no;
+ /* These are supposed to be (STRLEN*) so I cheat. Hope
+ it doesn't matter. */
+ specialsv_list[4] = (SV*)pWARN_ALL;
+ specialsv_list[5] = (SV*)pWARN_NONE;
+ specialsv_list[6] = (SV*)pWARN_STD;
Added: B-Generate/vendor/t/basic.t
==============================================================================
--- (empty file)
+++ B-Generate/vendor/t/basic.t Fri May 16 03:11:44 2008
@@ -0,0 +1,100 @@
+#!/usr/bin/perl -w
+
+use Test::More tests => 10;
+
+use B qw(svref_2object);
+BEGIN { use_ok 'B::Generate'; }
+
+CHECK {
+ my ($x, $y,$z);
+
+ # Replace addition with subtraction
+ for ($x = B::main_start; $x->type != B::opnumber("add"); $x=$x->next){ # Find "add"
+ $y=$x; # $y is the op before "add"
+ };
+ $z = B::BINOP->new("subtract",0,$x->first, $x->last); # Create replacement "subtract"
+
+ $z->next($x->next); # Copy add's "next" across.
+ $y->next($z); # Tell $y to point to replacement op.
+ $z->targ($x->targ);
+
+ # Turn 30 into 13
+ for(
+ $x = B::main_start;
+ B::opnumber("const") ne $x->type || $x->sv->sv ne 30;
+ $x=$x->next
+ ) {}
+ $x->sv(13);
+
+ # Turn "bad" into "good"
+ for(
+ $x = svref_2object($foo)->START;
+ ref($x) ne 'B::NULL';
+ $x = $x->next
+ ) {
+ next unless($x->can('sv'));
+ if($x->sv->PV eq "bad") {
+ $x->sv("good");
+ last;
+ }
+ }
+
+ # Turn "lead" into "gold"
+ for(
+ $x = svref_2object(\&foo::baz)->START;
+ ref($x) ne 'B::NULL';
+ $x = $x->next
+ ) {
+ next unless($x->can('sv'));
+ if($x->sv->PV eq "lead") {
+ $x->sv("gold");
+ last;
+ }
+ }
+
+}
+
+my $b; # STAY STILL!
+
+$a = 17;
+$b = 15;
+is $a + $b, 2, "Changed addition to substraction";
+
+$c = 30;
+$d = 10;
+is $c - $d, 3, "Changed the number 30 into 13";
+
+
+# This used to segv
+ok( B::BINOP->new("add", 0, 0, 0) );
+
+
+BEGIN {
+ $foo = sub {
+ is( "bad", "good" );
+ }
+}
+$foo->();
+foo::baz();
+
+sub foo::baz {
+ is( "lead", "gold" );
+}
+
+SKIP: {
+ skip( q(->seq was removed for 5.10), 1 ) if $] >= 5.010;
+ my $x = svref_2object(\&foo::baz);
+ my $op = $x->START;
+ my $y = $op->find_cv();
+ is($x->ROOT->seq, $y->ROOT->seq);
+}
+
+{
+ my $foo = "hi";
+ my $x = svref_2object(\$foo);
+ is($x->PV, "hi", 'svref2object');
+
+ $x->PV("bar");
+ is($x->PV, "bar", ' changing the value of a PV');
+ is($foo, "bar", ' and the associated lexical changes');
+}
Added: B-Generate/vendor/typemap
==============================================================================
--- (empty file)
+++ B-Generate/vendor/typemap Fri May 16 03:11:44 2008
@@ -0,0 +1,71 @@
+TYPEMAP
+
+B::OP T_OP_OBJ
+B::UNOP T_OP_OBJ
+B::BINOP T_OP_OBJ
+B::LOGOP T_OP_OBJ
+B::LISTOP T_OP_OBJ
+B::PMOP T_OP_OBJ
+B::SVOP T_OP_OBJ
+B::PADOP T_OP_OBJ
+B::PVOP T_OP_OBJ
+B::CVOP T_OP_OBJ
+B::LOOP T_OP_OBJ
+B::COP T_OP_OBJ
+
+B::SV T_SV_OBJ
+B::PV T_SV_OBJ
+B::IV T_SV_OBJ
+B::NV T_SV_OBJ
+B::PVMG T_SV_OBJ
+B::PVLV T_SV_OBJ
+B::BM T_SV_OBJ
+B::RV T_SV_OBJ
+B::GV T_SV_OBJ
+B::CV T_SV_OBJ
+B::HV T_SV_OBJ
+B::AV T_SV_OBJ
+B::IO T_SV_OBJ
+
+B::MAGIC T_MG_OBJ
+SSize_t T_IV
+STRLEN T_IV
+PADOFFSET T_UV
+
+INPUT
+T_OP_OBJ
+ if (SvROK($arg)) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = INT2PTR($type,tmp);
+ }
+ else
+ croak(\"$var is not a reference\")
+
+T_SV_OBJ
+ if (SvROK($arg)) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = INT2PTR($type,tmp);
+ }
+ else
+ croak(\"$var is not a reference\")
+
+T_MG_OBJ
+ if (SvROK($arg)) {
+ IV tmp = SvIV((SV*)SvRV($arg));
+ $var = INT2PTR($type,tmp);
+ }
+ else
+ croak(\"$var is not a reference\")
+
+OUTPUT
+T_OP_OBJ
+ sv_setiv(newSVrv($arg, cc_opclassname(aTHX_ (OP*)$var)), PTR2IV($var));
+
+T_SV_OBJ
+ make_sv_object(aTHX_ ($arg), (SV*)($var));
+
+
+T_MG_OBJ
+ sv_setiv(newSVrv($arg, "B::MAGIC"), PTR2IV($var));
+
+
More information about the Jifty-commit
mailing list