ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Array-Heap/Heap.xs
(Generate patch)

Comparing Array-Heap/Heap.xs (file contents):
Revision 1.1 by root, Wed Jul 1 08:31:34 2009 UTC vs.
Revision 1.4 by root, Sun Jul 26 05:25:18 2009 UTC

1#include "EXTERN.h" 1#include "EXTERN.h"
2#include "perl.h" 2#include "perl.h"
3#include "XSUB.h" 3#include "XSUB.h"
4 4
5/* pre-5.10 compatibility */
6#ifndef GV_NOTQUAL
7# define GV_NOTQUAL 1
8#endif
9#ifndef gv_fetchpvs
10# define gv_fetchpvs gv_fetchpv
11#endif
12
13/* pre-5.8 compatibility */
14#ifndef PERL_MAGIC_tied
15# define PERL_MAGIC_tied 'P'
16#endif
17
18#include "multicall.h"
19
20/* workaround for buggy multicall API */
21#ifndef cxinc
22# define cxinc() Perl_cxinc (aTHX)
23#endif
24
25#define dCMP \
26 dMULTICALL; \
27 void *cmp_data; \
28 I32 gimme = G_SCALAR;
29
30#define CMP_PUSH(sv) \
31 PUSH_MULTICALL (cmp_push_ (sv));\
32 cmp_data = multicall_cop;
33
34#define CMP_POP \
35 POP_MULTICALL;
36
37#define dCMP_CALL(data) \
38 OP *multicall_cop = (OP *)data;
39
40static void *
41cmp_push_ (SV *sv)
42{
43 HV *st;
44 GV *gvp;
45 CV *cv;
46
47 cv = sv_2cv (sv, &st, &gvp, 0);
48
49 if (!cv)
50 croak ("%s: callback must be a CODE reference or another callable object", SvPV_nolen (sv));
51
52 if (!PL_firstgv) PL_firstgv = gv_fetchpvs ("a", GV_ADD | GV_NOTQUAL, SVt_PV);
53 if (!PL_secondgv) PL_secondgv = gv_fetchpvs ("b", GV_ADD | GV_NOTQUAL, SVt_PV);
54
55 SAVESPTR (GvSV (PL_firstgv));
56 SAVESPTR (GvSV (PL_secondgv));
57
58 return cv;
59}
60
61/*****************************************************************************/
62
63static SV *
64sv_first (SV *sv)
65{
66 if (SvROK (sv) && SvTYPE (SvRV (sv)) == SVt_PVAV)
67 {
68 AV *av = (AV *)SvRV (sv);
69
70 sv = AvFILLp (av) < 0 ? &PL_sv_undef : AvARRAY (av)[0];
71 }
72
73 return sv;
74}
75
5static int 76static int
6cmp_nv (SV *a, SV *b, SV *data) 77cmp_nv (SV *a, SV *b, void *cmp_data)
7{ 78{
8 if (SvROK (a) && SvTYPE (SvRV (a)) == SVt_PVAV) a = *av_fetch ((AV *)SvRV (a), 0, 1); 79 a = sv_first (a);
9 if (SvROK (b) && SvTYPE (SvRV (b)) == SVt_PVAV) b = *av_fetch ((AV *)SvRV (b), 0, 1); 80 b = sv_first (b);
10 81
11 return SvNV (a) > SvNV (b); 82 return SvNV (a) > SvNV (b);
12} 83}
13 84
14static int 85static int
15cmp_sv (SV *a, SV *b, SV *data) 86cmp_sv (SV *a, SV *b, void *cmp_data)
16{ 87{
17 if (SvROK (a) && SvTYPE (SvRV (a)) == SVt_PVAV) a = *av_fetch ((AV *)SvRV (a), 0, 1); 88 a = sv_first (a);
18 if (SvROK (b) && SvTYPE (SvRV (b)) == SVt_PVAV) b = *av_fetch ((AV *)SvRV (b), 0, 1); 89 b = sv_first (b);
19 90
20 return sv_cmp(a, b) > 0; 91 return sv_cmp (a, b) > 0;
21} 92}
22 93
23static int 94static int
24cmp_custom (SV *a, SV *b, SV *data) 95cmp_custom (SV *a, SV *b, void *cmp_data)
25{ 96{
26 SV *old_a, *old_b; 97 dCMP_CALL (cmp_data);
27 int ret;
28 dSP;
29
30 if (!PL_firstgv) PL_firstgv = gv_fetchpv ("a", 1, SVt_PV);
31 if (!PL_secondgv) PL_secondgv = gv_fetchpv ("b", 1, SVt_PV);
32
33 old_a = GvSV (PL_firstgv);
34 old_b = GvSV (PL_secondgv);
35 98
36 GvSV (PL_firstgv) = a; 99 GvSV (PL_firstgv) = a;
37 GvSV (PL_secondgv) = b; 100 GvSV (PL_secondgv) = b;
38 101
39 PUSHMARK (SP); 102 MULTICALL;
40 PUTBACK;
41 ret = call_sv (data, G_SCALAR | G_NOARGS | G_EVAL);
42 SPAGAIN;
43
44 GvSV (PL_firstgv) = old_a;
45 GvSV (PL_secondgv) = old_b;
46 103
47 if (SvTRUE (ERRSV)) 104 if (SvTRUE (ERRSV))
48 croak (NULL); 105 croak (NULL);
49 106
50 if (ret != 1) 107 {
51 croak ("sort function must return exactly one return value"); 108 dSP;
52
53 return POPi >= 0; 109 return TOPi > 0;
110 }
54} 111}
55 112
113/*****************************************************************************/
114
56typedef int (*f_cmp)(SV *, SV *, SV *); 115typedef int (*f_cmp)(SV *a, SV *b, void *cmp_data);
57 116
58static AV * 117static AV *
59array (SV *ref) 118array (SV *ref)
60{ 119{
120 if (SvROK (ref)
61 if (SvROK (ref) && SvTYPE (SvRV (ref)) == SVt_PVAV) 121 && SvTYPE (SvRV (ref)) == SVt_PVAV
122 && !SvTIED_mg (SvRV (ref), PERL_MAGIC_tied))
62 return (AV *)SvRV (ref); 123 return (AV *)SvRV (ref);
63 124
64 croak ("argument 'heap' must be an array"); 125 croak ("argument 'heap' must be a (non-tied) array");
65} 126}
66 127
67#define geta(i) (*av_fetch (av, (i), 1))
68#define gt(a,b) cmp ((a), (b), data) 128#define gt(a,b) cmp ((a), (b), cmp_data)
69#define seta(i,v) seta_helper (av_fetch (av, (i), 1), v)
70 129
71static void 130/*****************************************************************************/
72seta_helper (SV **i, SV *v)
73{
74 SvREFCNT_dec (*i);
75 *i = v;
76}
77 131
132/* away from the root */
78static void 133static void
79push_heap_aux (AV *av, f_cmp cmp, SV *data, int hole_index, int top, SV *value) 134downheap (AV *av, f_cmp cmp, void *cmp_data, int N, int k)
80{ 135{
81 int parent = (hole_index - 1) / 2; 136 SV **heap = AvARRAY (av);
137 SV *he = heap [k];
82 138
83 while (hole_index > top && gt (geta (parent), value)) 139 for (;;)
84 {
85 seta (hole_index, SvREFCNT_inc (geta (parent)));
86 hole_index = parent;
87 parent = (hole_index - 1) / 2;
88 } 140 {
141 int c = (k << 1) + 1;
89 142
90 seta (hole_index, value); 143 if (c >= N)
91} 144 break;
92 145
93static void 146 c += c + 1 < N && gt (heap [c], heap [c + 1])
94adjust_heap (AV *av, f_cmp cmp, SV *data, int hole_index, int len, SV *elem) 147 ? 1 : 0;
95{
96 int top = hole_index;
97 int second_child = 2 * (hole_index + 1);
98 148
99 while (second_child < len) 149 if (!(gt (he, heap [c])))
150 break;
151
152 heap [k] = heap [c];
153
154 k = c;
100 { 155 }
101 if (gt (geta (second_child), geta (second_child - 1)))
102 second_child--;
103 156
104 seta (hole_index, SvREFCNT_inc (geta (second_child))); 157 heap [k] = he;
105 hole_index = second_child; 158}
106 second_child = 2 * (second_child + 1); 159
160/* towards the root */
161static void
162upheap (AV *av, f_cmp cmp, void *cmp_data, int k)
163{
164 SV **heap = AvARRAY (av);
165 SV *he = heap [k];
166
167 while (k)
107 } 168 {
169 int p = (k - 1) >> 1;
108 170
109 if (second_child == len) 171 if (!(gt (heap [p], he)))
172 break;
173
174 heap [k] = heap [p];
175 k = p;
110 { 176 }
111 seta (hole_index, SvREFCNT_inc (geta (second_child - 1)));
112 hole_index = second_child - 1;
113 }
114 177
115 push_heap_aux (av, cmp, data, hole_index, top, elem); 178 heap [k] = he;
116} 179}
117 180
181/* move an element suitably so it is in a correct place */
118static void 182static void
183adjustheap (AV *av, f_cmp cmp, void *cmp_data, int N, int k)
184{
185 SV **heap = AvARRAY (av);
186
187 if (k > 0 && !gt (heap [k], heap [(k - 1) >> 1]))
188 upheap (av, cmp, cmp_data, k);
189 else
190 downheap (av, cmp, cmp_data, N, k);
191}
192
193/*****************************************************************************/
194
195static void
119make_heap (AV *av, f_cmp cmp, SV *data) 196make_heap (AV *av, f_cmp cmp, void *cmp_data)
120{ 197{
121 if (av_len (av) > 0) 198 int i, len = AvFILLp (av);
122 {
123 int len = av_len (av) + 1;
124 int parent = (len - 2) / 2;
125 199
126 do { 200 /* do not use floyds algorithm, as I expect the simpler and more cache-efficient */
127 adjust_heap (av, cmp, data, parent, len, SvREFCNT_inc (geta (parent))); 201 /* upheap is actually faster */
128 } while (parent--); 202 for (i = 0; i <= len; ++i)
129 } 203 upheap (av, cmp, cmp_data, i);
130} 204}
131 205
132static void 206static void
133push_heap (AV *av, f_cmp cmp, SV *data, SV *elem) 207push_heap (AV *av, f_cmp cmp, void *cmp_data, SV **elems, int nelems)
134{ 208{
135 elem = newSVsv (elem); 209 int i;
136 av_push (av, elem); 210
137 push_heap_aux (av, cmp, data, av_len (av), 0, SvREFCNT_inc (elem)); 211 av_extend (av, AvFILLp (av) + nelems);
212
213 /* we do it in two steps, as the perl cmp function might copy the stack */
214 for (i = 0; i < nelems; ++i)
215 AvARRAY (av)[++AvFILLp (av)] = newSVsv (elems [i]);
216
217 for (i = 0; i < nelems; ++i)
218 upheap (av, cmp, cmp_data, AvFILLp (av) - i);
138} 219}
139 220
140static SV * 221static SV *
141pop_heap (AV *av, f_cmp cmp, SV *data) 222pop_heap (AV *av, f_cmp cmp, void *cmp_data)
142{ 223{
224 int len = AvFILLp (av);
225
143 if (av_len (av) < 0) 226 if (len < 0)
144 return &PL_sv_undef; 227 return &PL_sv_undef;
145 else if (av_len (av) == 0) 228 else if (len == 0)
146 return av_pop (av); 229 return av_pop (av);
147 else 230 else
148 { 231 {
149 SV *result = newSVsv (geta (0));
150 SV *top = av_pop (av); 232 SV *top = av_pop (av);
151 233 SV *result = AvARRAY (av)[0];
152 adjust_heap (av, cmp, data, 0, av_len (av) + 1, top); 234 AvARRAY (av)[0] = top;
153 235 downheap (av, cmp, cmp_data, len, 0);
154 return result; 236 return result;
155 } 237 }
156} 238}
157 239
240static SV *
241splice_heap (AV *av, f_cmp cmp, void *cmp_data, int idx)
242{
243 int len = AvFILLp (av);
244
245 if (len < 0 || idx > len)
246 return &PL_sv_undef;
247 else if (len == 0 || idx == len)
248 return av_pop (av); /* the only or last element */
249 else
250 {
251 SV *top = av_pop (av);
252 SV *result = AvARRAY (av)[idx];
253 AvARRAY (av)[idx] = top;
254 adjustheap (av, cmp, cmp_data, len, idx);
255 return result;
256 }
257}
258
259static void
260adjust_heap (AV *av, f_cmp cmp, void *cmp_data, int idx)
261{
262 adjustheap (av, cmp, cmp_data, AvFILLp (av) + 1, idx);
263}
264
158MODULE = Array::Heap PACKAGE = Array::Heap 265MODULE = Array::Heap PACKAGE = Array::Heap
159 266
160void 267void
161make_heap (heap) 268make_heap (SV *heap)
162 SV * heap
163 PROTOTYPE: \@ 269 PROTOTYPE: \@
164 CODE: 270 CODE:
165 make_heap (array (heap), cmp_nv, 0); 271 make_heap (array (heap), cmp_nv, 0);
166 272
167void 273void
168make_heap_lex (heap) 274make_heap_lex (SV *heap)
169 SV * heap
170 PROTOTYPE: \@ 275 PROTOTYPE: \@
171 CODE: 276 CODE:
172 make_heap (array (heap), cmp_sv, 0); 277 make_heap (array (heap), cmp_sv, 0);
173 278
174void 279void
175make_heap_cmp (cmp, heap) 280make_heap_cmp (SV *cmp, SV *heap)
176 SV * cmp
177 SV * heap
178 PROTOTYPE: &\@ 281 PROTOTYPE: &\@
179 CODE: 282 CODE:
283{
284 dCMP;
285 CMP_PUSH (cmp);
180 make_heap (array (heap), cmp_custom, cmp); 286 make_heap (array (heap), cmp_custom, cmp_data);
287 CMP_POP;
288}
181 289
182void 290void
183push_heap (heap, ...) 291push_heap (SV *heap, ...)
184 SV * heap
185 PROTOTYPE: \@@ 292 PROTOTYPE: \@@
186 CODE: 293 CODE:
187 int i;
188 for (i = 1; i < items; i++)
189 push_heap (array (heap), cmp_nv, 0, ST(i)); 294 push_heap (array (heap), cmp_nv, 0, &(ST(1)), items - 1);
190 295
191void 296void
192push_heap_lex (heap, ...) 297push_heap_lex (SV *heap, ...)
193 SV * heap
194 PROTOTYPE: \@@ 298 PROTOTYPE: \@@
195 CODE: 299 CODE:
196 int i;
197 for (i = 1; i < items; i++)
198 push_heap (array (heap), cmp_sv, 0, ST(i)); 300 push_heap (array (heap), cmp_sv, 0, &(ST(1)), items - 1);
199 301
200void 302void
201push_heap_cmp (cmp, heap, ...) 303push_heap_cmp (SV *cmp, SV *heap, ...)
202 SV * cmp
203 SV * heap
204 PROTOTYPE: &\@@ 304 PROTOTYPE: &\@@
205 CODE: 305 CODE:
206 int i; 306{
207 for (i = 1; i < items; i++) 307 SV **st_2 = &(ST(2)); /* multicall.h uses PUSHSTACK */
308 dCMP;
309 CMP_PUSH (cmp);
208 push_heap (array (heap), cmp_custom, cmp, ST(i)); 310 push_heap (array (heap), cmp_custom, cmp_data, st_2, items - 2);
311 CMP_POP;
312}
209 313
210SV * 314SV *
211pop_heap (heap) 315pop_heap (SV *heap)
212 SV * heap
213 PROTOTYPE: \@ 316 PROTOTYPE: \@
214 CODE: 317 CODE:
215 RETVAL = pop_heap (array (heap), cmp_nv, 0); 318 RETVAL = pop_heap (array (heap), cmp_nv, 0);
216 OUTPUT: 319 OUTPUT:
217 RETVAL 320 RETVAL
218 321
219SV * 322SV *
220pop_heap_lex (heap) 323pop_heap_lex (SV *heap)
221 SV * heap
222 PROTOTYPE: \@ 324 PROTOTYPE: \@
223 CODE: 325 CODE:
224 RETVAL = pop_heap (array (heap), cmp_sv, 0); 326 RETVAL = pop_heap (array (heap), cmp_sv, 0);
225 OUTPUT: 327 OUTPUT:
226 RETVAL 328 RETVAL
227 329
228SV * 330SV *
229pop_heap_cmp (cmp, heap) 331pop_heap_cmp (SV *cmp, SV *heap)
230 SV * cmp
231 SV * heap
232 PROTOTYPE: &\@ 332 PROTOTYPE: &\@
233 CODE: 333 CODE:
334{
335 dCMP;
336 CMP_PUSH (cmp);
234 RETVAL = pop_heap (array (heap), cmp_custom, cmp); 337 RETVAL = pop_heap (array (heap), cmp_custom, cmp_data);
338 CMP_POP;
339}
235 OUTPUT: 340 OUTPUT:
236 RETVAL 341 RETVAL
237 342
343SV *
344splice_heap (SV *heap, int idx)
345 PROTOTYPE: \@$
346 CODE:
347 RETVAL = splice_heap (array (heap), cmp_nv, 0, idx);
348 OUTPUT:
349 RETVAL
238 350
351SV *
352splice_heap_lex (SV *heap, int idx)
353 PROTOTYPE: \@$
354 CODE:
355 RETVAL = splice_heap (array (heap), cmp_sv, 0, idx);
356 OUTPUT:
357 RETVAL
358
359SV *
360splice_heap_cmp (SV *cmp, SV *heap, int idx)
361 PROTOTYPE: &\@$
362 CODE:
363{
364 dCMP;
365 CMP_PUSH (cmp);
366 RETVAL = splice_heap (array (heap), cmp_custom, cmp_data, idx);
367 CMP_POP;
368}
369 OUTPUT:
370 RETVAL
371
372void
373adjust_heap (SV *heap, int idx)
374 PROTOTYPE: \@$
375 CODE:
376 adjust_heap (array (heap), cmp_nv, 0, idx);
377
378void
379adjust_heap_lex (SV *heap, int idx)
380 PROTOTYPE: \@$
381 CODE:
382 adjust_heap (array (heap), cmp_sv, 0, idx);
383
384void
385adjust_heap_cmp (SV *cmp, SV *heap, int idx)
386 PROTOTYPE: &\@$
387 CODE:
388{
389 dCMP;
390 CMP_PUSH (cmp);
391 adjust_heap (array (heap), cmp_custom, cmp_data, idx);
392 CMP_POP;
393}
394

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines