diff options
| -rw-r--r-- | eg/relink | 24 | ||||
| -rw-r--r-- | eg/rename | 11 | ||||
| -rw-r--r-- | eg/travesty | 46 | ||||
| -rw-r--r-- | lib/termcap.pl | 39 | ||||
| -rw-r--r-- | patchlevel.h | 2 | ||||
| -rw-r--r-- | stab.c | 62 | ||||
| -rw-r--r-- | str.c | 75 | ||||
| -rw-r--r-- | toke.c | 77 | ||||
| -rw-r--r-- | util.c | 84 | ||||
| -rw-r--r-- | x2p/s2p.SH | 11 | ||||
| -rw-r--r-- | x2p/walk.c | 9 |
11 files changed, 373 insertions, 67 deletions
diff --git a/eg/relink b/eg/relink new file mode 100644 index 0000000000..2d8e5f6540 --- /dev/null +++ b/eg/relink @@ -0,0 +1,24 @@ +#!/usr/bin/perl + +($op = shift) || die "Usage: relink perlexpr [filenames]\n"; +if (!@ARGV) { + if (-t) { + @ARGV = <*>; + } + else { + @ARGV = <STDIN>; + chop(@ARGV); + } +} +for (@ARGV) { + next unless -l; # symbolic link? + $name = $_; + $_ = readlink($_); + $was = $_; + eval $op; + die $@ if $@; + if ($was ne $_) { + unlink($name); + symlink($_, $name); + } +} @@ -1,9 +1,14 @@ #!/usr/bin/perl ($op = shift) || die "Usage: rename perlexpr [filenames]\n"; -if ($#ARGV < 0) { - @ARGV = <stdin>; - chop(@ARGV); +if (!@ARGV) { + if (-t) { + @ARGV = <*>; + } + else { + @ARGV = <STDIN>; + chop(@ARGV); + } } for (@ARGV) { $was = $_; diff --git a/eg/travesty b/eg/travesty new file mode 100644 index 0000000000..7e6f983c7c --- /dev/null +++ b/eg/travesty @@ -0,0 +1,46 @@ +#!/usr/bin/perl + +while (<>) { + next if /^\./; + next if /^From / .. /^$/; + next if /^Path: / .. /^$/; + s/^\W+//; + push(@ary,split(' ')); + while ($#ary > 1) { + $a = $p; + $p = $n; + $w = shift(@ary); + $n = $num{$w}; + if ($n eq '') { + push(@word,$w); + $n = pack('S',$#word); + $num{$w} = $n; + } + $lookup{$a . $p} .= $n; + } +} + +for (;;) { + $n = $lookup{$a . $p}; + ($foo,$n) = each(lookup) if $n eq ''; + $n = substr($n,int(rand(length($n))) & 0177776,2); + $a = $p; + $p = $n; + ($w) = unpack('S',$n); + $w = $word[$w]; + $col += length($w) + 1; + if ($col >= 65) { + $col = 0; + print "\n"; + } + else { + print ' '; + } + print $w; + if ($w =~ /\.$/) { + if (rand() < .1) { + print "\n"; + $col = 80; + } + } +} diff --git a/lib/termcap.pl b/lib/termcap.pl index ab693f28d7..a92b71456c 100644 --- a/lib/termcap.pl +++ b/lib/termcap.pl @@ -1,13 +1,13 @@ -;# $Header: termcap.pl,v 3.0 89/10/18 15:19:58 lwall Locked $ +;# $Header: termcap.pl,v 3.0.1.1 90/02/28 17:46:44 lwall Locked $ ;# ;# Usage: ;# do 'ioctl.pl'; ;# ioctl(TTY,$TIOCGETP,$foo); ;# ($ispeed,$ospeed) = unpack('cc',$foo); -;# do 'termcap.pl'; -;# do Tgetent('vt100'); # sets $TC{'cm'}, etc. -;# do Tgoto($TC{'cm'},$row,$col); -;# do Tputs($TC{'dl'},$affcnt,'FILEHANDLE'); +;# do 'termcap.pl' || die "Can't get termcap.pl"; +;# &Tgetent('vt100'); # sets $TC{'cm'}, etc. +;# &Tputs(&Tgoto($TC{'cm'},$col,$row), 0, 'FILEHANDLE'); +;# &Tputs($TC{'dl'},$affcnt,'FILEHANDLE'); ;# sub Tgetent { local($TERM) = @_; @@ -47,7 +47,7 @@ sub Tgetent { \$entry .= \$_; "; eval $loop; - } while s/:tc=([^:]+):/:/, $TERM = $1; + } while s/:tc=([^:]+):/:/ && ($TERM = $1); $TERMCAP = $entry; } @@ -70,7 +70,7 @@ sub Tgetent { s/\\f/\f/g; s/\\\^/\377/g; s/\^\?/\177/g; - s/\^(.)/pack('c',$1 & 031)/eg; + s/\^(.)/pack('c',$1 & 31)/eg; s/\\(.)/$1/g; s/\377/^/g; $TC{$entry} = $_ if $TC{$entry} eq ''; @@ -104,17 +104,18 @@ sub Tgoto { local($result) = ''; local($after) = ''; local($code,$tmp) = @_; - @_ = ($tmp,$code); + local(@tmp); + @tmp = ($tmp,$code); local($online) = 0; while ($string =~ /^([^%]*)%(.)(.*)/) { $result .= $1; $code = $2; $string = $3; if ($code eq 'd') { - $result .= sprintf("%d",shift(@_)); + $result .= sprintf("%d",shift(@tmp)); } elsif ($code eq '.') { - $tmp = shift(@_); + $tmp = shift(@tmp); if ($tmp == 0 || $tmp == 4 || $tmp == 10) { if ($online) { ++$tmp, $after .= $TC{'up'} if $TC{'up'}; @@ -127,32 +128,32 @@ sub Tgoto { $online = !$online; } elsif ($code eq '+') { - $result .= sprintf("%c",shift(@_)+ord($string)); + $result .= sprintf("%c",shift(@tmp)+ord($string)); $string = substr($string,1,99); $online = !$online; } elsif ($code eq 'r') { - ($code,$tmp) = @_; - @_ = ($tmp,$code); + ($code,$tmp) = @tmp; + @tmp = ($tmp,$code); $online = !$online; } elsif ($code eq '>') { ($code,$tmp,$string) = unpack("CCa99",$string); - if ($_[$[] > $code) { - $_[$[] += $tmp; + if ($tmp[$[] > $code) { + $tmp[$[] += $tmp; } } elsif ($code eq '2') { - $result .= sprintf("%02d",shift(@_)); + $result .= sprintf("%02d",shift(@tmp)); $online = !$online; } elsif ($code eq '3') { - $result .= sprintf("%03d",shift(@_)); + $result .= sprintf("%03d",shift(@tmp)); $online = !$online; } elsif ($code eq 'i') { - ($code,$tmp) = @_; - @_ = ($code+1,$tmp+1); + ($code,$tmp) = @tmp; + @tmp = ($code+1,$tmp+1); } else { return "OOPS"; diff --git a/patchlevel.h b/patchlevel.h index 98702f8e84..bc5f1c8250 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1 +1 @@ -#define PATCHLEVEL 11 +#define PATCHLEVEL 12 @@ -1,4 +1,4 @@ -/* $Header: stab.c,v 3.0.1.3 89/12/21 20:18:40 lwall Locked $ +/* $Header: stab.c,v 3.0.1.4 90/02/28 18:19:14 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,13 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: stab.c,v $ + * Revision 3.0.1.4 90/02/28 18:19:14 lwall + * patch9: $0 is now always the command name + * patch9: you may now undef $/ to have no input record separator + * patch9: local($.) didn't work + * patch9: sometimes perl thought ordinary data was a symbol table entry + * patch9: stab_array() and stab_hash() weren't defined on MICROPORT + * * Revision 3.0.1.3 89/12/21 20:18:40 lwall * patch7: ANSI strerror() is now supported * patch7: errno may now be a macro with an lvalue @@ -50,7 +57,7 @@ STR *str; return stab_val(stab); switch (*stab->str_magic->str_ptr) { - case '0': case '1': case '2': case '3': case '4': + case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': case '&': if (curspat) { paren = atoi(stab_name(stab)); @@ -128,9 +135,11 @@ STR *str; break; #endif case '/': - *tokenbuf = record_separator; - tokenbuf[1] = '\0'; - str_nset(stab_val(stab),tokenbuf,rslen); + if (record_separator != 12345) { + *tokenbuf = record_separator; + tokenbuf[1] = '\0'; + str_nset(stab_val(stab),tokenbuf,rslen); + } break; case '[': str_numset(stab_val(stab),(double)arybase); @@ -228,7 +237,7 @@ STR *str; break; case '*': s = str_get(str); - if (strnNE(s,"Stab",4) || str->str_cur != sizeof(STBP)) { + if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) { if (!*s) { STBP *stbp; @@ -239,7 +248,7 @@ STR *str; stab->str_ptr = stbp; stab->str_len = stab->str_cur = sizeof(STBP); stab->str_pok = 1; - strncpy(stab_magic(stab),"Stab",4); + strcpy(stab_magic(stab),"StB"); stab_val(stab) = Str_new(70,0); stab_line(stab) = line; } @@ -264,6 +273,10 @@ STR *str; case 0: switch (*stab->str_magic->str_ptr) { + case '.': + if (localizing) + savesptr((STR**)&last_in_stab); + break; case '^': Safefree(stab_io(curoutstab)->top_name); stab_io(curoutstab)->top_name = s = savestr(str_get(str)); @@ -296,8 +309,14 @@ STR *str; multiline = (i != 0); break; case '/': - record_separator = *str_get(str); - rslen = str->str_cur; + if (str->str_ptr) { + record_separator = *str_get(str); + rslen = str->str_cur; + } + else { + record_separator = 12345; /* fake a non-existent char */ + rslen = 1; + } break; case '\\': if (ors) @@ -588,7 +607,7 @@ int add; stab->str_ptr = stbp; stab->str_len = stab->str_cur = sizeof(STBP); stab->str_pok = 1; - strncpy(stab_magic(stab),"Stab",4); + strcpy(stab_magic(stab),"StB"); stab_val(stab) = Str_new(72,0); stab_line(stab) = line; str_magic(stab,stab,'*',name,len); @@ -661,3 +680,26 @@ register STAB *stab; stab->str_cur = 0; } +#if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286)) +#define MICROPORT +#endif + +#ifdef MICROPORT /* Microport 2.4 hack */ +ARRAY *stab_array(stab) +register STAB *stab; +{ + if (((STBP*)(stab->str_ptr))->stbp_array) + return ((STBP*)(stab->str_ptr))->stbp_array; + else + return ((STBP*)(aadd(stab)->str_ptr))->stbp_array; +} + +HASH *stab_hash(stab) +register STAB *stab; +{ + if (((STBP*)(stab->str_ptr))->stbp_hash) + return ((STBP*)(stab->str_ptr))->stbp_hash; + else + return ((STBP*)(hadd(stab)->str_ptr))->stbp_hash; +} +#endif /* Microport 2.4 hack */ @@ -1,4 +1,4 @@ -/* $Header: str.c,v 3.0.1.4 89/12/21 20:21:35 lwall Locked $ +/* $Header: str.c,v 3.0.1.5 90/02/28 18:30:38 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,15 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: str.c,v $ + * 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 @@ -129,7 +138,15 @@ 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) @@ -144,13 +161,21 @@ register STR *str; #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'; @@ -194,6 +219,8 @@ register STR *sstr; #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) { @@ -206,7 +233,7 @@ register STR *sstr; 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'; } @@ -642,7 +669,7 @@ int append; 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; @@ -742,15 +769,36 @@ STR *str; 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--; @@ -803,11 +851,12 @@ STR *src; 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 */ @@ -821,10 +870,18 @@ STR *src; 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 '\'': @@ -1,4 +1,4 @@ -/* $Header: toke.c,v 3.0.1.4 89/12/21 20:26:56 lwall Locked $ +/* $Header: toke.c,v 3.0.1.5 90/02/28 18:47:06 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,13 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: toke.c,v $ + * Revision 3.0.1.5 90/02/28 18:47:06 lwall + * patch9: return grandfathered to never be function call + * patch9: non-existent perldb.pl now gives reasonable error message + * patch9: perl can now start up other interpreters scripts + * patch9: line numbers were bogus during certain portions of foreach evaluation + * patch9: null hereis core dumped + * * Revision 3.0.1.4 89/12/21 20:26:56 lwall * patch7: -d switch incompatible with -p or -n * patch7: " ''$foo'' " didn't parse right @@ -78,6 +85,8 @@ char *reparse; /* if non-null, scanreg found ${foo[$bar]} */ #define LOP(f) return(*s == '(' || (s = skipspace(s), *s == '(') ? \ (*s = META('('), bufptr = oldbufptr, '(') : \ (yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP)) +/* grandfather return to old style */ +#define OLDLOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP) char * skipspace(s) @@ -171,7 +180,8 @@ yylex() if (minus_n || minus_p || perldb) { str_set(linestr,""); if (perldb) - str_cat(linestr,"do 'perldb.pl'; print $@;"); + str_cat(linestr, +"do 'perldb.pl' || die \"Can't find perldb.pl in @INC\"; print $@;"); if (minus_n || minus_p) { str_cat(linestr,"line: while (<>) {"); if (minus_a) @@ -222,12 +232,42 @@ yylex() } #endif bufend = linestr->str_ptr + linestr->str_cur; - if (firstline) { - while (s < bufend && isspace(*s)) - s++; - if (*s == ':') /* for csh's that have to exec sh scripts */ - s++; - firstline = FALSE; + if (line == 1) { + if (*s == '#' && s[1] == '!') { + if (!in_eval && !instr(s,"perl") && instr(origargv[0],"perl")) { + char **newargv; + char *cmd; + + s += 2; + if (*s == ' ') + s++; + cmd = s; + while (s < bufend && !isspace(*s)) + s++; + *s++ = '\0'; + while (s < bufend && isspace(*s)) + s++; + if (s < bufend) { + Newz(899,newargv,origargc+3,char*); + newargv[1] = s; + while (s < bufend && !isspace(*s)) + s++; + *s = '\0'; + Copy(origargv+1, newargv+2, origargc+1, char*); + } + else + newargv = origargv; + newargv[0] = cmd; + execv(cmd,newargv); + fatal("Can't exec %s", cmd); + } + } + else { + while (s < bufend && isspace(*s)) + s++; + if (*s == ':') /* for csh's that have to exec sh scripts */ + s++; + } } goto retry; case ' ': case '\t': case '\f': @@ -519,8 +559,10 @@ yylex() LFUN(O_CHOP); if (strEQ(d,"continue")) OPERATOR(CONTINUE); - if (strEQ(d,"chdir")) + if (strEQ(d,"chdir")) { + (void)stabent("ENV",TRUE); /* may use HOME */ UNI(O_CHDIR); + } if (strEQ(d,"close")) FOP(O_CLOSE); if (strEQ(d,"closedir")) @@ -606,10 +648,10 @@ yylex() break; case 'f': case 'F': SNARFWORD; - if (strEQ(d,"for")) - OPERATOR(FOR); - if (strEQ(d,"foreach")) + if (strEQ(d,"for") || strEQ(d,"foreach")) { + yylval.ival = line; OPERATOR(FOR); + } if (strEQ(d,"format")) { d = bufend; while (s < d && isspace(*s)) @@ -819,6 +861,8 @@ yylex() FL2(O_PACK); if (strEQ(d,"package")) OPERATOR(PACKAGE); + if (strEQ(d,"pipe")) + FOP22(O_PIPE); break; case 'q': case 'Q': SNARFWORD; @@ -834,7 +878,7 @@ yylex() case 'r': case 'R': SNARFWORD; if (strEQ(d,"return")) - LOP(O_RETURN); + OLDLOP(O_RETURN); if (strEQ(d,"reset")) UNI(O_RESET); if (strEQ(d,"redo")) @@ -1483,7 +1527,8 @@ get_repl: tmpstr = spat->spat_repl[1].arg_ptr.arg_str; e = tmpstr->str_ptr + tmpstr->str_cur; for (t = tmpstr->str_ptr; t < e; t++) { - if (*t == '$' && t[1] && index("`'&+0123456789",t[1])) + if (*t == '$' && t[1] && (index("`'&+0123456789",t[1]) || + (t[1] == '{' /*}*/ && isdigit(t[2])) )) spat->spat_flags &= ~SPAT_CONST; } } @@ -1861,7 +1906,7 @@ register char *s; term = tmps[5]; multi_close = term; } - tmpstr = Str_new(87,0); + tmpstr = Str_new(87,80); if (hereis) { term = *tokenbuf; if (!rsfp) { @@ -1946,7 +1991,7 @@ register char *s; if ((*s == '$' && s+1 < send && (alwaysdollar || /*(*/ (s[1] != ')' && s[1] != '|')) ) || (*s == '@' && s+1 < send) ) { - len = scanreg(s,bufend,tokenbuf) - s; + len = scanreg(s,send,tokenbuf) - s; if (*s == '$' || strEQ(tokenbuf,"ARGV") || strEQ(tokenbuf,"ENV") || strEQ(tokenbuf,"SIG") @@ -1,4 +1,4 @@ -/* $Header: util.c,v 3.0.1.3 89/12/21 20:27:41 lwall Locked $ +/* $Header: util.c,v 3.0.1.4 90/03/01 10:26:48 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,12 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: util.c,v $ + * Revision 3.0.1.4 90/03/01 10:26:48 lwall + * patch9: fbminstr() called instr() rather than ninstr() + * patch9: nested evals clobbered their longjmp environment + * patch9: piped opens returned undefined rather than 0 in child + * patch9: the x operator is now up to 10 times faster + * * Revision 3.0.1.3 89/12/21 20:27:41 lwall * patch7: errno may now be a macro with an lvalue * @@ -479,7 +485,8 @@ STR *littlestr; #ifndef lint if (!(littlestr->str_pok & SP_FBM)) - return instr((char*)big,littlestr->str_ptr); + return ninstr((char*)big,(char*)bigend, + littlestr->str_ptr, littlestr->str_ptr + littlestr->str_cur); #endif littlelen = littlestr->str_cur; @@ -733,11 +740,33 @@ long a1, a2, a3, a4; { extern FILE *e_fp; extern char *e_tmpname; + char *tmps; mess(pat,a1,a2,a3,a4); if (in_eval) { str_set(stab_val(stabent("@",TRUE)),buf); - longjmp(eval_env,1); + tmps = "_EVAL_"; + while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label || + strNE(tmps,loop_stack[loop_ptr].loop_label) )) { +#ifdef DEBUGGING + if (debug & 4) { + deb("(Skipping label #%d %s)\n",loop_ptr, + loop_stack[loop_ptr].loop_label); + } +#endif + loop_ptr--; + } +#ifdef DEBUGGING + if (debug & 4) { + deb("(Found label #%d %s)\n",loop_ptr, + loop_stack[loop_ptr].loop_label); + } +#endif + if (loop_ptr < 0) { + in_eval = 0; + fatal("Bad label: %s", tmps); + } + longjmp(loop_stack[loop_ptr].loop_env, 1); } fputs(buf,stderr); (void)fflush(stderr); @@ -809,6 +838,7 @@ va_dcl va_list args; extern FILE *e_fp; extern char *e_tmpname; + char *tmps; #ifndef lint va_start(args); @@ -819,7 +849,28 @@ va_dcl va_end(args); if (in_eval) { str_set(stab_val(stabent("@",TRUE)),buf); - longjmp(eval_env,1); + tmps = "_EVAL_"; + while (loop_ptr >= 0 && (!loop_stack[loop_ptr].loop_label || + strNE(tmps,loop_stack[loop_ptr].loop_label) )) { +#ifdef DEBUGGING + if (debug & 4) { + deb("(Skipping label #%d %s)\n",loop_ptr, + loop_stack[loop_ptr].loop_label); + } +#endif + loop_ptr--; + } +#ifdef DEBUGGING + if (debug & 4) { + deb("(Found label #%d %s)\n",loop_ptr, + loop_stack[loop_ptr].loop_label); + } +#endif + if (loop_ptr < 0) { + in_eval = 0; + fatal("Bad label: %s", tmps); + } + longjmp(loop_stack[loop_ptr].loop_env, 1); } fputs(buf,stderr); (void)fflush(stderr); @@ -1112,6 +1163,7 @@ char *mode; } if (tmpstab = stabent("$",allstabs)) str_numset(STAB_STR(tmpstab),(double)getpid()); + forkprocess = 0; return Nullfp; #undef THIS #undef THAT @@ -1235,3 +1287,27 @@ register int len; return 0; } #endif /* MEMCMP */ + +void +repeatcpy(to,from,len,count) +register char *to; +register char *from; +int len; +register int count; +{ + register int todo; + register char *frombase = from; + + if (len == 1) { + todo = *from; + while (count-- > 0) + *to++ = todo; + return; + } + while (count-- > 0) { + for (todo = len; todo > 0; todo--) { + *to++ = *from++; + } + from = frombase; + } +} diff --git a/x2p/s2p.SH b/x2p/s2p.SH index fc85209d34..08230b02ec 100644 --- a/x2p/s2p.SH +++ b/x2p/s2p.SH @@ -28,9 +28,12 @@ $spitshell >s2p <<!GROK!THIS! : In the following dollars and backticks do not need the extra backslash. $spitshell >>s2p <<'!NO!SUBS!' -# $Header: s2p.SH,v 3.0.1.2 89/11/17 15:51:27 lwall Locked $ +# $Header: s2p.SH,v 3.0.1.3 90/03/01 10:31:21 lwall Locked $ # # $Log: s2p.SH,v $ +# Revision 3.0.1.3 90/03/01 10:31:21 lwall +# patch9: s2p didn't handle \< and \> +# # Revision 3.0.1.2 89/11/17 15:51:27 lwall # patch5: in s2p, line labels without a subsequent statement were done wrong # patch5: s2p left residue in /tmp @@ -426,6 +429,9 @@ ${space}next line;"; $len--; $_ = substr($_,0,$i) . substr($_,$i+1,10000); } + elsif (!$repl && substr($_,$i,1) =~ /^[<>]$/) { + substr($_,$i,1) = 'b'; + } } elsif ($c eq '[' && !$repl) { $i++ if substr($_,$i,1) eq '^'; @@ -607,7 +613,8 @@ sub fetchpat { s/(.)//; $ch = $1; $delim = '' if $ch =~ /^[(){}\w]$/; - $delim .= $1; + $ch = 'b' if $ch =~ /^[<>]$/; + $delim .= $ch; } elsif ($delim eq '[') { $inbracket = 1; diff --git a/x2p/walk.c b/x2p/walk.c index ca1214d488..58494c9d78 100644 --- a/x2p/walk.c +++ b/x2p/walk.c @@ -1,4 +1,4 @@ -/* $Header: walk.c,v 3.0.1.3 89/12/21 20:32:35 lwall Locked $ +/* $Header: walk.c,v 3.0.1.4 90/03/01 10:32:45 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: walk.c,v $ + * Revision 3.0.1.4 90/03/01 10:32:45 lwall + * patch9: a2p didn't put a $ on ExitValue + * * Revision 3.0.1.3 89/12/21 20:32:35 lwall * patch7: in a2p, user-defined functions didn't work on some machines * @@ -158,7 +161,7 @@ int minprec; /* minimum precedence without parens */ str_cat(str,"\n"); } if (exitval) - str_cat(str,"exit ExitValue;\n"); + str_cat(str,"exit $ExitValue;\n"); if (subs->str_ptr) { str_cat(str,"\n"); str_scat(str,subs); @@ -1327,7 +1330,7 @@ sub Pick {\n\ } else { if (len == 1) { - str_set(str,"ExitValue = "); + str_set(str,"$ExitValue = "); exitval = TRUE; str_scat(str, fstr=walk(1,level,ops[node+1].ival,&numarg,P_ASSIGN)); |