]> git.vpit.fr Git - perl/modules/Scalar-Vec-Util.git/blob - Util.xs
Importing Scalar-Vec-Util-0.01.tar.gz
[perl/modules/Scalar-Vec-Util.git] / 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