[Jifty-commit] r5728 - B-Utils
Jifty commits
jifty-commit at lists.jifty.org
Sat Aug 16 06:17:44 EDT 2008
Author: clkao
Date: Sat Aug 16 06:17:43 2008
New Revision: 5728
Added:
B-Utils/typemap
Modified:
B-Utils/BUtils.h
B-Utils/Makefile.PL
B-Utils/Utils.xs
Log:
- typemap and install helpers.
- clean up stuff for context for now.
Modified: B-Utils/BUtils.h
==============================================================================
--- B-Utils/BUtils.h (original)
+++ B-Utils/BUtils.h Sat Aug 16 06:17:43 2008
@@ -1,11 +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
Modified: B-Utils/Makefile.PL
==============================================================================
--- B-Utils/Makefile.PL (original)
+++ B-Utils/Makefile.PL Sat Aug 16 06:17:43 2008
@@ -1,11 +1,12 @@
use lib 'inc';
require ExtUtils::Depends;
-my $butils = ExtUtils::Depends->new('B::Utils');
+my $pkg = ExtUtils::Depends->new('B::Utils');
-$butils->install('BUtils.h');
+$pkg->install('BUtils.h');
+$pkg->add_typemaps("typemap");
+$pkg->save_config('build/IFiles.pm');
-$butils->save_config('build/IFiles.pm');
use ExtUtils::MakeMaker;
WriteMakefile(
@@ -15,5 +16,5 @@
ABSTRACT_FROM => 'lib/B/Utils.pm',
AUTHOR => 'Joshua b. Jore <jjore at cpan.org>',
LICENSE => 'perl',
- $butils->get_makefile_vars,
+ $pkg->get_makefile_vars,
);
Modified: B-Utils/Utils.xs
==============================================================================
--- B-Utils/Utils.xs (original)
+++ B-Utils/Utils.xs Sat Aug 16 06:17:43 2008
@@ -255,72 +255,4 @@
return arg;
}
-/* Stolen from pp_ctl.c (with modifications) */
-
-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:
- case CXt_FORMAT:
- DEBUG_l( Perl_deb(aTHX_ "(Found sub #%ld)\n", (long)i));
- return i;
- }
- }
- return i;
-}
-
-I32
-dopoptosub(pTHX_ I32 startingblock)
-{
- dTHR;
- return dopoptosub_at(aTHX_ cxstack, startingblock);
-}
-
-PERL_CONTEXT*
-upcontext(pTHX_ I32 count)
-{
- PERL_SI *top_si = PL_curstackinfo;
- I32 cxix = dopoptosub(aTHX_ cxstack_ix);
- PERL_CONTEXT *cx;
- PERL_CONTEXT *ccstack = cxstack;
- I32 dbcxix;
-
- 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 < 0) {
- return (PERL_CONTEXT *)0;
- }
- if (PL_DBsub && cxix >= 0 &&
- ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
- count++;
- if (!count--)
- break;
- cxix = dopoptosub_at(aTHX_ ccstack, cxix - 1);
- }
- cx = &ccstack[cxix];
- if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
- dbcxix = dopoptosub_at(aTHX_ ccstack, cxix - 1);
- /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
- field below is defined for any cx. */
- if (PL_DBsub && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub)) {
- cx = &ccstack[dbcxix];
- }
- }
- return cx;
-}
-
MODULE = B::Utils PACKAGE = B::Utils
Added: B-Utils/typemap
==============================================================================
--- (empty file)
+++ B-Utils/typemap Sat Aug 16 06:17:43 2008
@@ -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));
More information about the Jifty-commit
mailing list