Perl and XS: Example 3: Set::Bit

概述#define PERL_NO_GET_CONTEXT#include "EXTERN.h"#include "perl.h"#include "XSUB.h"#include "ppport.h"typedef struct{ /* The range of the set is 0..n_bits - 1 */ int n_bits;

#define PERL_NO_GET_CONTEXT#include "EXTERN.h"#include "perl.h"#include "XSUB.h"#include "ppport.h"typedef struct{    /* The range of the set is 0..n_bits - 1 */    int n_bits;    /* The number of bytes used for storage. */    int n_chars;    /* The bytes used for storage. */    unsigned char * chars;}vector;typedef vector* Set__Bit;vector * new (pTHX_ int n_bits){    vector * p;    Newx(p,1,vector);    if (!p) {	croak ("Out of memory");    }    p->n_bits = n_bits;    /* We use one char to store the bits. The C standard promises that       one byte contains at least eight bits. */    p->n_chars = (n_bits + 8 - 1) / 8;	Newxz(p->chars,p->n_chars,unsigned char);    if (!p->chars) {	croak ("Out of memory");    }    return p;}/* Set bit "n" in "p". */voID insert (vector *p,int n){    int q;    int r;    if (n < 0 || n >= p->n_bits) {	croak ("Bit out of range");    }    q = n / 8;    r = n % 8;    p->chars[q] |= 1 << r;}voID DESTROY (vector *p){    //printf("good\n");    Safefree(p->chars);    Safefree(p);}MODulE = Set::Bit		PACKAGE = Set::Bit		Set::Bitnew(package,nBits)        char *package        int   nBits        CODE:        RETVAL = new(aTHX_ nBits);        OUTPUT:        RETVAL        voIDinsert(pVector,n)        Set::Bit pVector        int      nvoIDDESTROY(pVector)        Set::Bit pVector

 

#define PERL_NO_GET_CONTEXT#include "EXTERN.h"#include "perl.h"#include "XSUB.h"#include "ppport.h"typedef struct{    /* The range of the set is 0..n_bits - 1 */    int n_bits;    /* The number of bytes used for storage. */    int n_chars;    /* The bytes used for storage. */    unsigned char * chars;}vector;typedef vector* Set__Bit;vector * new (pTHX_ int n_bits){    vector * p;    Newx(p,int n){    int q;    int r;    if (n < 0 || n >= p->n_bits) {	croak ("Bit out of range");    }    q = n / 8;    r = n % 8;    p->chars[q] |= 1 << r;}voID DESTROY (vector *p){    printf("good luck\n");    Safefree(p->chars);    Safefree(p);}        XS(XS_Set__Bit_new){    dXSARGS;    if (items != 2)        croak("Usage: Set::Bit::new(package,nBits)");    {        int     	 nBits = (int)SvIV(ST(1));        Set__Bit 	RETVAL;        RETVAL = new(aTHX_ nBits);        ST(0) = sv_newmortal();        sv_setref_pv(ST(0),"Set::Bit",(voID*)RETVAL);    }    XSRETURN(1);}XS(XS_Set__Bit_insert){    dXSARGS;    if (items != 2)        croak("Usage: Set::Bit::insert(pVector,n)");    {        Set__Bit	pVector;        int     	n = (int)SvIV(ST(1));        if (SvROK(ST(0)) && sv_derived_from(ST(0),"Set::Bit")) {            pVector = (Set__Bit) SvIV((SV*)SvRV(ST(0)));        }        else            croak("pVector is not of type Set::Bit");        insert(pVector,n);    }    XSRETURN_EMPTY;}XS(XS_Set__Bit_DESTROY){    dXSARGS;    Set__Bit	pVector;    if (items != 1)    {		XSRETURN_EMPTY;    }	if (SvROK(ST(0))) {		IV tmp = SvIV((SV*)SvRV(ST(0)));		pVector = INT2PTR(Set__Bit,tmp);	}	else		croak(aTHX_ "%s: %s is not a reference","Set::Bit::DESTROY","pVector");	DESTROY(pVector);    XSRETURN_EMPTY;}XS_EXTERNAL(boot_Set__Bit){    dXSARGS;    const char* file = __file__;    newXS("Set::Bit::new",XS_Set__Bit_new,file);    newXS("Set::Bit::insert",XS_Set__Bit_insert,file);    newXS("Set::Bit::DESTROY",XS_Set__Bit_DESTROY,file);	if (PL_unitcheckav)		call_List(PL_scopestack_ix,PL_unitcheckav);    XSRETURN_YES;}

A Perl object

EarlIEr,I saID that I wanted the Set::Bit object to be the C-languagevector struct,rather than a Perl data object. It dIDn't work out that way. TheSet::Bit object is indeed a Perl data object: it is the scalar created bysv_setref_pv().

The Set::Bit object gives the essential features of a C-language object. Data is represented in C,we can write methods in C,and methods written in C access instance data through avector *,passed as the first argument. At the same time,the Set::Bit object gives us the flexibility to write methods in Perl.

SV = IV(0x1d710a8) at 0x1d710ac  REFCNT = 1  FLAGS = (ROK)  RV = 0x546f14  SV = PVMG(0x1d67e84) at 0x546f14    REFCNT = 1    FLAGS = (OBJECT,IOK,pIOK)    IV = 30824164                        // 指针p的值    NV = 0    PV = 0    STASH = 0x1d7119c   "Set::Bit"

上面的SV dump是new方法后的结果，在perl空间中也可以实现相同的效果，比如：

use Devel::Peek;{	local $m=30824164;	$r = $m;	bless $r,"Devel::Peek";	}Dump ($r);

首先，创建一个临时的SViv，iv值为指针值（对象指针）

然后，创建一个RV，并指向之前的这个SV，并在Devel::Peek模块下bless RV

最后，返回RV。

输出:

SV = IV(0x6370b4) at 0x6370b4  REFCNT = 1  FLAGS = (ROK)  RV = 0x4db35c  SV = PVMG(0x628dd4) at 0x4db35c    REFCNT = 1    FLAGS = (OBJECT,pIOK)    IV = 30824164    NV = 0    PV = 0    STASH = 0x63733c    "Devel::Peek"

总结

以上是内存溢出为你收集整理的Perl and XS: Example 3: Set::Bit全部内容，希望文章能够帮你解决Perl and XS: Example 3: Set::Bit所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错，欢迎将内存溢出网站推荐给程序员好友。