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;
90 tbl = (short*) cPVOP->op_pv;
94 fatal("panic: do_trans");
95 DEBUG_t( deb("2.TBL\n"));
96 if (!op->op_private) {
98 if ((ch = tbl[*s & 0377]) >= 0) {
108 if ((ch = tbl[*s & 0377]) >= 0) {
110 if (matches++ && squash) {
119 else if (ch == -1) /* -1 is unmapped character */
120 *d++ = *s; /* -2 is delete character */
123 matches += send - d; /* account for disappeared chars */
125 SvCUR_set(sv, d - SvPV(sv));
132 do_join(sv,del,mark,sp)
139 register I32 items = sp - mark;
140 register char *delim = SvPVn(del);
142 I32 delimlen = SvCUR(del);
145 len = (items > 0 ? (delimlen * (items - 1) ) : 0);
146 if (SvTYPE(sv) < SVt_PV)
147 sv_upgrade(sv, SVt_PV);
148 if (SvLEN(sv) < len + items) { /* current length is way too short */
149 while (items-- > 0) {
156 len += SvCUR((*mark));
160 SvGROW(sv, len + 1); /* so try to pre-extend */
168 sv_setsv(sv, *mark++);
173 for (; items > 0; items--,mark++) {
174 sv_catpvn(sv,delim,len);
179 for (; items > 0; items--,mark++)
186 do_sprintf(sv,len,sarg)
208 len--; /* don't count pattern string */
209 t = s = SvPVn(*sarg);
210 send = s + SvCUR(*sarg);
215 if (len <= 0 || !(arg = *sarg++))
219 for ( ; t < send && *t != '%'; t++) ;
221 break; /* end of run_format string, ignore extra args */
230 for (t++; t < send; t++) {
239 case '0': case '1': case '2': case '3': case '4':
240 case '5': case '6': case '7': case '8': case '9':
241 case '.': case '#': case '-': case '+': case ' ':
256 if (strEQ(f,"%c")) { /* some printfs fail on null chars */
262 (void)sprintf(xs,f,xlen);
274 (void)sprintf(buf,s,(quad)SvNVn(arg));
278 (void)sprintf(xs,f,(long)SvNVn(arg));
280 (void)sprintf(xs,f,SvIVn(arg));
286 case 'x': case 'o': case 'u':
292 (void)sprintf(buf,s,(unsigned quad)value);
296 (void)sprintf(xs,f,U_L(value));
298 (void)sprintf(xs,f,U_I(value));
301 case 'E': case 'e': case 'f': case 'G': case 'g':
304 (void)sprintf(xs,f,SvNVn(arg));
315 if (strEQ(f,"%s")) { /* some printfs fail on >128 chars */
316 break; /* so handle simple cases */
318 else if (f[1] == '-') {
319 char *mp = index(f, '.');
323 I32 max = atoi(mp+1);
332 else if (isDIGIT(f[1])) {
333 char *mp = index(f, '.');
337 I32 max = atoi(mp+1);
346 strcpy(tokenbuf+64,f); /* sprintf($s,...$s...) */
348 (void)sprintf(buf,tokenbuf+64,xs);
353 /* end of switch, copy results */
355 SvGROW(sv, SvCUR(sv) + (f - s) + xlen + 1 + pre + post);
356 sv_catpvn(sv, s, f - s);
358 repeatcpy(SvPV(sv) + SvCUR(sv), " ", 1, pre);
361 sv_catpvn(sv, xs, xlen);
363 repeatcpy(SvPV(sv) + SvCUR(sv), " ", 1, post);
367 break; /* break from for loop */
370 sv_catpvn(sv, s, t - s);
378 SV *targ = LvTARG(sv);
381 register unsigned char *s = (unsigned char*)SvPV(targ);
382 register unsigned long lval = U_L(SvNVn(sv));
385 offset = LvTARGOFF(sv);
386 size = LvTARGLEN(sv);
388 mask = (1 << size) - 1;
392 s[offset] &= ~(mask << size);
393 s[offset] |= lval << size;
397 s[offset] = lval & 255;
398 else if (size == 16) {
399 s[offset] = (lval >> 8) & 255;
400 s[offset+1] = lval & 255;
402 else if (size == 32) {
403 s[offset] = (lval >> 24) & 255;
404 s[offset+1] = (lval >> 16) & 255;
405 s[offset+2] = (lval >> 8) & 255;
406 s[offset+3] = lval & 255;
424 if (SvTYPE(sv) == SVt_PVAV) {
426 SV **array = AvARRAY(sv);
428 for (i = 0; i <= max; i++)
429 do_chop(astr,array[i]);
432 if (SvTYPE(sv) == SVt_PVHV) {
434 (void)hv_iterinit(hash);
436 while (entry = hv_iternext(hash))
437 do_chop(astr,hv_iterval(hash,entry));
441 if (tmps && SvCUR(sv)) {
442 tmps += SvCUR(sv) - 1;
443 sv_setpvn(astr,tmps,1); /* remember last char */
444 *tmps = '\0'; /* wipe it out */
445 SvCUR_set(sv, tmps - SvPV(sv));
450 sv_setpvn(astr,"",0);
454 do_vop(optype,sv,left,right)
466 register char *lc = SvPVn(left);
467 register char *rc = SvPVn(right);
471 if (len > SvCUR(right))
473 if (SvTYPE(sv) < SVt_PV)
474 sv_upgrade(sv, SVt_PV);
477 else if (SvCUR(sv) < len) {
479 (void)memzero(SvPV(sv) + SvCUR(sv), len - SvCUR(sv));
489 if (len >= sizeof(long)*4 &&
490 !((long)dc % sizeof(long)) &&
491 !((long)lc % sizeof(long)) &&
492 !((long)rc % sizeof(long))) /* It's almost always aligned... */
494 I32 remainder = len % (sizeof(long)*4);
495 len /= (sizeof(long)*4);
504 *dl++ = *ll++ & *rl++;
505 *dl++ = *ll++ & *rl++;
506 *dl++ = *ll++ & *rl++;
507 *dl++ = *ll++ & *rl++;
512 *dl++ = *ll++ ^ *rl++;
513 *dl++ = *ll++ ^ *rl++;
514 *dl++ = *ll++ ^ *rl++;
515 *dl++ = *ll++ ^ *rl++;
520 *dl++ = *ll++ | *rl++;
521 *dl++ = *ll++ | *rl++;
522 *dl++ = *ll++ | *rl++;
523 *dl++ = *ll++ | *rl++;
537 *dc++ = *lc++ & *rc++;
541 *dc++ = *lc++ ^ *rc++;
545 *dc++ = *lc++ | *rc++;
548 if (SvCUR(right) > len)
549 sv_catpvn(sv,SvPV(right)+len,SvCUR(right) - len);
550 else if (SvCUR(left) > len)
551 sv_catpvn(sv,SvPV(left)+len,SvCUR(left) - len);