view release on metacpan or  search on metacpan

RectanglesContainingDot_XS.xs  view on Meta::CPAN

/* -*- Mode: C -*- */

#define PERL_NO_GET_CONTEXT 1

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#if (PERL_VERSION < 7)
#include "sort.h"
#endif

#include "ppport.h"


static SV *
_obj2sv(pTHX_ void *ptr, SV * klass, char * ctype) {
    if (ptr) {
	SV *rv;
	SV *sv = newSVpvf("%s(0x%x)", ctype, ptr);
	SV *mgobj = sv_2mortal(newSViv(PTR2IV(ptr)));
	SvREADONLY_on(mgobj);

#if (PERL_VERSION < 7)
        sv_magic(sv, mgobj, '~', ctype, strlen(ctype));
#else
        sv_magic(sv, mgobj, '~', ctype, 0);
#endif

	rv = newRV_noinc(sv);
	if (SvOK(klass)) {
	    HV *stash;
	    if (SvROK(klass))
		stash = SvSTASH(klass);
	    else
		stash = gv_stashsv(klass, 1);
	    
	    sv_bless(rv, stash);
	}
	return rv;
    }
    return &PL_sv_undef;
}

static void *
_sv2obj(pTHX_ SV* self, char * ctype, int required) {
    SV *sv = SvRV(self);
    if (sv && (SvTYPE(sv) == SVt_PVMG)) {
        MAGIC *mg = mg_find(sv, '~');
        if (mg && (strcmp(ctype, mg->mg_ptr) == 0 && mg->mg_obj))
            return INT2PTR(void *, SvIV(mg->mg_obj));
    }
    if (required)
        Perl_croak(aTHX_ "object of class %s expected", ctype);
    return NULL;
}

#ifdef MYDEBUG

struct alloc {
    U32 size;
    U32 _barrier;
};

void failed_assertion(pTHX_ char *str, int line, char *file) {
    fprintf(stderr, "assertion %s failed at %s line %d\n", str, line, file);
    fflush(stderr);
    exit(1);
}

#define my_assert(a)  if(!(a)) failed_assertion(aTHX_ #a, __LINE__, __FILE__) 

void *
my_malloc(int count, int size) {
    struct alloc *a = malloc(sizeof(struct alloc) + count * size + 1);
    char *c = (char*)(a+1);
    a->size = count * size;
    c[-1] = 123;
    c[a->size] = 124;
    return a + 1;
}

#define Safefry(ptr) if (1) {                              \
        struct alloc *a = (struct alloc *)(ptr);           \
        char *c = (char *)(ptr);                           \
        my_assert(c[-1] == 123);                           \
        my_assert(c[a[-1].size] == 124);                   \
        free(a-1);                                         \
    } else

#define Newy(ptr, count, type) ptr = (type *)my_malloc(count, sizeof(type))

#define Newyz(ptr, count, type) \
        Newy(ptr, count, type); \
        memset(ptr, 0, (count) * sizeof(type))
                       

#else