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