diff options
Diffstat (limited to 'doop.c2')
| -rw-r--r-- | doop.c2 | 571 |
1 files changed, 571 insertions, 0 deletions
diff --git a/doop.c2 b/doop.c2 new file mode 100644 index 0000000000..ea5fec7a83 --- /dev/null +++ b/doop.c2 @@ -0,0 +1,571 @@ +/* $RCSfile: doarg.c,v $$Revision: 4.1 $$Date: 92/08/07 17:19:37 $ + * + * Copyright (c) 1991, Larry Wall + * + * You may distribute under the terms of either the GNU General Public + * License or the Artistic License, as specified in the README file. + * + * $Log: doarg.c,v $ + * Revision 4.1 92/08/07 17:19:37 lwall + * Stage 6 Snapshot + * + * Revision 4.0.1.7 92/06/11 21:07:11 lwall + * patch34: join with null list attempted negative allocation + * patch34: sprintf("%6.4s", "abcdefg") didn't print "abcd " + * + * Revision 4.0.1.6 92/06/08 12:34:30 lwall + * patch20: removed implicit int declarations on funcions + * patch20: pattern modifiers i and o didn't interact right + * patch20: join() now pre-extends target string to avoid excessive copying + * patch20: fixed confusion between a *var's real name and its effective name + * patch20: subroutines didn't localize $`, $&, $', $1 et al correctly + * patch20: usersub routines didn't reclaim temp values soon enough + * patch20: ($<,$>) = ... didn't work on some architectures + * patch20: added Atari ST portability + * + * Revision 4.0.1.5 91/11/11 16:31:58 lwall + * patch19: added little-endian pack/unpack options + * + * Revision 4.0.1.4 91/11/05 16:35:06 lwall + * patch11: /$foo/o optimizer could access deallocated data + * patch11: minimum match length calculation in regexp is now cumulative + * patch11: added some support for 64-bit integers + * patch11: prepared for ctype implementations that don't define isascii() + * patch11: sprintf() now supports any length of s field + * patch11: indirect subroutine calls through magic vars (e.g. &$1) didn't work + * patch11: defined(&$foo) and undef(&$foo) didn't work + * + * Revision 4.0.1.3 91/06/10 01:18:41 lwall + * patch10: pack(hh,1) dumped core + * + * Revision 4.0.1.2 91/06/07 10:42:17 lwall + * patch4: new copyright notice + * patch4: // wouldn't use previous pattern if it started with a null character + * patch4: //o and s///o now optimize themselves fully at runtime + * patch4: added global modifier for pattern matches + * patch4: undef @array disabled "@array" interpolation + * patch4: chop("") was returning "\0" rather than "" + * patch4: vector logical operations &, | and ^ sometimes returned null string + * patch4: syscall couldn't pass numbers with most significant bit set on sparcs + * + * Revision 4.0.1.1 91/04/11 17:40:14 lwall + * patch1: fixed undefined environ problem + * patch1: fixed debugger coredump on subroutines + * + * Revision 4.0 91/03/20 01:06:42 lwall + * 4.0 baseline. + * + */ + +#include "EXTERN.h" +#include "perl.h" + +#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) +#include <signal.h> +#endif + +#ifdef BUGGY_MSC + #pragma function(memcmp) +#endif /* BUGGY_MSC */ + +static void doencodes(); + +#ifdef BUGGY_MSC + #pragma intrinsic(memcmp) +#endif /* BUGGY_MSC */ + +int +do_trans(sv,arg) +SV *sv; +OP *arg; +{ + register short *tbl; + register char *s; + register int matches = 0; + register int ch; + register char *send; + register char *d; + register int squash = op->op_private & OPpTRANS_SQUASH; + + tbl = (short*) cPVOP->op_pv; + s = SvPV(sv); + send = s + sv->sv_cur; + if (!tbl || !s) + fatal("panic: do_trans"); +#ifdef DEBUGGING + if (debug & 8) { + deb("2.TBL\n"); + } +#endif + if (!op->op_private) { + while (s < send) { + if ((ch = tbl[*s & 0377]) >= 0) { + matches++; + *s = ch; + } + s++; + } + } + else { + d = s; + while (s < send) { + if ((ch = tbl[*s & 0377]) >= 0) { + *d = ch; + if (matches++ && squash) { + if (d[-1] == *d) + matches--; + else + d++; + } + else + d++; + } + else if (ch == -1) /* -1 is unmapped character */ + *d++ = *s; /* -2 is delete character */ + s++; + } + matches += send - d; /* account for disappeared chars */ + *d = '\0'; + sv->sv_cur = d - sv->sv_ptr; + } + SvSETMAGIC(sv); + return matches; +} + +void +do_join(sv,del,mark,sp) +register SV *sv; +SV *del; +register SV **mark; +register SV **sp; +{ + SV **oldmark = mark; + register int items = sp - mark; + register char *delim = SvPV(del); + register STRLEN len; + int delimlen = del->sv_cur; + + mark++; + len = (items > 0 ? (delimlen * (items - 1) ) : 0); + if (sv->sv_len < len + items) { /* current length is way too short */ + while (items-- > 0) { + if (*mark) + len += (*mark)->sv_cur; + mark++; + } + SvGROW(sv, len + 1); /* so try to pre-extend */ + + mark = oldmark; + items = sp - mark;; + ++mark; + } + + if (items-- > 0) + sv_setsv(sv, *mark++); + else + sv_setpv(sv,""); + len = delimlen; + if (len) { + for (; items > 0; items--,mark++) { + sv_catpvn(sv,delim,len); + sv_catsv(sv,*mark); + } + } + else { + for (; items > 0; items--,mark++) + sv_catsv(sv,*mark); + } + SvSETMAGIC(sv); +} + +void +do_sprintf(sv,numargs,firstarg) +register SV *sv; +int numargs; +SV **firstarg; +{ + register char *s; + register char *t; + register char *f; + register int argix = 0; + register SV **sarg = firstarg; + bool dolong; +#ifdef QUAD + bool doquad; +#endif /* QUAD */ + char ch; + register char *send; + register SV *arg; + char *xs; + int xlen; + int pre; + int post; + double value; + + sv_setpv(sv,""); + len--; /* don't count pattern string */ + t = s = SvPV(*sarg); + send = s + (*sarg)->sv_cur; + sarg++; + for ( ; ; argix++) { + + /*SUPPRESS 530*/ + for ( ; t < send && *t != '%'; t++) ; + if (t >= send) + break; /* end of run_format string, ignore extra args */ + f = t; + if (t[2] == '$' && isDIGIT(t[1])) { + ch = *(++t); + *t = '\0'; + (void)sprintf(xs,t); + sv_catpvn(sv, xs, xlen); + argix = atoi(t+1); + sarg = firstarg + argix; + t[2] = '%'; + f += 2; + + } + /*SUPPRESS 560*/ + if (argix > numargs || !(arg = *sarg++)) + arg = &sv_no; + + *buf = '\0'; + xs = buf; +#ifdef QUAD + doquad = +#endif /* QUAD */ + dolong = FALSE; + pre = post = 0; + for (t++; t < send; t++) { + switch (*t) { + default: + ch = *(++t); + *t = '\0'; + (void)sprintf(xs,f); + argix--, sarg--; + xlen = strlen(xs); + break; + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + case '.': case '#': case '-': case '+': case ' ': + continue; + case 'l': +#ifdef QUAD + if (dolong) { + dolong = FALSE; + doquad = TRUE; + } else +#endif + dolong = TRUE; + continue; + case 'c': + ch = *(++t); + *t = '\0'; + xlen = (int)SvNV(arg); + if (strEQ(f,"%c")) { /* some printfs fail on null chars */ + *xs = xlen; + xs[1] = '\0'; + xlen = 1; + } + else { + (void)sprintf(xs,f,xlen); + xlen = strlen(xs); + } + break; + case 'D': + dolong = TRUE; + /* FALL THROUGH */ + case 'd': + ch = *(++t); + *t = '\0'; +#ifdef QUAD + if (doquad) + (void)sprintf(buf,s,(quad)SvNV(arg)); + else +#endif + if (dolong) + (void)sprintf(xs,f,(long)SvNV(arg)); + else + (void)sprintf(xs,f,(int)SvNV(arg)); + xlen = strlen(xs); + break; + case 'X': case 'O': + dolong = TRUE; + /* FALL THROUGH */ + case 'x': case 'o': case 'u': + ch = *(++t); + *t = '\0'; + value = SvNV(arg); +#ifdef QUAD + if (doquad) + (void)sprintf(buf,s,(unsigned quad)value); + else +#endif + if (dolong) + (void)sprintf(xs,f,U_L(value)); + else + (void)sprintf(xs,f,U_I(value)); + xlen = strlen(xs); + break; + case 'E': case 'e': case 'f': case 'G': case 'g': + ch = *(++t); + *t = '\0'; + (void)sprintf(xs,f,SvNV(arg)); + xlen = strlen(xs); + break; + case 's': + ch = *(++t); + *t = '\0'; + xs = SvPV(arg); + xlen = arg->sv_cur; + if (*xs == 'S' && xs[1] == 't' && xs[2] == 'B' && xs[3] == '\0' + && xlen == sizeof(GP)) { + SV *tmpstr = NEWSV(24,0); + + gv_efullname(tmpstr, ((GV*)arg)); /* a gv value! */ + sprintf(tokenbuf,"*%s",tmpstr->sv_ptr); + /* reformat to non-binary */ + xs = tokenbuf; + xlen = strlen(tokenbuf); + sv_free(tmpstr); + } + if (strEQ(f,"%s")) { /* some printfs fail on >128 chars */ + break; /* so handle simple cases */ + } + else if (f[1] == '-') { + char *mp = index(f, '.'); + int min = atoi(f+2); + + if (mp) { + int max = atoi(mp+1); + + if (xlen > max) + xlen = max; + } + if (xlen < min) + post = min - xlen; + break; + } + else if (isDIGIT(f[1])) { + char *mp = index(f, '.'); + int min = atoi(f+1); + + if (mp) { + int max = atoi(mp+1); + + if (xlen > max) + xlen = max; + } + if (xlen < min) + pre = min - xlen; + break; + } + strcpy(tokenbuf+64,f); /* sprintf($s,...$s...) */ + *t = ch; + (void)sprintf(buf,tokenbuf+64,xs); + xs = buf; + xlen = strlen(xs); + break; + } + /* end of switch, copy results */ + *t = ch; + SvGROW(sv, sv->sv_cur + (f - s) + xlen + 1 + pre + post); + sv_catpvn(sv, s, f - s); + if (pre) { + repeatcpy(sv->sv_ptr + sv->sv_cur, " ", 1, pre); + sv->sv_cur += pre; + } + sv_catpvn(sv, xs, xlen); + if (post) { + repeatcpy(sv->sv_ptr + sv->sv_cur, " ", 1, post); + sv->sv_cur += post; + } + s = t; + break; /* break from for loop */ + } + } + sv_catpvn(sv, s, t - s); + SvSETMAGIC(sv); +} + +void +do_vecset(mstr,sv) +SV *mstr; +SV *sv; +{ + struct lstring *lstr = (struct lstring*)sv; + register int offset; + register int size; + register unsigned char *s = (unsigned char*)mstr->sv_ptr; + register unsigned long lval = U_L(SvNV(sv)); + int mask; + + mstr->sv_rare = 0; + sv->sv_magic = Nullsv; + offset = lstr->lstr_offset; + size = lstr->lstr_len; + if (size < 8) { + mask = (1 << size) - 1; + size = offset & 7; + lval &= mask; + offset >>= 3; + s[offset] &= ~(mask << size); + s[offset] |= lval << size; + } + else { + if (size == 8) + s[offset] = lval & 255; + else if (size == 16) { + s[offset] = (lval >> 8) & 255; + s[offset+1] = lval & 255; + } + else if (size == 32) { + s[offset] = (lval >> 24) & 255; + s[offset+1] = (lval >> 16) & 255; + s[offset+2] = (lval >> 8) & 255; + s[offset+3] = lval & 255; + } + } +} + +void +do_chop(astr,sv) +register SV *astr; +register SV *sv; +{ + register char *tmps; + register int i; + AV *ary; + HV *hash; + HE *entry; + + if (!sv) + return; + if (sv->sv_state == SVs_AV) { + ary = (AV*)sv; + for (i = 0; i <= ary->av_fill; i++) + do_chop(astr,ary->av_array[i]); + return; + } + if (sv->sv_state == SVs_HV) { + hash = (HV*)sv; + (void)hv_iterinit(hash); + /*SUPPRESS 560*/ + while (entry = hv_iternext(hash)) + do_chop(astr,hv_iterval(hash,entry)); + return; + } + tmps = SvPV(sv); + if (tmps && sv->sv_cur) { + tmps += sv->sv_cur - 1; + sv_setpvn(astr,tmps,1); /* remember last char */ + *tmps = '\0'; /* wipe it out */ + sv->sv_cur = tmps - sv->sv_ptr; + sv->sv_nok = 0; + SvSETMAGIC(sv); + } + else + sv_setpvn(astr,"",0); +} + +void +do_vop(optype,sv,left,right) +int optype; +SV *sv; +SV *left; +SV *right; +{ +#ifdef LIBERAL + register long *dl; + register long *ll; + register long *rl; +#endif + register char *dc; + register char *lc = SvPV(left); + register char *rc = SvPV(right); + register int len; + + len = left->sv_cur; + if (len > right->sv_cur) + len = right->sv_cur; + if (sv->sv_cur > len) + sv->sv_cur = len; + else if (sv->sv_cur < len) { + SvGROW(sv,len); + (void)memzero(sv->sv_ptr + sv->sv_cur, len - sv->sv_cur); + sv->sv_cur = len; + } + sv->sv_pok = 1; + sv->sv_nok = 0; + dc = sv->sv_ptr; + if (!dc) { + sv_setpvn(sv,"",0); + dc = sv->sv_ptr; + } +#ifdef LIBERAL + if (len >= sizeof(long)*4 && + !((long)dc % sizeof(long)) && + !((long)lc % sizeof(long)) && + !((long)rc % sizeof(long))) /* It's almost always aligned... */ + { + int remainder = len % (sizeof(long)*4); + len /= (sizeof(long)*4); + + dl = (long*)dc; + ll = (long*)lc; + rl = (long*)rc; + + switch (optype) { + case OP_BIT_AND: + while (len--) { + *dl++ = *ll++ & *rl++; + *dl++ = *ll++ & *rl++; + *dl++ = *ll++ & *rl++; + *dl++ = *ll++ & *rl++; + } + break; + case OP_XOR: + while (len--) { + *dl++ = *ll++ ^ *rl++; + *dl++ = *ll++ ^ *rl++; + *dl++ = *ll++ ^ *rl++; + *dl++ = *ll++ ^ *rl++; + } + break; + case OP_BIT_OR: + while (len--) { + *dl++ = *ll++ | *rl++; + *dl++ = *ll++ | *rl++; + *dl++ = *ll++ | *rl++; + *dl++ = *ll++ | *rl++; + } + } + + dc = (char*)dl; + lc = (char*)ll; + rc = (char*)rl; + + len = remainder; + } +#endif + switch (optype) { + case OP_BIT_AND: + while (len--) + *dc++ = *lc++ & *rc++; + break; + case OP_XOR: + while (len--) + *dc++ = *lc++ ^ *rc++; + goto mop_up; + case OP_BIT_OR: + while (len--) + *dc++ = *lc++ | *rc++; + mop_up: + len = sv->sv_cur; + if (right->sv_cur > len) + sv_catpvn(sv,right->sv_ptr+len,right->sv_cur - len); + else if (left->sv_cur > len) + sv_catpvn(sv,left->sv_ptr+len,left->sv_cur - len); + break; + } +} |