Util.xs

   1 /* This file is part of the Scalar::Vec::Util Perl module.
   2  * See http://search.cpan.org/dist/Scalar-Vec-Util/ */
   3
   4 #define PERL_NO_GET_CONTEXT
   5 #include "EXTERN.h"
   6 #include "perl.h"
   7 #include "XSUB.h"
   8
   9 #define __PACKAGE__ "Scalar::Vec::Util"
  10
  11 #include "bitvect.h"
  12
  13 STATIC const char svu_error_invarg[] = "Invalid argument";
  14
  15 /* --- XS ------------------------------------------------------------------ */
  16
  17 MODULE = Scalar::Vec::Util              PACKAGE = Scalar::Vec::Util
  18
  19 PROTOTYPES: ENABLE
  20
  21 BOOT:
  22 {
  23  HV *stash = gv_stashpv(__PACKAGE__, 1);
  24  newCONSTSUB(stash, "SVU_PP",   newSVuv(0));
  25  newCONSTSUB(stash, "SVU_SIZE", newSVuv(SVU_SIZE));
  26 }
  27
  28 void
  29 vfill(SV *sv, SV *ss, SV *sl, SV *sf)
  30 PREINIT:
  31  size_t s, l, n, o;
  32  char f, *v;
  33 CODE:
  34  if (!SvOK(sv) || !SvOK(ss) || !SvOK(sl) || !SvOK(sf)) {
  35   croak(svu_error_invarg);
  36  }
  37
  38  l = SvUV(sl);
  39  if (!l) { XSRETURN(0); }
  40  s = SvUV(ss);
  41  f = SvTRUE(sf);
  42  if (SvTYPE(sv) < SVt_PV) { SvUPGRADE(sv, SVt_PV); }
  43
  44  n = BV_SIZE(s + l);
  45  o = SvLEN(sv);
  46  if (n > o) {
  47   v = SvGROW(sv, n);
  48   Zero(v + o, n - o, char);
  49  } else {
  50   v = SvPVX(sv);
  51  }
  52  if (SvCUR(sv) < n) {
  53   SvCUR_set(sv, n);
  54  }
  55
  56  bv_fill(v, s, l, f);
  57
  58  XSRETURN(0);
  59
  60 void
  61 vcopy(SV *sf, SV *sfs, SV *st, SV *sts, SV *sl)
  62 PREINIT:
  63  size_t fs, ts, l, lf = 0, n, o;
  64  char *t, *f;
  65 CODE:
  66  if (!SvOK(sf) || !SvOK(sfs) || !SvOK(st) || !SvOK(sts) || !SvOK(sl)) {
  67   croak(svu_error_invarg);
  68  }
  69
  70  l  = SvUV(sl);
  71  if (!l) { XSRETURN(0); }
  72  fs = SvUV(sfs);
  73  ts = SvUV(sts);
  74  if (SvTYPE(sf) < SVt_PV) { SvUPGRADE(sf, SVt_PV); }
  75  if (SvTYPE(st) < SVt_PV) { SvUPGRADE(st, SVt_PV); }
  76
  77  n  = BV_SIZE(ts + l);
  78  o  = SvLEN(st);
  79  if (n > o) {
  80   t = SvGROW(st, n);
  81   Zero(t + o, n - o, char);
  82  } else {
  83   t = SvPVX(st);
  84  }
  85  if (SvCUR(st) < n) {
  86   SvCUR_set(st, n);
  87  }
  88  f = SvPVX(sf); /* We do it there in case st == sf. */
  89
  90  n  = BV_SIZE(fs + l);
  91  o  = SvLEN(sf);
  92  if (n > o) {
  93   lf = fs + l - o * CHAR_BIT;
  94   l  = o * CHAR_BIT - fs;
  95  }
  96
  97  if (f == t) {
  98   bv_move(f, ts, fs, l);
  99  } else {
 100   bv_copy(t, ts, f, fs, l);
 101  }
 102
 103  if (lf) {
 104   bv_fill(t, ts + l, lf, 0);
 105  }
 106
 107  XSRETURN(0);
 108
 109 SV *
 110 veq(SV *sv1, SV *ss1, SV *sv2, SV *ss2, SV *sl)
 111 PREINIT:
 112  size_t s1, s2, l, o, n;
 113  char *v1, *v2;
 114 CODE:
 115  if (!SvOK(sv1) || !SvOK(ss1) || !SvOK(sv2) || !SvOK(ss2) || !SvOK(sl)) {
 116   croak(svu_error_invarg);
 117  }
 118
 119  l  = SvUV(sl);
 120  s1 = SvUV(ss1);
 121  s2 = SvUV(ss2);
 122  if (SvTYPE(sv1) < SVt_PV) { SvUPGRADE(sv1, SVt_PV); }
 123  if (SvTYPE(sv2) < SVt_PV) { SvUPGRADE(sv2, SVt_PV); }
 124
 125  n  = BV_SIZE(s1 + l);
 126  o  = SvLEN(sv1);
 127  if (n > o) {
 128   l = o * CHAR_BIT - s1;
 129  }
 130
 131  n  = BV_SIZE(s2 + l);
 132  o  = SvLEN(sv2);
 133  if (n > o) {
 134   l = o * CHAR_BIT - s2;
 135  }
 136
 137  v1 = SvPVX(sv1);
 138  v2 = SvPVX(sv2);
 139
 140  RETVAL = newSVuv(bv_eq(v1, s1, v2, s2, l));
 141 OUTPUT:
 142  RETVAL