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 #define __PACKAGE_LEN__ (sizeof(__PACKAGE__)-1)
  11
  12 #include "bitvect.h"
  13
  14 #ifndef SVU_SIZE
  15 # define SVU_SIZE (CHAR_BIT * sizeof(BV_UNIT))
  16 #endif
  17
  18 static size_t svu_validate_uv(pTHX_ SV *sv, const char *desc) {
  19 #define svu_validate_uv(S, D) svu_validate_uv(aTHX_ (S), (D))
  20  IV i;
  21
  22  if (SvOK(sv) && SvIOK(sv)) {
  23   if (SvIsUV(sv))
  24    return SvUVX(sv);
  25   else {
  26    i = SvIVX(sv);
  27    if (i >= 0)
  28     return i;
  29   }
  30  } else {
  31   i = SvIV(sv);
  32   if (i >= 0)
  33    return i;
  34  }
  35
  36  croak("Invalid negative %s", desc ? desc : "integer");
  37  return 0;
  38 }
  39
  40 static char *svu_prepare_sv(pTHX_ SV *sv, size_t s, size_t l) {
  41 #define svu_prepare_sv(S, I, L) svu_prepare_sv(aTHX_ (S), (I), (L))
  42  STRLEN  c;
  43  size_t  n = s + l, i, js, jz, k, z;
  44  char   *p;
  45
  46  SvUPGRADE(sv, SVt_PV);
  47
  48  p = SvGROW(sv, BV_SIZE(n));
  49  c = SvCUR(sv);
  50
  51  js = (s / BITS(BV_UNIT)) * sizeof(BV_UNIT);
  52  k  = js + sizeof(BV_UNIT);
  53  for (i = c < js ? js : c; i < k; ++i)
  54   p[i] = 0;
  55
  56  jz = ((s + l - 1) / BITS(BV_UNIT)) * sizeof(BV_UNIT);
  57  if (jz > js) {
  58   k = jz + sizeof(BV_UNIT);
  59   for (i = c < jz ? jz : c; i < k; ++i)
  60    p[i] = 0;
  61  }
  62
  63  z = 1 + ((s + l - 1) / CHAR_BIT);
  64  if (c < z)
  65   SvCUR_set(sv, z);
  66
  67  return p;
  68 }
  69
  70 /* --- XS ------------------------------------------------------------------ */
  71
  72 MODULE = Scalar::Vec::Util              PACKAGE = Scalar::Vec::Util
  73
  74 PROTOTYPES: ENABLE
  75
  76 BOOT:
  77 {
  78  HV *stash = gv_stashpvn(__PACKAGE__, __PACKAGE_LEN__, 1);
  79  newCONSTSUB(stash, "SVU_PP",   newSVuv(0));
  80  newCONSTSUB(stash, "SVU_SIZE", newSVuv(SVU_SIZE));
  81 }
  82
  83 void
  84 vfill(SV *sv, SV *ss, SV *sl, SV *sf)
  85 PROTOTYPE: $$$$
  86 PREINIT:
  87  size_t s, l;
  88  char f, *v;
  89 CODE:
  90  l = svu_validate_uv(sl, "length");
  91  if (!l)
  92   XSRETURN(0);
  93  s = svu_validate_uv(ss, "offset");
  94  v = svu_prepare_sv(sv, s, l);
  95  f = SvTRUE(sf);
  96
  97  bv_fill(v, s, l, f);
  98
  99  XSRETURN(0);
 100
 101 void
 102 vcopy(SV *sf, SV *sfs, SV *st, SV *sts, SV *sl)
 103 PROTOTYPE: $$$$$
 104 PREINIT:
 105  size_t fs, ts, l, e, lf, cf;
 106  char *vt, *vf;
 107 CODE:
 108  l = svu_validate_uv(sl, "length");
 109  if (!l)
 110   XSRETURN(0);
 111  fs = svu_validate_uv(sfs, "offset");
 112  ts = svu_validate_uv(sts, "offset");
 113
 114  SvUPGRADE(sf, SVt_PV);
 115  vt = svu_prepare_sv(st, ts, l);
 116
 117  /* We fetch vf after upgrading st in case st == sf. */
 118  vf = SvPVX(sf);
 119  cf = SvCUR(sf) * CHAR_BIT;
 120  lf = fs + l;
 121  e  = lf > cf ? lf - cf : 0;
 122  l  =  l > e  ?  l - e  : 0;
 123
 124  if (l) {
 125   if (vf == vt)
 126    bv_move(vf, ts, fs, l);
 127   else
 128    bv_copy(vt, ts, vf, fs, l);
 129  }
 130
 131  if (e)
 132   bv_fill(vt, ts + l, e, 0);
 133
 134  XSRETURN(0);
 135
 136 void
 137 veq(SV *sv1, SV *ss1, SV *sv2, SV *ss2, SV *sl)
 138 PROTOTYPE: $$$$$
 139 PREINIT:
 140  size_t s1, s2, l, l1, l2, c1, c2, e1, e2, e;
 141  int    res = 1;
 142  char  *v1, *v2;
 143 CODE:
 144  l = svu_validate_uv(sl, "length");
 145  if (!l)
 146   goto done;
 147  s1 = svu_validate_uv(ss1, "offset");
 148  s2 = svu_validate_uv(ss2, "offset");
 149
 150  SvUPGRADE(sv1, SVt_PV);
 151  SvUPGRADE(sv2, SVt_PV);
 152  v1 = SvPVX(sv1);
 153  v2 = SvPVX(sv2);
 154  c1 = SvCUR(sv1) * CHAR_BIT;
 155  c2 = SvCUR(sv2) * CHAR_BIT;
 156
 157  redo:
 158  l1 = s1 + l;
 159  l2 = s2 + l;
 160  e1 = l1 > c1 ? l1 - c1 : 0;
 161  e2 = l2 > c2 ? l2 - c2 : 0;
 162  e  = e1 > e2 ? e1 : e2;
 163
 164  if (l > e) {
 165   size_t p = l - e;
 166
 167   res = bv_eq(v1, s1, v2, s2, p);
 168   if (!res || e == 0)
 169    goto done;
 170
 171   /* Bit vectors are equal up to p < l */
 172   s1 += p;
 173   s2 += p;
 174   l   = e;
 175   goto redo;
 176  }
 177
 178  /* l <= max(e1, e2), at least one of the vectors is completely out of bounds */
 179  e = e1 < e2 ? e1 : e2;
 180  if (l > e) {
 181   size_t q = l - e;
 182
 183   if (s1 < c1)
 184    res = bv_zero(v1, s1, q);
 185   else if (s2 < c2)
 186    res = bv_zero(v2, s2, q);
 187  }
 188
 189  done:
 190  ST(0) = res ? &PL_sv_yes : &PL_sv_no;
 191  XSRETURN(1);