-/* $Header: str.c,v 3.0 89/10/18 15:23:38 lwall Locked $
+/* $Header: str.c,v 3.0.1.6 90/03/12 17:02:14 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: str.c,v $
+ * Revision 3.0.1.6 90/03/12 17:02:14 lwall
+ * patch13: substr as lvalue didn't invalidate old numeric value
+ *
+ * Revision 3.0.1.5 90/02/28 18:30:38 lwall
+ * patch9: you may now undef $/ to have no input record separator
+ * patch9: nested evals clobbered their longjmp environment
+ * patch9: sometimes perl thought ordinary data was a symbol table entry
+ * patch9: insufficient space allocated for numeric string on sun4
+ * patch9: underscore in an array name in a double-quoted string not recognized
+ * patch9: "@foo{}" not recognized unless %foo defined
+ * patch9: "$foo[$[]" gives error
+ *
+ * Revision 3.0.1.4 89/12/21 20:21:35 lwall
+ * patch7: errno may now be a macro with an lvalue
+ * patch7: made nested or recursive foreach work right
+ *
+ * Revision 3.0.1.3 89/11/17 15:38:23 lwall
+ * patch5: some machines typedef unchar too
+ * patch5: substitution on leading components occasionally caused <> corruption
+ *
+ * Revision 3.0.1.2 89/11/11 04:56:22 lwall
+ * patch2: uchar gives Crays fits
+ *
+ * Revision 3.0.1.1 89/10/26 23:23:41 lwall
+ * patch1: string ordering tests were wrong
+ * patch1: $/ now works even when STDSTDIO undefined
+ *
* Revision 3.0 89/10/18 15:23:38 lwall
* 3.0 baseline
*
#endif
}
-extern int errno;
-
char *
str_2ptr(str)
register STR *str;
if (!str)
return "";
if (str->str_nok) {
+/* this is a problem on the sun 4... 24 bytes is not always enough and the
+ exponent blows away the malloc stack
+ PEJ Wed Jan 31 18:41:34 CST 1990
+*/
+#ifdef sun4
+ STR_GROW(str, 30);
+#else
STR_GROW(str, 24);
+#endif /* sun 4 */
s = str->str_ptr;
olderrno = errno; /* some Xenix systems wipe out errno here */
#if defined(scs) && defined(ns32000)
#endif /*scs*/
errno = olderrno;
while (*s) s++;
+#ifdef hcx
+ if (s[-1] == '.')
+ s--;
+#endif
}
else {
if (str == &str_undef)
return No;
if (dowarn)
warn("Use of uninitialized variable");
+#ifdef sun4
+ STR_GROW(str, 30);
+#else
STR_GROW(str, 24);
+#endif
s = str->str_ptr;
}
*s = '\0';
#ifdef TAINT
tainted |= sstr->str_tainted;
#endif
+ if (sstr == dstr)
+ return;
if (!sstr)
dstr->str_pok = dstr->str_nok = 0;
else if (sstr->str_pok) {
else if (sstr->str_cur == sizeof(STBP)) {
char *tmps = sstr->str_ptr;
- if (*tmps == 'S' && bcmp(tmps,"Stab",4) == 0) {
+ if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) {
dstr->str_magic = str_smake(sstr->str_magic);
dstr->str_magic->str_rare = 'X';
}
}
else if (sstr->str_nok)
str_numset(dstr,sstr->str_u.str_nval);
- else
+ else {
+#ifdef STRUCTCOPY
+ dstr->str_u = sstr->str_u;
+#else
+ dstr->str_u.str_nval = sstr->str_u.str_nval;
+#endif
dstr->str_pok = dstr->str_nok = 0;
+ }
}
str_nset(str,ptr,len)
register char *bigend;
register int i;
+ bigstr->str_nok = 0;
+ bigstr->str_pok = SP_VALID; /* disable possible screamer */
+
i = littlelen - len;
if (i > 0) { /* string might grow */
STR_GROW(bigstr, bigstr->str_cur + i + 1);
if (midend > bigend)
fatal("panic: str_insert");
- bigstr->str_pok = SP_VALID; /* disable possible screamer */
-
if (mid - big > bigend - midend) { /* faster to shorten from end */
if (littlelen) {
(void)bcopy(little, mid, littlelen);
if (retval = memcmp(str1->str_ptr, str2->str_ptr, str1->str_cur))
return retval;
else
- return 1;
+ return -1;
}
else if (retval = memcmp(str1->str_ptr, str2->str_ptr, str2->str_cur))
return retval;
else if (str1->str_cur == str2->str_cur)
return 0;
else
- return -1;
+ return 1;
}
char *
register FILE *fp;
int append;
{
-#ifdef STDSTDIO /* Here is some breathtakingly efficient cheating */
-
register char *bp; /* we're going to steal some values */
register int cnt; /* from the stdio struct and put EVERYTHING */
register STDCHAR *ptr; /* in the innermost loop into registers */
- register char newline = record_separator;/* (assuming >= 6 registers) */
+ register int newline = record_separator;/* (assuming >= 6 registers) */
int i;
int bpx;
int obpx;
newline = '\n';
oldbp = Nullch; /* remember last \n position (none) */
}
+#ifdef STDSTDIO /* Here is some breathtakingly efficient cheating */
+
cnt = fp->_cnt; /* get count into register */
str->str_nok = 0; /* invalidate number */
str->str_pok = 1; /* validate pointer */
bpx = bp - str->str_ptr; /* prepare for possible relocation */
if (get_paragraph && oldbp)
obpx = oldbp - str->str_ptr;
+ str->str_cur = bpx;
STR_GROW(str, bpx + cnt + 2);
bp = str->str_ptr + bpx; /* reconstitute our pointer */
if (get_paragraph && oldbp)
#else /* !STDSTDIO */ /* The big, slow, and stupid way */
- static char buf[8192];
+ {
+ static char buf[8192];
+ char * bpe = buf + sizeof(buf) - 3;
+
+screamer:
+ bp = buf;
+filler:
+ while ((i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe);
+ if (i == newline && get_paragraph &&
+ (i = getc(fp)) != EOF && (*bp++ = i) != newline && bp < bpe)
+ goto filler;
- if (fgets(buf, sizeof buf, fp) != Nullch) {
+ *bp = '\0';
if (append)
str_cat(str, buf);
else
str_set(str, buf);
+ if (i != newline && i != EOF) {
+ append = -1;
+ goto screamer;
+ }
}
- else
- str_set(str, No);
#endif /* STDSTDIO */
register ARG *arg;
line_t oldline = line;
int retval;
+ char *tmps;
str_sset(linestr,str);
in_eval++;
oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
bufend = bufptr + linestr->str_cur;
- if (setjmp(eval_env)) {
- in_eval = 0;
+ if (++loop_ptr >= loop_max) {
+ loop_max += 128;
+ Renew(loop_stack, loop_max, struct loop);
+ }
+ loop_stack[loop_ptr].loop_label = "_EVAL_";
+ loop_stack[loop_ptr].loop_sp = 0;
+#ifdef DEBUGGING
+ if (debug & 4) {
+ deb("(Pushing label #%d _EVAL_)\n", loop_ptr);
+ }
+#endif
+ if (setjmp(loop_stack[loop_ptr].loop_env)) {
+ in_eval--;
+ loop_ptr--;
fatal("%s\n",stab_val(stabent("@",TRUE))->str_ptr);
}
+#ifdef DEBUGGING
+ if (debug & 4) {
+ tmps = loop_stack[loop_ptr].loop_label;
+ deb("(Popping label #%d %s)\n",loop_ptr,
+ tmps ? tmps : "" );
+ }
+#endif
+ loop_ptr--;
error_count = 0;
retval = yyparse();
in_eval--;
s+1 < send) {
str_ncat(str,t,s-t);
t = s;
- if (*s == '$' && s[1] == '#' && isalpha(s[2]) || s[2] == '_')
+ if (*s == '$' && s[1] == '#' && (isalpha(s[2]) || s[2] == '_'))
s++;
s = scanreg(s,send,tokenbuf);
if (*t == '@' &&
- (!(stab = stabent(tokenbuf,FALSE)) || !stab_xarray(stab)) ) {
+ (!(stab = stabent(tokenbuf,FALSE)) ||
+ (*s == '{' ? !stab_xhash(stab) : !stab_xarray(stab)) )) {
str_ncat(str,"@",1);
s = ++t;
continue; /* grandfather @ from old scripts */
checkpoint = s;
do {
switch (*s) {
- case '[': case '{':
+ case '[':
+ if (s[-1] != '$')
+ brackets++;
+ break;
+ case '{':
brackets++;
break;
- case ']': case '}':
+ case ']':
+ if (s[-1] != '$')
+ brackets--;
+ break;
+ case '}':
brackets--;
break;
case '\'':
else if (*d == '[' && s[-1] == ']') { /* char class? */
int weight = 2; /* let's weigh the evidence */
char seen[256];
- unsigned char uchar = 0, lastuchar;
+ unsigned char un_char = 0, last_un_char;
Zero(seen,256,char);
*--s = '\0';
weight -= 100;
}
for (d++; d < s; d++) {
- lastuchar = uchar;
- uchar = (unsigned char)*d;
+ last_un_char = un_char;
+ un_char = (unsigned char)*d;
switch (*d) {
case '&':
case '$':
- weight -= seen[uchar] * 10;
+ weight -= seen[un_char] * 10;
if (isalpha(d[1]) || isdigit(d[1]) ||
d[1] == '_') {
d = scanreg(d,s,tokenbuf);
}
break;
case '\\':
- uchar = 254;
+ un_char = 254;
if (d[1]) {
if (index("wds",d[1]))
weight += 100;
weight += 100;
break;
case '-':
- if (lastuchar < d[1] || d[1] == '\\') {
- if (index("aA01! ",lastuchar))
+ if (last_un_char < d[1] || d[1] == '\\') {
+ if (index("aA01! ",last_un_char))
weight += 30;
if (index("zZ79~",d[1]))
weight += 30;
weight -= 150;
d = bufptr;
}
- if (uchar == lastuchar + 1)
+ if (un_char == last_un_char + 1)
weight += 5;
- weight -= seen[uchar];
+ weight -= seen[un_char];
break;
}
- seen[uchar]++;
+ seen[un_char]++;
}
#ifdef DEBUGGING
if (debug & 512)
projects / p5sagit/p5-mst-13.2.git / blobdiff