view release on metacpan or  search on metacpan

PDL.xs  view on Meta::CPAN

  else if (stash == PDLStash1) {
    ospv_bridge *br = (ospv_bridge*) obj;
    //BrDEBUG_set(br, 1);
    pdl_bridge *pdlbr;
    Lib__PDL1 *pv = (Lib__PDL1 *) br->ospv();
    if (!pv)
      croak("Attempt to use PDL outside of transaction scope");
    if (!br->info) {
	pdlbr = (pdl_bridge*) Freelist.next_self();
	if (!pdlbr) {
	  pdlbr = new pdl_bridge();
          if (Debug >= 2) warn("creating proxy for 0x%x", br->ospv());
        }
	else {
	  pdlbr->link.detach();
          if (Debug >= 2) warn("reuse proxy for 0x%x", br->ospv());
        }
	pdlbr->init(pv);
	br->info = pdlbr;
#if OSP_BRIDGE_TRACE
	pdlbr->bridge = br;
#endif
    }
    pdlbr = (pdl_bridge*) br->info;
    return pdlbr->proxy;
  }
  else {
    if (!failok)
      croak("Don't know how to convert ObjStore::Lib::PDL to a '%s'",
	 HvNAME(stash));
    return 0;
  }
}

dynacast_fn Lib__PDL1::get_dynacast_meth()
{ return ospdl_dynacast; }


MODULE = ObjStore::Lib::PDL	PACKAGE = ObjStore::Lib::PDL

PROTOTYPES: disable

BOOT:
  extern _Application_schema_info Lib__PDL_dll_schema_info;
  osp_thr::use("ObjStore::Lib::PDL", OSPERL_API_VERSION);
  osp_thr::register_schema("ObjStore::Lib::PDL", &Lib__PDL_dll_schema_info);
  PDLStash1 = gv_stashpv("PDL", 1);
  SV *pdl_core_sv = perl_get_sv("PDL::SHARE", 0);
  if (!pdl_core_sv) croak("PDL is not loaded");
  PDLAPI = (Core*) SvIV(pdl_core_sv);
  assert(sizeof(PDL_Long) == sizeof(os_int32));
  SV *APIV = perl_get_sv("ObjStore::Lib::PDL::APIVERSION", 1);
  sv_setiv(APIV, OBJSTORE_LIB_PDL_VERSION);
  SvREADONLY_on(APIV);
  init_out_of_scope();

void
_allocate(CSV, seg)
	SV *CSV;
	SV *seg;
	PPCODE:
	os_segment *area = osp_thr::sv_2segment(seg);
	PUTBACK;
	OSSVPV *pv;
	NEW_OS_OBJECT(pv, area, Lib__PDL1::get_os_typespec(), Lib__PDL1);
	pv->bless(CSV);
	return;

void
_PurgeFreelist()
	CODE:
	pdl_bridge *pdlbr;
	while (pdlbr = (pdl_bridge*) Freelist.next_self()) {
	  delete pdlbr;
	}
	if (0 && bridge_counter)
	  warn("ObjStore::Lib::PDL: %d proxies are still in use",
		bridge_counter);

int
_set_debug(lv)
	int lv
	CODE:
	RETVAL = Debug;
	Debug = lv;
	OUTPUT:
	RETVAL

void
_inuse_bridges(...)
	PROTOTYPE: ;$
	PPCODE:
	IV show = items>0? sv_true(ST(0)) : 0;
	IV cnt=0;
#if OSP_BRIDGE_TRACE
	pdl_bridge *br = (pdl_bridge*) pdl_bridge::All.next_self();
	while (br) {
	  if (show) {
	    SV *sv = sv_2mortal(newSVpv("",0));
	    sv_catpvf(sv,"[%d]pdl_bridge 0x%x\n", cnt, br);
	    sv_catpvf(sv,"  bridge       : 0x%x\n", br->bridge);
	    sv_catpvf(sv,"  proxy        : 0x%x\n", br->proxy);
	    if (br->proxy)
	      sv_catpvf(sv,"  proxy->sv    : 0x%x\n", br->proxy->sv);
	    if (br->where)
	      sv_catpvf(sv,"  created%s\n", SvPV(br->where, PL_na));
	    XPUSHs(sv);
	  }
	  ++cnt;
	  br = (pdl_bridge*) br->al.next_self();
	}
