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 STATIC size_t svu_validate_uv(pTHX_ SV *sv, const char *desc) {
  15 #define svu_validate_uv(S, D) svu_validate_uv(aTHX_ (S), (D))
  16  IV i;
  17
  18  if (SvOK(sv) && SvIOK(sv)) {
  19   if (SvIsUV(sv))
  20    return SvUVX(sv);
  21   else {
  22    i = SvIVX(sv);
  23    if (i >= 0)
  24     return i;
  25   }
  26  } else {
  27   i = SvIV(sv);
  28   if (i >= 0)
  29    return i;
  30  }
  31
  32  croak("Invalid negative %s", desc ? desc : "integer");
  33  return 0;
  34 }
  35
  36 /* --- XS ------------------------------------------------------------------ */
  37
  38 MODULE = Scalar::Vec::Util              PACKAGE = Scalar::Vec::Util
  39
  40 PROTOTYPES: ENABLE
  41
  42 BOOT:
  43 {
  44  HV *stash = gv_stashpvn(__PACKAGE__, __PACKAGE_LEN__, 1);
  45  newCONSTSUB(stash, "SVU_PP",   newSVuv(0));
  46  newCONSTSUB(stash, "SVU_SIZE", newSVuv(SVU_SIZE));
  47 }
  48
  49 void
  50 vfill(SV *sv, SV *ss, SV *sl, SV *sf)
  51 PROTOTYPE: $$$$
  52 PREINIT:
  53  size_t s, l, n, o;
  54  char f, *v;
  55 CODE:
  56  l = svu_validate_uv(sl, "length");
  57  if (!l)
  58   XSRETURN(0);
  59  s = svu_validate_uv(ss, "offset");
  60  f = SvTRUE(sf);
  61  SvUPGRADE(sv, SVt_PV);
  62
  63  n = BV_SIZE(s + l);
  64  o = SvLEN(sv);
  65  if (n > o) {
  66   v = SvGROW(sv, n);
  67   Zero(v + o, n - o, char);
  68  } else {
  69   v = SvPVX(sv);
  70  }
  71  if (SvCUR(sv) < n)
  72   SvCUR_set(sv, n);
  73
  74  bv_fill(v, s, l, f);
  75
  76  XSRETURN(0);
  77
  78 void
  79 vcopy(SV *sf, SV *sfs, SV *st, SV *sts, SV *sl)
  80 PROTOTYPE: $$$$$
  81 PREINIT:
  82  size_t fs, ts, l, lf = 0, n, o;
  83  char *t, *f;
  84 CODE:
  85  l = svu_validate_uv(sl, "length");
  86  if (!l)
  87   XSRETURN(0);
  88  fs = svu_validate_uv(sfs, "offset");
  89  ts = svu_validate_uv(sts, "offset");
  90  SvUPGRADE(sf, SVt_PV);
  91  SvUPGRADE(st, SVt_PV);
  92
  93  n  = BV_SIZE(ts + l);
  94  o  = SvLEN(st);
  95  if (n > o) {
  96   t = SvGROW(st, n);
  97   Zero(t + o, n - o, char);
  98  } else {
  99   t = SvPVX(st);
 100  }
 101  if (SvCUR(st) < n)
 102   SvCUR_set(st, n);
 103  f = SvPVX(sf); /* We do it there in case st == sf. */
 104
 105  n  = BV_SIZE(fs + l);
 106  o  = SvLEN(sf);
 107  if (n > o) {
 108   lf = fs + l - o * CHAR_BIT;
 109   l  = o * CHAR_BIT - fs;
 110  }
 111
 112  if (f == t) {
 113   bv_move(f, ts, fs, l);
 114  } else {
 115   bv_copy(t, ts, f, fs, l);
 116  }
 117
 118  if (lf) {
 119   bv_fill(t, ts + l, lf, 0);
 120  }
 121
 122  XSRETURN(0);
 123
 124 SV *
 125 veq(SV *sv1, SV *ss1, SV *sv2, SV *ss2, SV *sl)
 126 PROTOTYPE: $$$$$
 127 PREINIT:
 128  size_t s1, s2, l, o, n;
 129  char *v1, *v2;
 130 CODE:
 131  l = svu_validate_uv(sl, "length");
 132  if (!l)
 133   XSRETURN_YES;
 134  s1 = svu_validate_uv(ss1, "offset");
 135  s2 = svu_validate_uv(ss2, "offset");
 136  SvUPGRADE(sv1, SVt_PV);
 137  SvUPGRADE(sv2, SVt_PV);
 138
 139  n  = BV_SIZE(s1 + l);
 140  o  = SvLEN(sv1);
 141  if (n > o) {
 142   l = o * CHAR_BIT - s1;
 143  }
 144
 145  n  = BV_SIZE(s2 + l);
 146  o  = SvLEN(sv2);
 147  if (n > o) {
 148   l = o * CHAR_BIT - s2;
 149  }
 150
 151  v1 = SvPVX(sv1);
 152  v2 = SvPVX(sv2);
 153
 154  RETVAL = newSVuv(bv_eq(v1, s1, v2, s2, l));
 155 OUTPUT:
 156  RETVAL