Initial Commit
This commit is contained in:
Riley Schneider
36
database/perl/vendor/lib/B/Utils/Install/BUtils.h
vendored
Normal file
36
database/perl/vendor/lib/B/Utils/Install/BUtils.h
vendored
Normal file
@@ -0,0 +1,36 @@
|
||||
#ifndef _BUTILS_H_
|
||||
#define _BUTILS_H_
|
||||
|
||||
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 SV *B__FM;
|
||||
typedef AV *B__AV;
|
||||
typedef HV *B__HV;
|
||||
typedef CV *B__CV;
|
||||
typedef GV *B__GV;
|
||||
typedef IO *B__IO;
|
||||
|
||||
extern char *BUtils_cc_opclassname(pTHX_ const OP *o);
|
||||
extern SV *BUtils_make_sv_object(pTHX_ SV *arg, SV *sv);
|
||||
|
||||
extern I32 BUtils_op_name_to_num(SV * name);
|
||||
|
||||
#endif
|
||||
37
database/perl/vendor/lib/B/Utils/Install/Files.pm
vendored
Normal file
37
database/perl/vendor/lib/B/Utils/Install/Files.pm
vendored
Normal file
@@ -0,0 +1,37 @@
|
||||
package B::Utils::Install::Files;
|
||||
|
||||
$self = {
|
||||
'deps' => [],
|
||||
'inc' => '',
|
||||
'libs' => '',
|
||||
'typemaps' => [
|
||||
'typemap'
|
||||
]
|
||||
};
|
||||
|
||||
@deps = @{ $self->{deps} };
|
||||
@typemaps = @{ $self->{typemaps} };
|
||||
$libs = $self->{libs};
|
||||
$inc = $self->{inc};
|
||||
|
||||
$CORE = undef;
|
||||
foreach (@INC) {
|
||||
if ( -f $_ . "/B/Utils/Install/Files.pm") {
|
||||
$CORE = $_ . "/B/Utils/Install/";
|
||||
last;
|
||||
}
|
||||
}
|
||||
|
||||
sub deps { @{ $self->{deps} }; }
|
||||
|
||||
sub Inline {
|
||||
my ($class, $lang) = @_;
|
||||
if ($lang ne 'C') {
|
||||
warn "Warning: Inline hints not available for $lang language
|
||||
";
|
||||
return;
|
||||
}
|
||||
+{ map { (uc($_) => $self->{$_}) } qw(inc libs typemaps) };
|
||||
}
|
||||
|
||||
1;
|
||||
96
database/perl/vendor/lib/B/Utils/Install/typemap
vendored
Normal file
96
database/perl/vendor/lib/B/Utils/Install/typemap
vendored
Normal file
@@ -0,0 +1,96 @@
|
||||
TYPEMAP
|
||||
|
||||
OP * T_OP_OBJ
|
||||
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::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::REGEXP 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::FM T_SV_OBJ
|
||||
|
||||
B::MAGIC T_MG_OBJ
|
||||
SSize_t T_IV
|
||||
STRLEN T_UV
|
||||
PADOFFSET T_UV
|
||||
|
||||
B::HE T_HE_OBJ
|
||||
B::RHE T_RHE_OBJ
|
||||
|
||||
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\")
|
||||
|
||||
T_HE_OBJ
|
||||
if (SvROK($arg)) {
|
||||
IV tmp = SvIV((SV*)SvRV($arg));
|
||||
$var = INT2PTR($type,tmp);
|
||||
}
|
||||
else
|
||||
croak(\"$var is not a reference\")
|
||||
|
||||
T_RHE_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, BUtils_cc_opclassname(aTHX_ (OP*)$var)), PTR2IV($var));
|
||||
|
||||
T_SV_OBJ
|
||||
BUtils_make_sv_object(aTHX_ ($arg), (SV*)($var));
|
||||
|
||||
|
||||
T_MG_OBJ
|
||||
sv_setiv(newSVrv($arg, "B::MAGIC"), PTR2IV($var));
|
||||
|
||||
T_HE_OBJ
|
||||
sv_setiv(newSVrv($arg, "B::HE"), PTR2IV($var));
|
||||
|
||||
T_RHE_OBJ
|
||||
sv_setiv(newSVrv($arg, "B::RHE"), PTR2IV($var));
|
||||
115
database/perl/vendor/lib/B/Utils/OP.pm
vendored
Normal file
115
database/perl/vendor/lib/B/Utils/OP.pm
vendored
Normal file
@@ -0,0 +1,115 @@
|
||||
package B::Utils::OP;
|
||||
|
||||
require 5.006;
|
||||
use Carp 'croak';
|
||||
use strict;
|
||||
use warnings;
|
||||
use B::Utils ();
|
||||
|
||||
our @ISA = 'Exporter';
|
||||
require Exporter;
|
||||
our $VERSION = '0.27';
|
||||
our @EXPORT = qw(parent_op return_op);
|
||||
|
||||
|
||||
push @ISA, '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 - op related utility functions for perl
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 0.27
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use B::Utils::OP 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@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;
|
||||
Reference in New Issue
Block a user