diff options
Diffstat (limited to 'doop.c2')
| -rw-r--r-- | doop.c2 | 571 |
1 files changed, 0 insertions, 571 deletions
diff --git a/doop.c2 b/doop.c2 deleted file mode 100644 index ea5fec7a83..0000000000 --- a/doop.c2 +++ /dev/null @@ -1,571 +0,0 @@ -/* $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; - } -} |