lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (03/02/90)
System: perl version 3.0 Patch #: 12 Priority: HIGH Subject: patch #9, continued Description: See patch #9. Fix: From rn, say "| patch -p -N -d DIR", where DIR is your perl source directory. Outside of rn, say "cd DIR; patch -p -N <thisarticle". If you don't have the patch program, apply the following by hand, or get patch (version 2.0, latest patchlevel). After patching: rm config.sh (on Mips cpus running Ultrix) Configure -d make depend make make test make install If patch indicates that patchlevel is the wrong version, you may need to apply one or more previous patches, or the patch may already have been applied. See the patchlevel.h file to find out what has or has not been applied. In any event, don't continue with the patch. If you are missing previous patches they can be obtained from me: Larry Wall lwall@jpl-devvax.jpl.nasa.gov If you send a mail message of the following form it will greatly speed processing: Subject: Command @SH mailpatch PATH perl 3.0 LIST ^ note the c where PATH is a return path FROM ME TO YOU either in Internet notation, or in bang notation from some well-known host, and LIST is the number of one or more patches you need, separated by spaces, commas, and/or hyphens. Saying 35- says everything from 35 to the end. You can also get the patches via anonymous FTP from jpl-devvax.jpl.nasa.gov (128.149.1.143). Index: patchlevel.h Prereq: 11 1c1 < #define PATCHLEVEL 11 --- > #define PATCHLEVEL 12 Index: eg/relink *** eg/relink.old Thu Mar 1 10:50:45 1990 --- eg/relink Thu Mar 1 10:50:47 1990 *************** *** 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); + } + } Index: eg/rename *** eg/rename.old Thu Mar 1 10:50:41 1990 --- eg/rename Thu Mar 1 10:50:42 1990 *************** *** 1,9 **** #!/usr/bin/perl ($op = shift) || die "Usage: rename perlexpr [filenames]\n"; ! if ($#ARGV < 0) { ! @ARGV = <stdin>; ! chop(@ARGV); } for (@ARGV) { $was = $_; --- 1,14 ---- #!/usr/bin/perl ($op = shift) || die "Usage: rename perlexpr [filenames]\n"; ! if (!@ARGV) { ! if (-t) { ! @ARGV = <*>; ! } ! else { ! @ARGV = <STDIN>; ! chop(@ARGV); ! } } for (@ARGV) { $was = $_; Index: x2p/s2p.SH Prereq: 3.0.1.2 *** x2p/s2p.SH.old Thu Mar 1 10:56:24 1990 --- x2p/s2p.SH Thu Mar 1 10:56:26 1990 *************** *** 28,36 **** : 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 $ # # $Log: s2p.SH,v $ # 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 --- 28,39 ---- : In the following dollars and backticks do not need the extra backslash. $spitshell >>s2p <<'!NO!SUBS!' ! # $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,431 **** --- 429,437 ---- $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,613 **** s/(.)//; $ch = $1; $delim = '' if $ch =~ /^[(){}\w]$/; ! $delim .= $1; } elsif ($delim eq '[') { $inbracket = 1; --- 613,620 ---- s/(.)//; $ch = $1; $delim = '' if $ch =~ /^[(){}\w]$/; ! $ch = 'b' if $ch =~ /^[<>]$/; ! $delim .= $ch; } elsif ($delim eq '[') { $inbracket = 1; Index: stab.c Prereq: 3.0.1.3 *** stab.c.old Thu Mar 1 10:54:18 1990 --- stab.c Thu Mar 1 10:54:21 1990 *************** *** 1,4 **** ! /* $Header: stab.c,v 3.0.1.3 89/12/21 20:18:40 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: stab.c,v 3.0.1.4 90/02/28 18:19:14 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,18 ---- * 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,56 **** return stab_val(stab); switch (*stab->str_magic->str_ptr) { ! case '0': 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)); --- 57,63 ---- return stab_val(stab); switch (*stab->str_magic->str_ptr) { ! 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,136 **** break; #endif case '/': ! *tokenbuf = record_separator; ! tokenbuf[1] = '\0'; ! str_nset(stab_val(stab),tokenbuf,rslen); break; case '[': str_numset(stab_val(stab),(double)arybase); --- 135,145 ---- break; #endif case '/': ! 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,234 **** break; case '*': s = str_get(str); ! if (strnNE(s,"Stab",4) || str->str_cur != sizeof(STBP)) { if (!*s) { STBP *stbp; --- 237,243 ---- break; case '*': s = str_get(str); ! if (strNE(s,"StB") || str->str_cur != sizeof(STBP)) { if (!*s) { STBP *stbp; *************** *** 239,245 **** stab->str_ptr = stbp; stab->str_len = stab->str_cur = sizeof(STBP); stab->str_pok = 1; ! strncpy(stab_magic(stab),"Stab",4); stab_val(stab) = Str_new(70,0); stab_line(stab) = line; } --- 248,254 ---- stab->str_ptr = stbp; stab->str_len = stab->str_cur = sizeof(STBP); stab->str_pok = 1; ! strcpy(stab_magic(stab),"StB"); stab_val(stab) = Str_new(70,0); stab_line(stab) = line; } *************** *** 264,269 **** --- 273,282 ---- 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,303 **** multiline = (i != 0); break; case '/': ! record_separator = *str_get(str); ! rslen = str->str_cur; break; case '\\': if (ors) --- 309,322 ---- multiline = (i != 0); break; case '/': ! 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,594 **** stab->str_ptr = stbp; stab->str_len = stab->str_cur = sizeof(STBP); stab->str_pok = 1; ! strncpy(stab_magic(stab),"Stab",4); stab_val(stab) = Str_new(72,0); stab_line(stab) = line; str_magic(stab,stab,'*',name,len); --- 607,613 ---- stab->str_ptr = stbp; stab->str_len = stab->str_cur = sizeof(STBP); stab->str_pok = 1; ! strcpy(stab_magic(stab),"StB"); stab_val(stab) = Str_new(72,0); stab_line(stab) = line; str_magic(stab,stab,'*',name,len); *************** *** 661,663 **** --- 680,705 ---- 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 */ Index: str.c Prereq: 3.0.1.4 *** str.c.old Thu Mar 1 10:54:32 1990 --- str.c Thu Mar 1 10:54:36 1990 *************** *** 1,4 **** ! /* $Header: str.c,v 3.0.1.4 89/12/21 20:21:35 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: str.c,v 3.0.1.5 90/02/28 18:30:38 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,12 **** * as specified in the README file that comes with the perl 3.0 kit. * * $Log: str.c,v $ ! * 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 * --- 6,21 ---- * 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,135 **** --- 138,152 ---- 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,149 **** --- 161,170 ---- #endif /*scs*/ errno = olderrno; while (*s) s++; + #ifdef hcx + if (s[-1] == '.') + s--; + #endif } else { if (str == &str_undef) *************** *** 150,156 **** --- 171,181 ---- 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,199 **** --- 219,226 ---- #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,212 **** else if (sstr->str_cur == sizeof(STBP)) { char *tmps = sstr->str_ptr; ! if (*tmps == 'S' && bcmp(tmps,"Stab",4) == 0) { dstr->str_magic = str_smake(sstr->str_magic); dstr->str_magic->str_rare = 'X'; } --- 233,239 ---- else if (sstr->str_cur == sizeof(STBP)) { char *tmps = sstr->str_ptr; ! if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) { dstr->str_magic = str_smake(sstr->str_magic); dstr->str_magic->str_rare = 'X'; } *************** *** 642,648 **** 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) */ int i; int bpx; int obpx; --- 669,675 ---- 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 int newline = record_separator;/* (assuming >= 6 registers) */ int i; int bpx; int obpx; *************** *** 742,756 **** register ARG *arg; line_t oldline = line; int retval; str_sset(linestr,str); in_eval++; oldoldbufptr = oldbufptr = bufptr = str_get(linestr); bufend = bufptr + linestr->str_cur; ! if (setjmp(eval_env)) { ! in_eval = 0; fatal("%s\n",stab_val(stabent("@",TRUE))->str_ptr); } error_count = 0; retval = yyparse(); in_eval--; --- 769,804 ---- 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 (++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,813 **** s+1 < send) { str_ncat(str,t,s-t); t = s; ! if (*s == '$' && s[1] == '#' && isalpha(s[2]) || s[2] == '_') s++; s = scanreg(s,send,tokenbuf); if (*t == '@' && ! (!(stab = stabent(tokenbuf,FALSE)) || !stab_xarray(stab)) ) { str_ncat(str,"@",1); s = ++t; continue; /* grandfather @ from old scripts */ --- 851,862 ---- s+1 < send) { str_ncat(str,t,s-t); t = s; ! if (*s == '$' && s[1] == '#' && (isalpha(s[2]) || s[2] == '_')) s++; s = scanreg(s,send,tokenbuf); if (*t == '@' && ! (!(stab = stabent(tokenbuf,FALSE)) || ! (*s == '{' ? !stab_xhash(stab) : !stab_xarray(stab)) )) { str_ncat(str,"@",1); s = ++t; continue; /* grandfather @ from old scripts */ *************** *** 821,830 **** checkpoint = s; do { switch (*s) { ! case '[': case '{': brackets++; break; ! case ']': case '}': brackets--; break; case '\'': --- 870,887 ---- checkpoint = s; do { switch (*s) { ! case '[': ! if (s[-1] != '$') ! brackets++; ! break; ! case '{': brackets++; break; ! case ']': ! if (s[-1] != '$') ! brackets--; ! break; ! case '}': brackets--; break; case '\'': Index: lib/termcap.pl Prereq: 3.0 *** lib/termcap.pl.old Thu Mar 1 10:52:11 1990 --- lib/termcap.pl Thu Mar 1 10:52:12 1990 *************** *** 1,13 **** ! ;# $Header: termcap.pl,v 3.0 89/10/18 15:19:58 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'); ;# sub Tgetent { local($TERM) = @_; --- 1,13 ---- ! ;# $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' || 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,53 **** \$entry .= \$_; "; eval $loop; ! } while s/:tc=([^:]+):/:/, $TERM = $1; $TERMCAP = $entry; } --- 47,53 ---- \$entry .= \$_; "; eval $loop; ! } while s/:tc=([^:]+):/:/ && ($TERM = $1); $TERMCAP = $entry; } *************** *** 70,76 **** s/\\f/\f/g; s/\\\^/\377/g; s/\^\?/\177/g; ! s/\^(.)/pack('c',$1 & 031)/eg; s/\\(.)/$1/g; s/\377/^/g; $TC{$entry} = $_ if $TC{$entry} eq ''; --- 70,76 ---- s/\\f/\f/g; s/\\\^/\377/g; s/\^\?/\177/g; ! s/\^(.)/pack('c',$1 & 31)/eg; s/\\(.)/$1/g; s/\377/^/g; $TC{$entry} = $_ if $TC{$entry} eq ''; *************** *** 104,110 **** local($result) = ''; local($after) = ''; local($code,$tmp) = @_; ! @_ = ($tmp,$code); local($online) = 0; while ($string =~ /^([^%]*)%(.)(.*)/) { $result .= $1; --- 104,111 ---- local($result) = ''; local($after) = ''; local($code,$tmp) = @_; ! local(@tmp); ! @tmp = ($tmp,$code); local($online) = 0; while ($string =~ /^([^%]*)%(.)(.*)/) { $result .= $1; *************** *** 111,120 **** $code = $2; $string = $3; if ($code eq 'd') { ! $result .= sprintf("%d",shift(@_)); } elsif ($code eq '.') { ! $tmp = shift(@_); if ($tmp == 0 || $tmp == 4 || $tmp == 10) { if ($online) { ++$tmp, $after .= $TC{'up'} if $TC{'up'}; --- 112,121 ---- $code = $2; $string = $3; if ($code eq 'd') { ! $result .= sprintf("%d",shift(@tmp)); } elsif ($code eq '.') { ! $tmp = shift(@tmp); if ($tmp == 0 || $tmp == 4 || $tmp == 10) { if ($online) { ++$tmp, $after .= $TC{'up'} if $TC{'up'}; *************** *** 127,158 **** $online = !$online; } elsif ($code eq '+') { ! $result .= sprintf("%c",shift(@_)+ord($string)); $string = substr($string,1,99); $online = !$online; } elsif ($code eq 'r') { ! ($code,$tmp) = @_; ! @_ = ($tmp,$code); $online = !$online; } elsif ($code eq '>') { ($code,$tmp,$string) = unpack("CCa99",$string); ! if ($_[$[] > $code) { ! $_[$[] += $tmp; } } elsif ($code eq '2') { ! $result .= sprintf("%02d",shift(@_)); $online = !$online; } elsif ($code eq '3') { ! $result .= sprintf("%03d",shift(@_)); $online = !$online; } elsif ($code eq 'i') { ! ($code,$tmp) = @_; ! @_ = ($code+1,$tmp+1); } else { return "OOPS"; --- 128,159 ---- $online = !$online; } elsif ($code eq '+') { ! $result .= sprintf("%c",shift(@tmp)+ord($string)); $string = substr($string,1,99); $online = !$online; } elsif ($code eq 'r') { ! ($code,$tmp) = @tmp; ! @tmp = ($tmp,$code); $online = !$online; } elsif ($code eq '>') { ($code,$tmp,$string) = unpack("CCa99",$string); ! if ($tmp[$[] > $code) { ! $tmp[$[] += $tmp; } } elsif ($code eq '2') { ! $result .= sprintf("%02d",shift(@tmp)); $online = !$online; } elsif ($code eq '3') { ! $result .= sprintf("%03d",shift(@tmp)); $online = !$online; } elsif ($code eq 'i') { ! ($code,$tmp) = @tmp; ! @tmp = ($code+1,$tmp+1); } else { return "OOPS"; Index: toke.c Prereq: 3.0.1.4 *** toke.c.old Thu Mar 1 10:55:22 1990 --- toke.c Thu Mar 1 10:55:28 1990 *************** *** 1,4 **** ! /* $Header: toke.c,v 3.0.1.4 89/12/21 20:26:56 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: toke.c,v 3.0.1.5 90/02/28 18:47:06 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,18 ---- * 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,83 **** --- 85,92 ---- #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,177 **** if (minus_n || minus_p || perldb) { str_set(linestr,""); if (perldb) ! str_cat(linestr,"do 'perldb.pl'; print $@;"); if (minus_n || minus_p) { str_cat(linestr,"line: while (<>) {"); if (minus_a) --- 180,187 ---- if (minus_n || minus_p || perldb) { str_set(linestr,""); if (perldb) ! 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,233 **** } #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; } goto retry; case ' ': case '\t': case '\f': --- 232,273 ---- } #endif bufend = linestr->str_ptr + linestr->str_cur; ! 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,526 **** LFUN(O_CHOP); if (strEQ(d,"continue")) OPERATOR(CONTINUE); ! if (strEQ(d,"chdir")) UNI(O_CHDIR); if (strEQ(d,"close")) FOP(O_CLOSE); if (strEQ(d,"closedir")) --- 559,568 ---- LFUN(O_CHOP); if (strEQ(d,"continue")) OPERATOR(CONTINUE); ! 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,615 **** break; case 'f': case 'F': SNARFWORD; ! if (strEQ(d,"for")) OPERATOR(FOR); ! if (strEQ(d,"foreach")) ! OPERATOR(FOR); if (strEQ(d,"format")) { d = bufend; while (s < d && isspace(*s)) --- 648,657 ---- break; case 'f': case 'F': SNARFWORD; ! if (strEQ(d,"for") || strEQ(d,"foreach")) { ! yylval.ival = line; OPERATOR(FOR); ! } if (strEQ(d,"format")) { d = bufend; while (s < d && isspace(*s)) *************** *** 819,824 **** --- 861,868 ---- FL2(O_PACK); if (strEQ(d,"package")) OPERATOR(PACKAGE); + if (strEQ(d,"pipe")) + FOP22(O_PIPE); break; case 'q': case 'Q': SNARFWORD; *************** *** 834,840 **** case 'r': case 'R': SNARFWORD; if (strEQ(d,"return")) ! LOP(O_RETURN); if (strEQ(d,"reset")) UNI(O_RESET); if (strEQ(d,"redo")) --- 878,884 ---- case 'r': case 'R': SNARFWORD; if (strEQ(d,"return")) ! OLDLOP(O_RETURN); if (strEQ(d,"reset")) UNI(O_RESET); if (strEQ(d,"redo")) *************** *** 1483,1489 **** 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])) spat->spat_flags &= ~SPAT_CONST; } } --- 1527,1534 ---- 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]) || ! (t[1] == '{' /*}*/ && isdigit(t[2])) )) spat->spat_flags &= ~SPAT_CONST; } } *************** *** 1861,1867 **** term = tmps[5]; multi_close = term; } ! tmpstr = Str_new(87,0); if (hereis) { term = *tokenbuf; if (!rsfp) { --- 1906,1912 ---- term = tmps[5]; multi_close = term; } ! tmpstr = Str_new(87,80); if (hereis) { term = *tokenbuf; if (!rsfp) { *************** *** 1946,1952 **** if ((*s == '$' && s+1 < send && (alwaysdollar || /*(*/ (s[1] != ')' && s[1] != '|')) ) || (*s == '@' && s+1 < send) ) { ! len = scanreg(s,bufend,tokenbuf) - s; if (*s == '$' || strEQ(tokenbuf,"ARGV") || strEQ(tokenbuf,"ENV") || strEQ(tokenbuf,"SIG") --- 1991,1997 ---- if ((*s == '$' && s+1 < send && (alwaysdollar || /*(*/ (s[1] != ')' && s[1] != '|')) ) || (*s == '@' && s+1 < send) ) { ! len = scanreg(s,send,tokenbuf) - s; if (*s == '$' || strEQ(tokenbuf,"ARGV") || strEQ(tokenbuf,"ENV") || strEQ(tokenbuf,"SIG") Index: eg/travesty *** eg/travesty.old Thu Mar 1 10:50:51 1990 --- eg/travesty Thu Mar 1 10:50:53 1990 *************** *** 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; + } + } + } Index: util.c Prereq: 3.0.1.3 *** util.c.old Thu Mar 1 10:55:42 1990 --- util.c Thu Mar 1 10:55:47 1990 *************** *** 1,4 **** ! /* $Header: util.c,v 3.0.1.3 89/12/21 20:27:41 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: util.c,v 3.0.1.4 90/03/01 10:26:48 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,17 ---- * 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,485 **** #ifndef lint if (!(littlestr->str_pok & SP_FBM)) ! return instr((char*)big,littlestr->str_ptr); #endif littlelen = littlestr->str_cur; --- 485,492 ---- #ifndef lint if (!(littlestr->str_pok & SP_FBM)) ! return ninstr((char*)big,(char*)bigend, ! littlestr->str_ptr, littlestr->str_ptr + littlestr->str_cur); #endif littlelen = littlestr->str_cur; *************** *** 733,743 **** { extern FILE *e_fp; extern char *e_tmpname; mess(pat,a1,a2,a3,a4); if (in_eval) { str_set(stab_val(stabent("@",TRUE)),buf); ! longjmp(eval_env,1); } fputs(buf,stderr); (void)fflush(stderr); --- 740,772 ---- { 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); ! 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,814 **** --- 838,844 ---- va_list args; extern FILE *e_fp; extern char *e_tmpname; + char *tmps; #ifndef lint va_start(args); *************** *** 819,825 **** va_end(args); if (in_eval) { str_set(stab_val(stabent("@",TRUE)),buf); ! longjmp(eval_env,1); } fputs(buf,stderr); (void)fflush(stderr); --- 849,876 ---- va_end(args); if (in_eval) { str_set(stab_val(stabent("@",TRUE)),buf); ! 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,1117 **** --- 1163,1169 ---- } if (tmpstab = stabent("$",allstabs)) str_numset(STAB_STR(tmpstab),(double)getpid()); + forkprocess = 0; return Nullfp; #undef THIS #undef THAT *************** *** 1235,1237 **** --- 1287,1313 ---- 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; + } + } Index: x2p/walk.c Prereq: 3.0.1.3 *** x2p/walk.c.old Thu Mar 1 10:56:38 1990 --- x2p/walk.c Thu Mar 1 10:56:43 1990 *************** *** 1,4 **** ! /* $Header: walk.c,v 3.0.1.3 89/12/21 20:32:35 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: walk.c,v 3.0.1.4 90/03/01 10:32:45 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,14 ---- * 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,164 **** str_cat(str,"\n"); } if (exitval) ! str_cat(str,"exit ExitValue;\n"); if (subs->str_ptr) { str_cat(str,"\n"); str_scat(str,subs); --- 161,167 ---- str_cat(str,"\n"); } if (exitval) ! str_cat(str,"exit $ExitValue;\n"); if (subs->str_ptr) { str_cat(str,"\n"); str_scat(str,subs); *************** *** 1327,1333 **** } else { if (len == 1) { ! str_set(str,"ExitValue = "); exitval = TRUE; str_scat(str, fstr=walk(1,level,ops[node+1].ival,&numarg,P_ASSIGN)); --- 1330,1336 ---- } else { if (len == 1) { ! str_set(str,"$ExitValue = "); exitval = TRUE; str_scat(str, fstr=walk(1,level,ops[node+1].ival,&numarg,P_ASSIGN)); *** End of Patch 12 ***
tneff@bfmny0.UU.NET (Tom Neff) (03/03/90)
Some notes on upgrading from Perl 3.0.1.3 to 3.0.1.4 on AT&T System V/386 release 3.2: * Patch 2.0.1.5 (88/06/03, PL11) has trouble patching files with names like 't/op.subst'. It wanted to look in '.' instead of 't/' so failed to find the files. I had to type the names in by hand. But 't/Makefile.SH' erroneously matched './Makefile.SH' which was even more dangerous. (This is the version of Patch on UUNET. If Larry uses a newer one, how 'bout releasing it.) * Configure was smart and found my /lib/lPW.a, but this caused a symbol conflict with fatal() which is defined there as well as in util.c. I had to remove -lPW from the list of additional libraries to proceed. * After that everything proceeded OK. All tests passed. The purged executable (with DEBUGGING enabled) is about 234k versus 200k for 3.0.1.3. Presumably all good useful new code. :-) -- "NASA Awards Acronym Generation :(%( : Tom Neff System (AGS) Contract For Space : )%): tneff%bfmny@UUNET.UU.NET Station Freedom" - release 1989-9891 :(%( : ...!uunet!bfmny0!tneff
john@trigraph.uucp (John Chew) (03/06/90)
Problems encountered while upgrading from patch 8 to patch 12 of
Perl 3.0 under A/UX 1.1 using cc:
- The optimizer warns that some optimizations are lost due to table
overflow when compiling eval.c and toke.c. The generated code appears
to be correct even if presumably suboptimal :-).
- Because A/UX has a fake <dirent.h> which includes <sys/dir.h> and
#defines dirent to be direct, Configure gets confused. Editing
config.sh to set i_dirent=undef and d_dirnamlen=define works. This
problem was present in patch 8 as well.
- The function fatal() is defined in libPW.a and in util.o. Removing
-lPW from the list of libraries allows successful linkage.
John
--
john j. chew, iii phone: +1 416 425 3818 AppleLink: CDA0329
trigraph, inc., toronto, canada {uunet!utai!utcsri,utgpu,utzoo}!trigraph!john
dept. of math., u. of toronto poslfit@{utorgpu.bitnet,gpu.utcs.utoronto.ca}tneff@bfmny0.UU.NET (Tom Neff) (03/06/90)
In article <1990Mar5.200203.25581@trigraph.uucp> "John J. Chew" <poslfit@gpu.UTCS.UToronto.CA> writes: >Problems encountered while upgrading from patch 8 to patch 12 of >Perl 3.0 under A/UX 1.1 using cc: > >- The optimizer warns that some optimizations are lost due to table > overflow when compiling eval.c and toke.c. The generated code appears > to be correct even if presumably suboptimal :-). This also happens on V/386 3.2, but I didn't report it because it's happened on every version of Perl I've ever built. (Actually I just get it on eval.c now that I think of it.) I suppose it would be nice to cut the label count down. May not be possible though... -- If the human mind were simple enough to understand, =)) Tom Neff we'd be too simple to understand it. -- Pat Bahn ((= tneff@bfmny0.UU.NET
nazgul@alphalpha.com (Kee Hinckley) (03/08/90)
In article <15233@bfmny0.UU.NET> tneff@bfmny0.UU.NET (Tom Neff) writes: >In article <1990Mar5.200203.25581@trigraph.uucp> "John J. Chew" <poslfit@gpu.UTCS.UToronto.CA> writes: >>Problems encountered while upgrading from patch 8 to patch 12 of >>Perl 3.0 under A/UX 1.1 using cc: >> >>- The optimizer warns that some optimizations are lost due to table >> overflow when compiling eval.c and toke.c. The generated code appears >> to be correct even if presumably suboptimal :-). Ah, I'm glad I'm not the only one who had problems with that. The Apollo compiler is quite dogged about never letting a possible optimization escape its grasp. No giving up for it! Instead it simply took an hour to compile the file! -kee -- +-----------------------------------------------------------------------------+ | Alphalpha Software, Inc. | Voice/Fax: 617/646-7703 | Home: 617/641-3805 | | 148 Scituate St. | Smart fax, dial number. | | | Arlington, MA 02174 | Dumb fax, dial number, | BBS: 617/641-3722 |