1 /* $RCSfile: dolist.c,v $$Revision: 4.1 $$Date: 92/08/07 17:19:51 $
3 * Copyright (c) 1991, Larry Wall
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
9 * Revision 4.1 92/08/07 17:19:51 lwall
12 * Revision 4.0.1.5 92/06/08 13:13:27 lwall
13 * patch20: g pattern modifer sometimes returned extra values
14 * patch20: m/$pattern/g didn't work
15 * patch20: pattern modifiers i and o didn't interact right
16 * patch20: @ in unpack failed too often
17 * patch20: Perl now distinguishes overlapped copies from non-overlapped
18 * patch20: slice on null list in scalar context returned random value
19 * patch20: splice with negative offset didn't work with $[ = 1
20 * patch20: fixed some memory leaks in splice
21 * patch20: scalar keys %array now counts keys for you
23 * Revision 4.0.1.4 91/11/11 16:33:19 lwall
24 * patch19: added little-endian pack/unpack options
25 * patch19: sort $subname was busted by changes in 4.018
27 * Revision 4.0.1.3 91/11/05 17:07:02 lwall
28 * patch11: prepared for ctype implementations that don't define isascii()
29 * patch11: /$foo/o optimizer could access deallocated data
30 * patch11: certain optimizations of //g in array context returned too many values
31 * patch11: regexp with no parens in array context returned wacky $`, $& and $'
32 * patch11: $' not set right on some //g
33 * patch11: added some support for 64-bit integers
34 * patch11: grep of a split lost its values
35 * patch11: added sort {} LIST
36 * patch11: multiple reallocations now avoided in 1 .. 100000
38 * Revision 4.0.1.2 91/06/10 01:22:15 lwall
39 * patch10: //g only worked first time through
41 * Revision 4.0.1.1 91/06/07 10:58:28 lwall
42 * patch4: new copyright notice
43 * patch4: added global modifier for pattern matches
44 * patch4: // wouldn't use previous pattern if it started with a null character
45 * patch4: //o and s///o now optimize themselves fully at runtime
46 * patch4: $` was busted inside s///
47 * patch4: caller($arg) didn't work except under debugger
49 * Revision 4.0 91/03/20 01:08:03 lwall
58 #pragma function(memcmp)
59 #endif /* BUGGY_MSC */
62 #pragma intrinsic(memcmp)
63 #endif /* BUGGY_MSC */
71 register AV *ary = stack;
76 I32 dokeys = (op->op_type == OP_KEYS || op->op_type == OP_RV2HV);
77 I32 dovalues = (op->op_type == OP_VALUES || op->op_type == OP_RV2HV);
81 if (GIMME != G_ARRAY) {
85 (void)hv_iterinit(hash);
87 while (entry = hv_iternext(hash)) {
93 /* Guess how much room we need. hv_max may be a few too many. Oh well. */
94 EXTEND(sp, HvMAX(hash) * (dokeys + dovalues));
95 (void)hv_iterinit(hash);
97 while (entry = hv_iternext(hash)) {
99 tmps = hv_iterkey(entry,&i);
102 XPUSHs(sv_2mortal(newSVpv(tmps,i)));
105 tmpstr = NEWSV(45,0);
106 sv_setsv(tmpstr,hv_iterval(hash,entry));
108 sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
109 HvMAX(hash)+1,entry->hent_hash & HvMAX(hash));
110 sv_setpv(tmpstr,buf);
112 XPUSHs(sv_2mortal(tmpstr));