3 * Copyright (c) 1991-1994, 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.
11 * "'So that was the job I felt I had to do when I started,' thought Sam."
17 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
22 #pragma function(memcmp)
23 #endif /* BUGGY_MSC */
26 #pragma intrinsic(memcmp)
27 #endif /* BUGGY_MSC */
40 register I32 matches = 0;
41 register I32 squash = op->op_private & OPpTRANS_SQUASH;
46 tbl = (short*)cPVOP->op_pv;
47 s = (U8*)SvPV(sv, len);
51 s = (U8*)SvPV_force(sv, len);
55 croak("panic: do_trans");
56 DEBUG_t( deb("2.TBL\n"));
57 if (!op->op_private) {
59 if ((ch = tbl[*s]) >= 0) {
69 if ((ch = tbl[*s]) >= 0) {
71 if (matches++ && squash) {
80 else if (ch == -1) /* -1 is unmapped character */
81 *d++ = *s; /* -2 is delete character */
84 matches += send - d; /* account for disappeared chars */
86 SvCUR_set(sv, d - (U8*)SvPVX(sv));
93 do_join(sv,del,mark,sp)
100 register I32 items = sp - mark;
103 register char *delim = SvPV(del, delimlen);
107 len = (items > 0 ? (delimlen * (items - 1) ) : 0);
108 if (SvTYPE(sv) < SVt_PV)
109 sv_upgrade(sv, SVt_PV);
110 if (SvLEN(sv) < len + items) { /* current length is way too short */
111 while (items-- > 0) {
118 SvGROW(sv, len + 1); /* so try to pre-extend */
129 s = SvPV(*mark, tmplen);
130 sv_setpvn(sv, s, tmplen);
140 for (; items > 0; items--,mark++) {
141 sv_catpvn(sv,delim,len);
146 for (; items > 0; items--,mark++)
153 do_sprintf(sv,len,sarg)
164 #endif /* HAS_QUAD */
176 len--; /* don't count pattern string */
177 t = s = SvPV(*sarg, arglen); /* XXX Don't know t is writeable */
183 if (len <= 0 || !(arg = *sarg++))
187 for ( ; t < send && *t != '%'; t++) ;
189 break; /* end of run_format string, ignore extra args */
195 #endif /* HAS_QUAD */
198 for (t++; t < send; t++) {
208 croak("Use of %c in printf format not supported", *t);
210 case '0': case '1': case '2': case '3': case '4':
211 case '5': case '6': case '7': case '8': case '9':
212 case '.': case '#': case '-': case '+': case ' ':
227 if (strEQ(f,"%c")) { /* some printfs fail on null chars */
233 (void)sprintf(xs,f,xlen);
245 (void)sprintf(buf,s,(Quad_t)SvNV(arg));
249 (void)sprintf(xs,f,(long)SvNV(arg));
251 (void)sprintf(xs,f,SvIV(arg));
257 case 'x': case 'o': case 'u':
263 (void)sprintf(buf,s,(unsigned Quad_t)value);
267 (void)sprintf(xs,f,U_L(value));
269 (void)sprintf(xs,f,U_I(value));
272 case 'E': case 'e': case 'f': case 'G': case 'g':
275 (void)sprintf(xs,f,SvNV(arg));
281 xs = SvPV(arg, arglen);
283 if (strEQ(f,"%s")) { /* some printfs fail on >128 chars */
284 break; /* so handle simple cases */
286 else if (f[1] == '-') {
287 char *mp = strchr(f, '.');
291 I32 max = atoi(mp+1);
300 else if (isDIGIT(f[1])) {
301 char *mp = strchr(f, '.');
305 I32 max = atoi(mp+1);
314 strcpy(tokenbuf+64,f); /* sprintf($s,...$s...) */
316 (void)sprintf(buf,tokenbuf+64,xs);
321 /* end of switch, copy results */
323 if (xs == buf && xlen >= sizeof(buf)) { /* Ooops! */
324 fputs("panic: sprintf overflow - memory corrupted!\n",stderr);
327 SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post);
328 sv_catpvn(sv, s, f - s);
330 repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, pre);
333 sv_catpvn(sv, xs, xlen);
335 repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, post);
339 break; /* break from for loop */
342 sv_catpvn(sv, s, t - s);
350 SV *targ = LvTARG(sv);
353 register unsigned char *s;
354 register unsigned long lval;
361 s = (unsigned char*)SvPV_force(targ, targlen);
362 lval = U_L(SvNV(sv));
363 offset = LvTARGOFF(sv);
364 size = LvTARGLEN(sv);
366 len = (offset + size + 7) / 8;
368 s = (unsigned char*)SvGROW(targ, len + 1);
369 (void)memzero(s + targlen, len - targlen + 1);
370 SvCUR_set(targ, len);
374 mask = (1 << size) - 1;
378 s[offset] &= ~(mask << size);
379 s[offset] |= lval << size;
384 s[offset] = lval & 255;
385 else if (size == 16) {
386 s[offset] = (lval >> 8) & 255;
387 s[offset+1] = lval & 255;
389 else if (size == 32) {
390 s[offset] = (lval >> 24) & 255;
391 s[offset+1] = (lval >> 16) & 255;
392 s[offset+2] = (lval >> 8) & 255;
393 s[offset+3] = lval & 255;
406 if (SvTYPE(sv) == SVt_PVAV) {
411 for (i = 0; i <= max; i++) {
412 sv = (SV*)av_fetch(av, i, FALSE);
413 if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
418 if (SvTYPE(sv) == SVt_PVHV) {
421 (void)hv_iterinit(hv);
423 while (entry = hv_iternext(hv))
424 do_chop(astr,hv_iterval(hv,entry));
428 if (len && !SvPOK(sv))
429 s = SvPV_force(sv, len);
432 sv_setpvn(astr, s, 1);
438 sv_setpvn(astr, "", 0);
453 if (SvTYPE(sv) == SVt_PVAV) {
458 for (i = 0; i <= max; i++) {
459 sv = (SV*)av_fetch(av, i, FALSE);
460 if (sv && ((sv = *(SV**)sv), sv != &sv_undef))
461 count += do_chomp(sv);
465 if (SvTYPE(sv) == SVt_PVHV) {
468 (void)hv_iterinit(hv);
470 while (entry = hv_iternext(hv))
471 count += do_chomp(hv_iterval(hv,entry));
475 if (len && !SvPOKp(sv))
476 s = SvPV_force(sv, len);
483 while (len && s[-1] == '\n') {
491 char *rsptr = SvPV(rs, rslen);
502 if (bcmp(s, rsptr, rslen))
517 do_vop(optype,sv,left,right)
531 register char *lc = SvPV(left, leftlen);
532 register char *rc = SvPV(right, rightlen);
536 dc = SvPV_force(sv,na);
537 len = leftlen < rightlen ? leftlen : rightlen;
539 if (SvCUR(sv) < len) {
540 dc = SvGROW(sv,len + 1);
541 (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1);
544 (void)SvPOK_only(sv);
546 if (len >= sizeof(long)*4 &&
547 !((long)dc % sizeof(long)) &&
548 !((long)lc % sizeof(long)) &&
549 !((long)rc % sizeof(long))) /* It's almost always aligned... */
551 I32 remainder = len % (sizeof(long)*4);
552 len /= (sizeof(long)*4);
561 *dl++ = *ll++ & *rl++;
562 *dl++ = *ll++ & *rl++;
563 *dl++ = *ll++ & *rl++;
564 *dl++ = *ll++ & *rl++;
569 *dl++ = *ll++ ^ *rl++;
570 *dl++ = *ll++ ^ *rl++;
571 *dl++ = *ll++ ^ *rl++;
572 *dl++ = *ll++ ^ *rl++;
577 *dl++ = *ll++ | *rl++;
578 *dl++ = *ll++ | *rl++;
579 *dl++ = *ll++ | *rl++;
580 *dl++ = *ll++ | *rl++;
598 *dc++ = *lc++ & *rc++;
602 *dc++ = *lc++ ^ *rc++;
606 *dc++ = *lc++ | *rc++;
610 sv_catpvn(sv, rsave + len, rightlen - len);
611 else if (leftlen > len)
612 sv_catpvn(sv, lsave + len, leftlen - len);
630 I32 dokeys = (op->op_type == OP_KEYS);
631 I32 dovalues = (op->op_type == OP_VALUES);
633 if (op->op_type == OP_RV2HV || op->op_type == OP_PADHV)
634 dokeys = dovalues = TRUE;
639 (void)hv_iterinit(hv); /* always reset iterator regardless */
641 if (GIMME != G_ARRAY) {
644 if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
649 while (entry = hv_iternext(hv)) {
657 /* Guess how much room we need. hv_max may be a few too many. Oh well. */
658 EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
660 PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */
661 while (entry = hv_iternext(hv)) {
664 tmps = hv_iterkey(entry,&i); /* won't clobber stack_sp */
667 XPUSHs(sv_2mortal(newSVpv(tmps,i)));
670 tmpstr = NEWSV(45,0);
672 sv_setsv(tmpstr,hv_iterval(hv,entry));
675 sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
676 HvMAX(hv)+1,entry->hent_hash & HvMAX(hv));
677 sv_setpv(tmpstr,buf);
679 XPUSHs(sv_2mortal(tmpstr));