1 /* $RCSfile: doarg.c,v $$Revision: 4.1 $$Date: 92/08/07 17:19:37 $
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:37 lwall
12 * Revision 4.0.1.7 92/06/11 21:07:11 lwall
13 * patch34: join with null list attempted negative allocation
14 * patch34: sprintf("%6.4s", "abcdefg") didn't print "abcd "
16 * Revision 4.0.1.6 92/06/08 12:34:30 lwall
17 * patch20: removed implicit int declarations on funcions
18 * patch20: pattern modifiers i and o didn't interact right
19 * patch20: join() now pre-extends target string to avoid excessive copying
20 * patch20: fixed confusion between a *var's real name and its effective name
21 * patch20: subroutines didn't localize $`, $&, $', $1 et al correctly
22 * patch20: usersub routines didn't reclaim temp values soon enough
23 * patch20: ($<,$>) = ... didn't work on some architectures
24 * patch20: added Atari ST portability
26 * Revision 4.0.1.5 91/11/11 16:31:58 lwall
27 * patch19: added little-endian pack/unpack options
29 * Revision 4.0.1.4 91/11/05 16:35:06 lwall
30 * patch11: /$foo/o optimizer could access deallocated data
31 * patch11: minimum match length calculation in regexp is now cumulative
32 * patch11: added some support for 64-bit integers
33 * patch11: prepared for ctype implementations that don't define isascii()
34 * patch11: sprintf() now supports any length of s field
35 * patch11: indirect subroutine calls through magic vars (e.g. &$1) didn't work
36 * patch11: defined(&$foo) and undef(&$foo) didn't work
38 * Revision 4.0.1.3 91/06/10 01:18:41 lwall
39 * patch10: pack(hh,1) dumped core
41 * Revision 4.0.1.2 91/06/07 10:42:17 lwall
42 * patch4: new copyright notice
43 * patch4: // wouldn't use previous pattern if it started with a null character
44 * patch4: //o and s///o now optimize themselves fully at runtime
45 * patch4: added global modifier for pattern matches
46 * patch4: undef @array disabled "@array" interpolation
47 * patch4: chop("") was returning "\0" rather than ""
48 * patch4: vector logical operations &, | and ^ sometimes returned null string
49 * patch4: syscall couldn't pass numbers with most significant bit set on sparcs
51 * Revision 4.0.1.1 91/04/11 17:40:14 lwall
52 * patch1: fixed undefined environ problem
53 * patch1: fixed debugger coredump on subroutines
55 * Revision 4.0 91/03/20 01:06:42 lwall
63 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
68 #pragma function(memcmp)
69 #endif /* BUGGY_MSC */
71 static void doencodes();
74 #pragma intrinsic(memcmp)
75 #endif /* BUGGY_MSC */
84 register I32 matches = 0;
88 register I32 squash = op->op_private & OPpTRANS_SQUASH;
91 tbl = (short*) cPVOP->op_pv;
95 croak("panic: do_trans");
96 DEBUG_t( deb("2.TBL\n"));
97 if (!op->op_private) {
99 if ((ch = tbl[*s & 0377]) >= 0) {
109 if ((ch = tbl[*s & 0377]) >= 0) {
111 if (matches++ && squash) {
120 else if (ch == -1) /* -1 is unmapped character */
121 *d++ = *s; /* -2 is delete character */
124 matches += send - d; /* account for disappeared chars */
126 SvCUR_set(sv, d - SvPVX(sv));
133 do_join(sv,del,mark,sp)
140 register I32 items = sp - mark;
143 register char *delim = SvPV(del, delimlen);
147 len = (items > 0 ? (delimlen * (items - 1) ) : 0);
148 if (SvTYPE(sv) < SVt_PV)
149 sv_upgrade(sv, SVt_PV);
150 if (SvLEN(sv) < len + items) { /* current length is way too short */
151 while (items-- > 0) {
158 SvGROW(sv, len + 1); /* so try to pre-extend */
166 char *s = SvPV(*mark, tmplen);
167 sv_setpvn(sv, s, tmplen);
174 for (; items > 0; items--,mark++) {
175 sv_catpvn(sv,delim,len);
180 for (; items > 0; items--,mark++)
187 do_sprintf(sv,len,sarg)
210 len--; /* don't count pattern string */
211 t = s = SvPV(*sarg, arglen);
217 if (len <= 0 || !(arg = *sarg++))
221 for ( ; t < send && *t != '%'; t++) ;
223 break; /* end of run_format string, ignore extra args */
232 for (t++; t < send; t++) {
241 case '0': case '1': case '2': case '3': case '4':
242 case '5': case '6': case '7': case '8': case '9':
243 case '.': case '#': case '-': case '+': case ' ':
258 if (strEQ(f,"%c")) { /* some printfs fail on null chars */
264 (void)sprintf(xs,f,xlen);
276 (void)sprintf(buf,s,(quad)SvNV(arg));
280 (void)sprintf(xs,f,(long)SvNV(arg));
282 (void)sprintf(xs,f,SvIV(arg));
288 case 'x': case 'o': case 'u':
294 (void)sprintf(buf,s,(unsigned quad)value);
298 (void)sprintf(xs,f,U_L(value));
300 (void)sprintf(xs,f,U_I(value));
303 case 'E': case 'e': case 'f': case 'G': case 'g':
306 (void)sprintf(xs,f,SvNV(arg));
312 xs = SvPV(arg, arglen);
314 if (strEQ(f,"%s")) { /* some printfs fail on >128 chars */
315 break; /* so handle simple cases */
317 else if (f[1] == '-') {
318 char *mp = strchr(f, '.');
322 I32 max = atoi(mp+1);
331 else if (isDIGIT(f[1])) {
332 char *mp = strchr(f, '.');
336 I32 max = atoi(mp+1);
345 strcpy(tokenbuf+64,f); /* sprintf($s,...$s...) */
347 (void)sprintf(buf,tokenbuf+64,xs);
352 /* end of switch, copy results */
354 SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post);
355 sv_catpvn(sv, s, f - s);
357 repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, pre);
360 sv_catpvn(sv, xs, xlen);
362 repeatcpy(SvPVX(sv) + SvCUR(sv), " ", 1, post);
366 break; /* break from for loop */
369 sv_catpvn(sv, s, t - s);
377 SV *targ = LvTARG(sv);
380 register unsigned char *s = (unsigned char*)SvPVX(targ);
381 register unsigned long lval = U_L(SvNV(sv));
384 offset = LvTARGOFF(sv);
385 size = LvTARGLEN(sv);
387 mask = (1 << size) - 1;
391 s[offset] &= ~(mask << size);
392 s[offset] |= lval << size;
396 s[offset] = lval & 255;
397 else if (size == 16) {
398 s[offset] = (lval >> 8) & 255;
399 s[offset+1] = lval & 255;
401 else if (size == 32) {
402 s[offset] = (lval >> 24) & 255;
403 s[offset+1] = (lval >> 16) & 255;
404 s[offset+2] = (lval >> 8) & 255;
405 s[offset+3] = lval & 255;
425 croak("Can't chop readonly value");
426 if (SvTYPE(sv) == SVt_PVAV) {
428 SV **array = AvARRAY(sv);
430 for (i = 0; i <= max; i++)
431 do_chop(astr,array[i]);
434 if (SvTYPE(sv) == SVt_PVHV) {
436 (void)hv_iterinit(hv);
438 while (entry = hv_iternext(hv))
439 do_chop(astr,hv_iterval(hv,entry));
442 tmps = SvPV(sv, len);
445 sv_setpvn(astr,tmps,1); /* remember last char */
446 *tmps = '\0'; /* wipe it out */
447 SvCUR_set(sv, tmps - SvPVX(sv));
452 sv_setpvn(astr,"",0);
456 do_vop(optype,sv,left,right)
470 register char *lc = SvPV(left, leftlen);
471 register char *rc = SvPV(right, rightlen);
475 croak("Can't do %s to readonly value", op_name[optype]);
476 len = leftlen < rightlen ? leftlen : rightlen;
477 if (SvTYPE(sv) < SVt_PV)
478 sv_upgrade(sv, SVt_PV);
481 else if (SvCUR(sv) < len) {
483 (void)memzero(SvPVX(sv) + SvCUR(sv), len - SvCUR(sv));
493 if (len >= sizeof(long)*4 &&
494 !((long)dc % sizeof(long)) &&
495 !((long)lc % sizeof(long)) &&
496 !((long)rc % sizeof(long))) /* It's almost always aligned... */
498 I32 remainder = len % (sizeof(long)*4);
499 len /= (sizeof(long)*4);
508 *dl++ = *ll++ & *rl++;
509 *dl++ = *ll++ & *rl++;
510 *dl++ = *ll++ & *rl++;
511 *dl++ = *ll++ & *rl++;
516 *dl++ = *ll++ ^ *rl++;
517 *dl++ = *ll++ ^ *rl++;
518 *dl++ = *ll++ ^ *rl++;
519 *dl++ = *ll++ ^ *rl++;
524 *dl++ = *ll++ | *rl++;
525 *dl++ = *ll++ | *rl++;
526 *dl++ = *ll++ | *rl++;
527 *dl++ = *ll++ | *rl++;
541 *dc++ = *lc++ & *rc++;
545 *dc++ = *lc++ ^ *rc++;
549 *dc++ = *lc++ | *rc++;
553 sv_catpvn(sv, SvPVX(right) + len, rightlen - len);
554 else if (leftlen > len)
555 sv_catpvn(sv, SvPVX(left) + len, leftlen - len);
566 register AV *ary = stack;
571 I32 dokeys = (op->op_type == OP_KEYS || op->op_type == OP_RV2HV);
572 I32 dovalues = (op->op_type == OP_VALUES || op->op_type == OP_RV2HV);
576 if (GIMME != G_ARRAY) {
579 if (!SvMAGICAL(hv) || !mg_find((SV*)hv,'P'))
583 (void)hv_iterinit(hv);
585 while (entry = hv_iternext(hv)) {
593 /* Guess how much room we need. hv_max may be a few too many. Oh well. */
594 EXTEND(sp, HvMAX(hv) * (dokeys + dovalues));
596 (void)hv_iterinit(hv);
598 PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */
599 while (entry = hv_iternext(hv)) {
602 tmps = hv_iterkey(entry,&i); /* won't clobber stack_sp */
605 XPUSHs(sv_2mortal(newSVpv(tmps,i)));
608 tmpstr = NEWSV(45,0);
610 sv_setsv(tmpstr,hv_iterval(hv,entry));
613 sprintf(buf,"%d%%%d=%d\n",entry->hent_hash,
614 HvMAX(hv)+1,entry->hent_hash & HvMAX(hv));
615 sv_setpv(tmpstr,buf);
617 XPUSHs(sv_2mortal(tmpstr));