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