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