Introduced thr->threadsvp and THREADSV() for faster per-thread
[p5sagit/p5-mst-13.2.git] / doop.c
CommitLineData
a0d0e21e 1/* doop.c
79072805 2 *
9607fc9c 3 * Copyright (c) 1991-1997, Larry Wall
79072805 4 *
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.
7 *
a0d0e21e 8 */
9
10/*
11 * "'So that was the job I felt I had to do when I started,' thought Sam."
79072805 12 */
13
14#include "EXTERN.h"
15#include "perl.h"
16
17#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
18#include <signal.h>
19#endif
20
79072805 21I32
8ac85365 22do_trans(SV *sv, OP *arg)
79072805 23{
11343788 24 dTHR;
79072805 25 register short *tbl;
1476d272 26 register U8 *s;
27 register U8 *send;
28 register U8 *d;
79072805 29 register I32 ch;
1476d272 30 register I32 matches = 0;
79072805 31 register I32 squash = op->op_private & OPpTRANS_SQUASH;
463ee0b2 32 STRLEN len;
79072805 33
5d06d08e 34 if (SvREADONLY(sv) && !(op->op_private & OPpTRANS_COUNTONLY))
a0d0e21e 35 croak(no_modify);
1476d272 36 tbl = (short*)cPVOP->op_pv;
37 s = (U8*)SvPV(sv, len);
a0d0e21e 38 if (!len)
39 return 0;
40 if (!SvPOKp(sv))
1476d272 41 s = (U8*)SvPV_force(sv, len);
a0d0e21e 42 (void)SvPOK_only(sv);
463ee0b2 43 send = s + len;
79072805 44 if (!tbl || !s)
463ee0b2 45 croak("panic: do_trans");
79072805 46 DEBUG_t( deb("2.TBL\n"));
47 if (!op->op_private) {
48 while (s < send) {
1476d272 49 if ((ch = tbl[*s]) >= 0) {
79072805 50 matches++;
51 *s = ch;
52 }
53 s++;
54 }
5d06d08e 55 SvSETMAGIC(sv);
56 }
57 else if (op->op_private & OPpTRANS_COUNTONLY) {
58 while (s < send) {
59 if (tbl[*s] >= 0)
60 matches++;
61 s++;
62 }
79072805 63 }
64 else {
65 d = s;
66 while (s < send) {
1476d272 67 if ((ch = tbl[*s]) >= 0) {
79072805 68 *d = ch;
69 if (matches++ && squash) {
70 if (d[-1] == *d)
71 matches--;
72 else
73 d++;
74 }
75 else
76 d++;
77 }
78 else if (ch == -1) /* -1 is unmapped character */
79 *d++ = *s; /* -2 is delete character */
80 s++;
81 }
82 matches += send - d; /* account for disappeared chars */
83 *d = '\0';
1476d272 84 SvCUR_set(sv, d - (U8*)SvPVX(sv));
5d06d08e 85 SvSETMAGIC(sv);
79072805 86 }
79072805 87 return matches;
88}
89
90void
8ac85365 91do_join(register SV *sv, SV *del, register SV **mark, register SV **sp)
79072805 92{
93 SV **oldmark = mark;
94 register I32 items = sp - mark;
79072805 95 register STRLEN len;
463ee0b2 96 STRLEN delimlen;
97 register char *delim = SvPV(del, delimlen);
98 STRLEN tmplen;
79072805 99
100 mark++;
101 len = (items > 0 ? (delimlen * (items - 1) ) : 0);
102 if (SvTYPE(sv) < SVt_PV)
103 sv_upgrade(sv, SVt_PV);
104 if (SvLEN(sv) < len + items) { /* current length is way too short */
105 while (items-- > 0) {
106 if (*mark) {
463ee0b2 107 SvPV(*mark, tmplen);
108 len += tmplen;
79072805 109 }
110 mark++;
111 }
112 SvGROW(sv, len + 1); /* so try to pre-extend */
113
114 mark = oldmark;
115 items = sp - mark;;
116 ++mark;
117 }
118
463ee0b2 119 if (items-- > 0) {
8990e307 120 char *s;
121
122 if (*mark) {
123 s = SvPV(*mark, tmplen);
124 sv_setpvn(sv, s, tmplen);
125 }
126 else
127 sv_setpv(sv, "");
463ee0b2 128 mark++;
129 }
79072805 130 else
131 sv_setpv(sv,"");
132 len = delimlen;
133 if (len) {
134 for (; items > 0; items--,mark++) {
135 sv_catpvn(sv,delim,len);
136 sv_catsv(sv,*mark);
137 }
138 }
139 else {
140 for (; items > 0; items--,mark++)
141 sv_catsv(sv,*mark);
142 }
143 SvSETMAGIC(sv);
144}
145
146void
8ac85365 147do_sprintf(SV *sv, I32 len, SV **sarg)
79072805 148{
46fc3d4c 149 STRLEN patlen;
150 char *pat = SvPV(*sarg, patlen);
151 bool do_taint = FALSE;
152
153 sv_vsetpvfn(sv, pat, patlen, Null(va_list*), sarg + 1, len - 1, &do_taint);
79072805 154 SvSETMAGIC(sv);
46fc3d4c 155 if (do_taint)
156 SvTAINTED_on(sv);
79072805 157}
158
159void
8ac85365 160do_vecset(SV *sv)
79072805 161{
162 SV *targ = LvTARG(sv);
163 register I32 offset;
164 register I32 size;
8990e307 165 register unsigned char *s;
166 register unsigned long lval;
79072805 167 I32 mask;
a0d0e21e 168 STRLEN targlen;
169 STRLEN len;
79072805 170
8990e307 171 if (!targ)
172 return;
a0d0e21e 173 s = (unsigned char*)SvPV_force(targ, targlen);
8990e307 174 lval = U_L(SvNV(sv));
79072805 175 offset = LvTARGOFF(sv);
176 size = LvTARGLEN(sv);
a0d0e21e 177
178 len = (offset + size + 7) / 8;
179 if (len > targlen) {
180 s = (unsigned char*)SvGROW(targ, len + 1);
181 (void)memzero(s + targlen, len - targlen + 1);
182 SvCUR_set(targ, len);
183 }
184
79072805 185 if (size < 8) {
186 mask = (1 << size) - 1;
187 size = offset & 7;
188 lval &= mask;
189 offset >>= 3;
190 s[offset] &= ~(mask << size);
191 s[offset] |= lval << size;
192 }
193 else {
a0d0e21e 194 offset >>= 3;
79072805 195 if (size == 8)
196 s[offset] = lval & 255;
197 else if (size == 16) {
198 s[offset] = (lval >> 8) & 255;
199 s[offset+1] = lval & 255;
200 }
201 else if (size == 32) {
202 s[offset] = (lval >> 24) & 255;
203 s[offset+1] = (lval >> 16) & 255;
204 s[offset+2] = (lval >> 8) & 255;
205 s[offset+3] = lval & 255;
206 }
207 }
208}
209
210void
8ac85365 211do_chop(register SV *astr, register SV *sv)
79072805 212{
463ee0b2 213 STRLEN len;
a0d0e21e 214 char *s;
215
79072805 216 if (SvTYPE(sv) == SVt_PVAV) {
a0d0e21e 217 register I32 i;
218 I32 max;
219 AV* av = (AV*)sv;
220 max = AvFILL(av);
221 for (i = 0; i <= max; i++) {
222 sv = (SV*)av_fetch(av, i, FALSE);
223 if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
224 do_chop(astr, sv);
225 }
226 return;
79072805 227 }
228 if (SvTYPE(sv) == SVt_PVHV) {
a0d0e21e 229 HV* hv = (HV*)sv;
230 HE* entry;
231 (void)hv_iterinit(hv);
232 /*SUPPRESS 560*/
233 while (entry = hv_iternext(hv))
234 do_chop(astr,hv_iterval(hv,entry));
235 return;
79072805 236 }
a0d0e21e 237 s = SvPV(sv, len);
748a9306 238 if (len && !SvPOK(sv))
a0d0e21e 239 s = SvPV_force(sv, len);
240 if (s && len) {
241 s += --len;
242 sv_setpvn(astr, s, 1);
243 *s = '\0';
244 SvCUR_set(sv, len);
245 SvNIOK_off(sv);
79072805 246 }
247 else
a0d0e21e 248 sv_setpvn(astr, "", 0);
249 SvSETMAGIC(sv);
250}
251
252I32
8ac85365 253do_chomp(register SV *sv)
a0d0e21e 254{
aeea060c 255 dTHR;
c07a80fd 256 register I32 count;
a0d0e21e 257 STRLEN len;
258 char *s;
c07a80fd 259
260 if (RsSNARF(rs))
261 return 0;
262 count = 0;
a0d0e21e 263 if (SvTYPE(sv) == SVt_PVAV) {
264 register I32 i;
265 I32 max;
266 AV* av = (AV*)sv;
267 max = AvFILL(av);
268 for (i = 0; i <= max; i++) {
269 sv = (SV*)av_fetch(av, i, FALSE);
270 if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
271 count += do_chomp(sv);
272 }
273 return count;
274 }
275 if (SvTYPE(sv) == SVt_PVHV) {
276 HV* hv = (HV*)sv;
277 HE* entry;
278 (void)hv_iterinit(hv);
279 /*SUPPRESS 560*/
280 while (entry = hv_iternext(hv))
281 count += do_chomp(hv_iterval(hv,entry));
282 return count;
283 }
284 s = SvPV(sv, len);
285 if (len && !SvPOKp(sv))
286 s = SvPV_force(sv, len);
287 if (s && len) {
288 s += --len;
c07a80fd 289 if (RsPARA(rs)) {
a0d0e21e 290 if (*s != '\n')
291 goto nope;
292 ++count;
293 while (len && s[-1] == '\n') {
294 --len;
295 --s;
296 ++count;
297 }
298 }
a0d0e21e 299 else {
c07a80fd 300 STRLEN rslen;
301 char *rsptr = SvPV(rs, rslen);
302 if (rslen == 1) {
303 if (*s != *rsptr)
304 goto nope;
305 ++count;
306 }
307 else {
8c2cee6f 308 if (len < rslen - 1)
c07a80fd 309 goto nope;
310 len -= rslen - 1;
311 s -= rslen - 1;
36477c24 312 if (memNE(s, rsptr, rslen))
c07a80fd 313 goto nope;
314 count += rslen;
315 }
a0d0e21e 316 }
a0d0e21e 317 *s = '\0';
318 SvCUR_set(sv, len);
319 SvNIOK_off(sv);
320 }
321 nope:
322 SvSETMAGIC(sv);
323 return count;
324}
79072805 325
326void
8ac85365 327do_vop(I32 optype, SV *sv, SV *left, SV *right)
79072805 328{
aeea060c 329 dTHR; /* just for taint */
79072805 330#ifdef LIBERAL
331 register long *dl;
332 register long *ll;
333 register long *rl;
334#endif
335 register char *dc;
463ee0b2 336 STRLEN leftlen;
337 STRLEN rightlen;
7a4c00b4 338 register char *lc;
339 register char *rc;
79072805 340 register I32 len;
a0d0e21e 341 I32 lensave;
7a4c00b4 342 char *lsave;
343 char *rsave;
79072805 344
1fbd88dc 345 if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv)))
346 sv_setpvn(sv, "", 0); /* avoid undef warning on |= and ^= */
7a4c00b4 347 lsave = lc = SvPV(left, leftlen);
348 rsave = rc = SvPV(right, rightlen);
93a17b20 349 len = leftlen < rightlen ? leftlen : rightlen;
a0d0e21e 350 lensave = len;
7a4c00b4 351 if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) {
ff68c719 352 dc = SvPV_force(sv, na);
353 if (SvCUR(sv) < len) {
354 dc = SvGROW(sv, len + 1);
355 (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
356 }
357 }
358 else {
359 I32 needlen = ((optype == OP_BIT_AND)
360 ? len : (leftlen > rightlen ? leftlen : rightlen));
361 Newz(801, dc, needlen + 1, char);
362 (void)sv_usepvn(sv, dc, needlen);
363 dc = SvPVX(sv); /* sv_usepvn() calls Renew() */
79072805 364 }
a0d0e21e 365 SvCUR_set(sv, len);
366 (void)SvPOK_only(sv);
79072805 367#ifdef LIBERAL
368 if (len >= sizeof(long)*4 &&
369 !((long)dc % sizeof(long)) &&
370 !((long)lc % sizeof(long)) &&
371 !((long)rc % sizeof(long))) /* It's almost always aligned... */
372 {
373 I32 remainder = len % (sizeof(long)*4);
374 len /= (sizeof(long)*4);
375
376 dl = (long*)dc;
377 ll = (long*)lc;
378 rl = (long*)rc;
379
380 switch (optype) {
381 case OP_BIT_AND:
382 while (len--) {
383 *dl++ = *ll++ & *rl++;
384 *dl++ = *ll++ & *rl++;
385 *dl++ = *ll++ & *rl++;
386 *dl++ = *ll++ & *rl++;
387 }
388 break;
a0d0e21e 389 case OP_BIT_XOR:
79072805 390 while (len--) {
391 *dl++ = *ll++ ^ *rl++;
392 *dl++ = *ll++ ^ *rl++;
393 *dl++ = *ll++ ^ *rl++;
394 *dl++ = *ll++ ^ *rl++;
395 }
396 break;
397 case OP_BIT_OR:
398 while (len--) {
399 *dl++ = *ll++ | *rl++;
400 *dl++ = *ll++ | *rl++;
401 *dl++ = *ll++ | *rl++;
402 *dl++ = *ll++ | *rl++;
403 }
404 }
405
406 dc = (char*)dl;
407 lc = (char*)ll;
408 rc = (char*)rl;
409
410 len = remainder;
411 }
412#endif
a0d0e21e 413 {
a0d0e21e 414 switch (optype) {
415 case OP_BIT_AND:
416 while (len--)
417 *dc++ = *lc++ & *rc++;
418 break;
419 case OP_BIT_XOR:
420 while (len--)
421 *dc++ = *lc++ ^ *rc++;
422 goto mop_up;
423 case OP_BIT_OR:
424 while (len--)
425 *dc++ = *lc++ | *rc++;
426 mop_up:
427 len = lensave;
428 if (rightlen > len)
429 sv_catpvn(sv, rsave + len, rightlen - len);
430 else if (leftlen > len)
431 sv_catpvn(sv, lsave + len, leftlen - len);
4633a7c4 432 else
433 *SvEND(sv) = '\0';
a0d0e21e 434 break;
435 }
79072805 436 }
fb73857a 437 SvTAINT(sv);
79072805 438}
463ee0b2 439
440OP *
8ac85365 441do_kv(ARGSproto)
463ee0b2 442{
4e35701f 443 djSP;
463ee0b2 444 HV *hv = (HV*)POPs;
463ee0b2 445 register HE *entry;
463ee0b2 446 SV *tmpstr;
54310121 447 I32 gimme = GIMME_V;
a0d0e21e 448 I32 dokeys = (op->op_type == OP_KEYS);
449 I32 dovalues = (op->op_type == OP_VALUES);
c750a3ec 450 I32 realhv = (SvTYPE(hv) == SVt_PVHV);
451
a0d0e21e 452 if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV)
453 dokeys = dovalues = TRUE;
463ee0b2 454
85581909 455 if (!hv) {
456 if (op->op_flags & OPf_MOD) { /* lvalue */
457 dTARGET; /* make sure to clear its target here */
458 if (SvTYPE(TARG) == SVt_PVLV)
459 LvTARG(TARG) = Nullsv;
460 PUSHs(TARG);
461 }
463ee0b2 462 RETURN;
85581909 463 }
748a9306 464
c750a3ec 465 if (realhv)
466 (void)hv_iterinit(hv); /* always reset iterator regardless */
467 else
468 (void)avhv_iterinit((AV*)hv);
748a9306 469
54310121 470 if (gimme == G_VOID)
aa689395 471 RETURN;
472
54310121 473 if (gimme == G_SCALAR) {
8c2cee6f 474 I32 i;
463ee0b2 475 dTARGET;
476
85581909 477 if (op->op_flags & OPf_MOD) { /* lvalue */
478 if (SvTYPE(TARG) < SVt_PVLV) {
479 sv_upgrade(TARG, SVt_PVLV);
480 sv_magic(TARG, Nullsv, 'k', Nullch, 0);
481 }
482 LvTYPE(TARG) = 'k';
483 LvTARG(TARG) = (SV*)hv;
484 PUSHs(TARG);
485 RETURN;
486 }
487
8990e307 488 if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
463ee0b2 489 i = HvKEYS(hv);
490 else {
491 i = 0;
463ee0b2 492 /*SUPPRESS 560*/
c750a3ec 493 while (entry = realhv ? hv_iternext(hv) : avhv_iternext((AV*)hv)) {
463ee0b2 494 i++;
495 }
496 }
497 PUSHi( i );
498 RETURN;
499 }
500
501 /* Guess how much room we need. hv_max may be a few too many. Oh well. */
502 EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
503
463ee0b2 504 PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */
c750a3ec 505 while (entry = realhv ? hv_iternext(hv) : avhv_iternext((AV*)hv)) {
463ee0b2 506 SPAGAIN;
8c2cee6f 507 if (dokeys)
508 XPUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */
463ee0b2 509 if (dovalues) {
46fc3d4c 510 tmpstr = sv_newmortal();
463ee0b2 511 PUTBACK;
c750a3ec 512 sv_setsv(tmpstr,realhv ?
513 hv_iterval(hv,entry) : avhv_iterval((AV*)hv,entry));
46fc3d4c 514 DEBUG_H(sv_setpvf(tmpstr, "%lu%%%d=%lu",
515 (unsigned long)HeHASH(entry),
516 HvMAX(hv)+1,
517 (unsigned long)(HeHASH(entry) & HvMAX(hv))));
463ee0b2 518 SPAGAIN;
46fc3d4c 519 XPUSHs(tmpstr);
463ee0b2 520 }
521 PUTBACK;
522 }
523 return NORMAL;
524}
4e35701f 525