#else
	warn("_inuse_bridges detail is not available");
#endif

void
OSSVPV::getndims()
	PPCODE:
	XPUSHs(sv_2mortal(newSViv(((Lib__PDL1*)THIS)->ndims)));

void
OSSVPV::getdim(y)
	int y;
	PPCODE:
	XPUSHs(sv_2mortal(newSViv(((Lib__PDL1*)THIS)->dims[y])));

void
OSSVPV::setdims(sv)
	SV *sv
	CODE:
	if (!(SvROK(sv) && SvTYPE(SvRV(sv))==SVt_PVAV))
	  croak("setdims: expecting an array ref");
	AV *ar = (AV*) SvRV(sv);
	int ndims = av_len(ar)+1;
	I32 *dims;
	if (ndims) {
	  New(0, dims, ndims, I32);
	  for (int xx=0; xx < ndims; xx++)
	    dims[xx] = SvIV(*av_fetch(ar,xx,0));
	}
	((Lib__PDL1*)THIS)->setdims(ndims, dims);
	if (THIS_bridge->info)
	  ((pdl_bridge*) THIS_bridge->info)->init(((Lib__PDL1*)THIS));

void
OSSVPV::set_datatype(datatype)
	int datatype;
	CODE:
	((Lib__PDL1*)THIS)->set_datatype(datatype);
	if (THIS_bridge->info)
	  ((pdl_bridge*) THIS_bridge->info)->init(((Lib__PDL1*)THIS));

void
copy(THIS)
	OSSVPV *THIS;
	PPCODE:
	OSSVPV *cpy;
	NEW_OS_OBJECT(cpy, os_segment::of(THIS), Lib__PDL1::get_os_typespec(),
		Lib__PDL1);
	((Lib__PDL1*)cpy)->copy(* (Lib__PDL1*)THIS);
	SV *me = osp_thr::ospv_2sv(cpy, 1);
	XPUSHs(me);

void
OSSVPV::upd_data()
	CODE:
	/* do nothing */

void
OSSVPV::at(...)
	PPCODE:
	Lib__PDL1_c pdl((Lib__PDL1*)THIS);
	if (items-1 != pdl.ndims)
	  croak("PDL->set expecting %d dimensions (not %d)", pdl.ndims, items-1);
	pdl.seek(&ST(1));
	SV *ret;
	switch (pdl.datatype) {
	case PDL_B: ret = newSViv(pdl.at_b()); break;
	case PDL_S: ret = newSViv(pdl.at_s()); break;
	case PDL_US: ret = newSViv(pdl.at_us()); break;
	case PDL_L: ret = newSViv(pdl.at_l()); break;
	case PDL_F: ret = newSVnv(pdl.at_f()); break;
	case PDL_D: ret = newSVnv(pdl.at_d()); break;
	default: croak("datatype unknown");
	}
	XPUSHs(sv_2mortal(ret));

void
OSSVPV::set(...)
	PPCODE:
	Lib__PDL1_c pdl((Lib__PDL1*)THIS);
	if (items-1 != pdl.ndims + 1)
	  croak("PDL->set expecting %d dimensions (not %d)", pdl.ndims, items-2);
	pdl.seek(&ST(1));
	pdl.set(ST(items-1));

void
DESTROY(sv)
	SV *sv
	PPCODE:
	ospv_bridge* br;
	br= (ospv_bridge*) typemap_any::try_decode(sv, ospdl_dynacast, 0);
	if (br) {
	  br->leave_perl();
	}