lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (11/10/90)
System: perl version 3.0 Patch #: 40 Priority: Subject: patch #38, continued Description: See patch #38. 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: 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: 39 1c1 < #define PATCHLEVEL 39 --- > #define PATCHLEVEL 40 Index: perl_man.3 Prereq: 3.0.1.10 *** perl_man.3.old Sat Nov 10 02:32:51 1990 --- perl_man.3 Sat Nov 10 02:33:00 1990 *************** *** 1,7 **** ''' Beginning of part 3 ! ''' $Header: perl_man.3,v 3.0.1.10 90/10/20 02:15:17 lwall Locked $ ''' ''' $Log: perl_man.3,v $ ''' Revision 3.0.1.10 90/10/20 02:15:17 lwall ''' patch37: patch37: fixed various typos in man page ''' --- 1,11 ---- ''' Beginning of part 3 ! ''' $Header: perl_man.3,v 3.0.1.11 90/11/10 01:48:21 lwall Locked $ ''' ''' $Log: perl_man.3,v $ + ''' Revision 3.0.1.11 90/11/10 01:48:21 lwall + ''' patch38: random cleanup + ''' patch38: documented tr///cds + ''' ''' Revision 3.0.1.10 90/10/20 02:15:17 lwall ''' patch37: patch37: fixed various typos in man page ''' *************** *** 298,304 **** count, padding with nulls or spaces as necessary. (When unpacking, "A" strips trailing spaces and nulls, but "a" does not.) ! Real numbers (floats and doubles) are in the nnativeative machine format only; due to the multiplicity of floating formats around, and the lack of a standard \*(L"network\*(R" representation, no facility for interchange has been made. --- 302,308 ---- count, padding with nulls or spaces as necessary. (When unpacking, "A" strips trailing spaces and nulls, but "a" does not.) ! Real numbers (floats and doubles) are in the native machine format only; due to the multiplicity of floating formats around, and the lack of a standard \*(L"network\*(R" representation, no facility for interchange has been made. *************** *** 308,314 **** representation is not part of the IEEE spec). Note that perl uses doubles internally for all numeric calculation, and converting from ! double -> float -> double will loose precision (i.e. unpack("f", pack("f", $foo)) will not in general equal $foo). .br Examples: --- 312,318 ---- representation is not part of the IEEE spec). Note that perl uses doubles internally for all numeric calculation, and converting from ! double -> float -> double will lose precision (i.e. unpack("f", pack("f", $foo)) will not in general equal $foo). .br Examples: *************** *** 382,388 **** of its expressions evaluated in an array context. Also be careful not to follow the print keyword with a left parenthesis unless you want the corresponding right parenthesis to terminate the ! arguments to the print--interpose a + or put parens around all the arguments. .Ip "printf(FILEHANDLE LIST)" 8 10 .Ip "printf(LIST)" 8 .Ip "printf FILEHANDLE LIST" 8 --- 386,392 ---- of its expressions evaluated in an array context. Also be careful not to follow the print keyword with a left parenthesis unless you want the corresponding right parenthesis to terminate the ! arguments to the print\*(--interpose a + or put parens around all the arguments. .Ip "printf(FILEHANDLE LIST)" 8 10 .Ip "printf(LIST)" 8 .Ip "printf FILEHANDLE LIST" 8 *************** *** 639,645 **** Returns 1 upon success, 0 otherwise. .Ip "seekdir(DIRHANDLE,POS)" 8 3 Sets the current position for the readdir() routine on DIRHANDLE. ! POS must be a value returned by seekdir(). Has the same caveats about possible directory compaction as the corresponding system library routine. .Ip "select(FILEHANDLE)" 8 3 --- 643,649 ---- Returns 1 upon success, 0 otherwise. .Ip "seekdir(DIRHANDLE,POS)" 8 3 Sets the current position for the readdir() routine on DIRHANDLE. ! POS must be a value returned by telldir(). Has the same caveats about possible directory compaction as the corresponding system library routine. .Ip "select(FILEHANDLE)" 8 3 *************** *** 808,814 **** Opens a socket of the specified kind and attaches it to filehandle SOCKET. DOMAIN, TYPE and PROTOCOL are specified the same as for the system call of the same name. ! You may need to run makelib on sys/socket.h to get the proper values handy in a perl library file. Return true if successful. See the example in the section on Interprocess Communication. --- 812,818 ---- Opens a socket of the specified kind and attaches it to filehandle SOCKET. DOMAIN, TYPE and PROTOCOL are specified the same as for the system call of the same name. ! You may need to run h2ph on sys/socket.h to get the proper values handy in a perl library file. Return true if successful. See the example in the section on Interprocess Communication. *************** *** 1114,1120 **** like numbers. .nf ! require 'syscall.ph'; # may need to run makelib syscall(&SYS_write, fileno(STDOUT), "hi there\en", 9); .fi --- 1118,1124 ---- like numbers. .nf ! require 'syscall.ph'; # may need to run h2ph syscall(&SYS_write, fileno(STDOUT), "hi there\en", 9); .fi *************** *** 1162,1168 **** Has the same caveats about possible directory compaction as the corresponding system library routine. .Ip "time" 8 4 ! Returns the number of non-leap seconds since January 1, 1970, UTC. Suitable for feeding to gmtime() and localtime(). .Ip "times" 8 4 Returns a four-element array giving the user and system times, in seconds, for this --- 1166,1172 ---- Has the same caveats about possible directory compaction as the corresponding system library routine. .Ip "time" 8 4 ! Returns the number of non-leap seconds since 00:00:00 UTC, January 1, 1970. Suitable for feeding to gmtime() and localtime(). .Ip "times" 8 4 Returns a four-element array giving the user and system times, in seconds, for this *************** *** 1170,1180 **** .Sp ($user,$system,$cuser,$csystem) = times; .Sp ! .Ip "tr/SEARCHLIST/REPLACEMENTLIST/" 8 5 ! .Ip "y/SEARCHLIST/REPLACEMENTLIST/" 8 Translates all occurrences of the characters found in the search list with the corresponding character in the replacement list. ! It returns the number of characters replaced. If no string is specified via the =~ or !~ operator, the $_ string is translated. (The string specified with =~ must be a scalar variable, an array element, --- 1174,1184 ---- .Sp ($user,$system,$cuser,$csystem) = times; .Sp ! .Ip "tr/SEARCHLIST/REPLACEMENTLIST/cds" 8 5 ! .Ip "y/SEARCHLIST/REPLACEMENTLIST/cds" 8 Translates all occurrences of the characters found in the search list with the corresponding character in the replacement list. ! It returns the number of characters replaced or deleted. If no string is specified via the =~ or !~ operator, the $_ string is translated. (The string specified with =~ must be a scalar variable, an array element, *************** *** 1185,1190 **** --- 1189,1212 ---- .I y is provided as a synonym for .IR tr . + .Sp + If the c modifier is specified, the SEARCHLIST character set is complemented. + If the d modifier is specified, any characters specified by SEARCHLIST that + are not found in REPLACEMENTLIST are deleted. + (Note that this is slightly more flexible than the behavior of some + .I tr + programs, which delete anything they find in the SEARCHLIST, period.) + If the s modifier is specified, sequences of characters that were translated + to the same character are squashed down to 1 instance of the character. + .Sp + If the d modifier was used, the REPLACEMENTLIST is always interpreted exactly + as specified. + Otherwise, if the REPLACEMENTLIST is shorter than the SEARCHLIST, + the final character is replicated till it is long enough. + If the REPLACEMENTLIST is null, the SEARCHLIST is replicated. + This latter is useful for counting characters in a class, or for squashing + character sequences in a class. + .Sp Examples: .nf *************** *** 1192,1200 **** $cnt = tr/*/*/; \h'|3i'# count the stars in $_ ($HOST = $host) =~ tr/a\-z/A\-Z/; ! y/\e001\-@[\-_{\-\e177/ /; \h'|3i'# change non-alphas to space .fi .Ip "truncate(FILEHANDLE,LENGTH)" 8 4 --- 1214,1228 ---- $cnt = tr/*/*/; \h'|3i'# count the stars in $_ + $cnt = tr/0\-9//; \h'|3i'# count the digits in $_ + + tr/a\-zA\-Z//s; \h'|3i'# bookkeeper \-> bokeper + ($HOST = $host) =~ tr/a\-z/A\-Z/; ! y/a\-zA\-Z/ /cs; \h'|3i'# change non-alphas to single space ! ! tr/\e200\-\e377/\e0\-\e177/;\h'|3i'# delete 8th bit .fi .Ip "truncate(FILEHANDLE,LENGTH)" 8 4 Index: perl_man.4 Prereq: 3.0.1.12 *** perl_man.4.old Sat Nov 10 02:33:50 1990 --- perl_man.4 Sat Nov 10 02:34:09 1990 *************** *** 1,7 **** ''' Beginning of part 4 ! ''' $Header: perl_man.4,v 3.0.1.12 90/10/20 02:15:43 lwall Locked $ ''' ''' $Log: perl_man.4,v $ ''' Revision 3.0.1.12 90/10/20 02:15:43 lwall ''' patch37: patch37: fixed various typos in man page ''' --- 1,10 ---- ''' Beginning of part 4 ! ''' $Header: perl_man.4,v 3.0.1.13 90/11/10 01:51:00 lwall Locked $ ''' ''' $Log: perl_man.4,v $ + ''' Revision 3.0.1.13 90/11/10 01:51:00 lwall + ''' patch38: random cleanup + ''' ''' Revision 3.0.1.12 90/10/20 02:15:43 lwall ''' patch37: patch37: fixed various typos in man page ''' *************** *** 60,66 **** left\h'|1i'&& left\h'|1i'| ^ left\h'|1i'& ! nonassoc\h'|1i'== != eq ne nonassoc\h'|1i'< > <= >= lt gt le ge nonassoc\h'|1i'chdir exit eval reset sleep rand umask nonassoc\h'|1i'\-r \-w \-x etc. --- 63,69 ---- left\h'|1i'&& left\h'|1i'| ^ left\h'|1i'& ! nonassoc\h'|1i'== != <=> eq ne cmp nonassoc\h'|1i'< > <= >= lt gt le ge nonassoc\h'|1i'chdir exit eval reset sleep rand umask nonassoc\h'|1i'\-r \-w \-x etc. *************** *** 223,229 **** do foo(); # pass a null list &foo(); # the same ! &foo; # pass no arguments--more efficient .fi .Sh "Passing By Reference" --- 226,232 ---- do foo(); # pass a null list &foo(); # the same ! &foo; # pass no arguments\*(--more efficient .fi .Sh "Passing By Reference" *************** *** 774,779 **** --- 777,784 ---- results when $* is 0. Default is 0. (Mnemonic: * matches multiple things.) + Note that this variable only influences the interpretation of ^ and $. + A literal newline can be searched for even when $* == 0. .Ip $0 8 Contains the name of the file containing the .I perl *************** *** 827,833 **** But don't put ! @foo{$a,$b,$c} # a slice--note the @ which means --- 832,838 ---- But don't put ! @foo{$a,$b,$c} # a slice\*(--note the @ which means *************** *** 1088,1093 **** --- 1093,1102 ---- .fi When in doubt, parenthesize. At the very least it will let some poor schmuck bounce on the % key in vi. + .Sp + Even if you aren't in doubt, consider the mental welfare of the person who + has to maintain the code after you, and who will probably put parens in + the wrong place. .Ip 2. 4 4 Don't go through silly contortions to exit a loop at the top or the bottom, when Index: os2/perldb.dif *** os2/perldb.dif.old Sat Nov 10 02:30:17 1990 --- os2/perldb.dif Sat Nov 10 02:30:19 1990 *************** *** 0 **** --- 1,52 ---- + *** lib/perldb.pl Tue Oct 23 23:14:20 1990 + --- os2/perldb.pl Tue Nov 06 21:13:42 1990 + *************** + *** 36,43 **** + # + # + + ! open(IN, "</dev/tty") || open(IN, "<&STDIN"); # so we don't dingle stdin + ! open(OUT,">/dev/tty") || open(OUT, ">&STDOUT"); # so we don't dongle stdout + select(OUT); + $| = 1; # for DB'OUT + select(STDOUT); + --- 36,43 ---- + # + # + + ! open(IN, "<con") || open(IN, "<&STDIN"); # so we don't dingle stdin + ! open(OUT,">con") || open(OUT, ">&STDOUT"); # so we don't dongle stdout + select(OUT); + $| = 1; # for DB'OUT + select(STDOUT); + *************** + *** 517,530 **** + s/(.*)/'$1'/ unless /^-?[\d.]+$/; + } + + ! if (-f '.perldb') { + ! do './.perldb'; + } + ! elsif (-f "$ENV{'LOGDIR'}/.perldb") { + ! do "$ENV{'LOGDIR'}/.perldb"; + } + ! elsif (-f "$ENV{'HOME'}/.perldb") { + ! do "$ENV{'HOME'}/.perldb"; + } + + 1; + --- 517,530 ---- + s/(.*)/'$1'/ unless /^-?[\d.]+$/; + } + + ! if (-f 'perldb.ini') { + ! do './perldb.ini'; + } + ! elsif (-f "$ENV{'INIT'}/perldb.ini") { + ! do "$ENV{'INIT'}/perldb.ini"; + } + ! elsif (-f "$ENV{'HOME'}/perldb.ini") { + ! do "$ENV{'HOME'}/perldb.ini"; + } + + 1; Index: lib/perldb.pl Prereq: 3.0.1.4 *** lib/perldb.pl.old Sat Nov 10 02:28:34 1990 --- lib/perldb.pl Sat Nov 10 02:28:38 1990 *************** *** 1,6 **** package DB; ! $header = '$Header: perldb.pl,v 3.0.1.4 90/10/15 17:40:38 lwall Locked $'; # # This file is automatically included if you do perl -d. # It's probably not useful to include this yourself. --- 1,6 ---- package DB; ! $header = '$Header: perldb.pl,v 3.0.1.5 90/11/10 01:40:26 lwall Locked $'; # # This file is automatically included if you do perl -d. # It's probably not useful to include this yourself. *************** *** 10,15 **** --- 10,18 ---- # have a breakpoint. It also inserts a do 'perldb.pl' before the first line. # # $Log: perldb.pl,v $ + # Revision 3.0.1.5 90/11/10 01:40:26 lwall + # patch38: the debugger wouldn't stop correctly or do action routines + # # Revision 3.0.1.4 90/10/15 17:40:38 lwall # patch29: added caller # patch29: the debugger now understands packages and evals *************** *** 59,65 **** $signal |= 1; } else { ! $signal |= &eval($stop); $dbline{$line} =~ s/;9($|\0)/$1/; } } --- 62,68 ---- $signal |= 1; } else { ! &eval("\$DB'signal |= do {$stop;}"); $dbline{$line} =~ s/;9($|\0)/$1/; } } *************** *** 307,313 **** print OUT "Line $i may not have an action.\n"; } else { $dbline{$i} =~ s/\0[^\0]*//; ! $dbline .= "\0" . do action($3); } next; }; $cmd =~ /^n$/ && do { --- 310,316 ---- print OUT "Line $i may not have an action.\n"; } else { $dbline{$i} =~ s/\0[^\0]*//; ! $dbline{$i} .= "\0" . do action($3); } next; }; $cmd =~ /^n$/ && do { Index: os2/perlglob.cs *** os2/perlglob.cs.old Sat Nov 10 02:30:26 1990 --- os2/perlglob.cs Sat Nov 10 02:30:28 1990 *************** *** 1,7 **** ! glob.c setargv.obj ! perlglob.def perlglob.exe -AS -LB -S0x1000 --- 1,7 ---- ! msdos\glob.c setargv.obj ! os2\perlglob.def perlglob.exe -AS -LB -S0x1000 Index: os2/perlglob.def *** os2/perlglob.def.old Sat Nov 10 02:30:34 1990 --- os2/perlglob.def Sat Nov 10 02:30:35 1990 *************** *** 1,3 **** NAME PERLGLOB WINDOWCOMPAT NEWFILES DESCRIPTION 'Filename globbing for PERL - for MS-DOS and OS/2' - STUB 'REALGLOB.EXE' --- 1,2 ---- Index: perly.c Prereq: 3.0.1.8 *** perly.c.old Sat Nov 10 02:34:33 1990 --- perly.c Sat Nov 10 02:34:41 1990 *************** *** 1,4 **** ! char rcsid[] = "$Header: perly.c,v 3.0.1.8 90/10/16 10:14:20 lwall Locked $\nPatch level: ###\n"; /* * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! char rcsid[] = "$Header: perly.c,v 3.0.1.9 90/11/10 01:53:26 lwall Locked $\nPatch level: ###\n"; /* * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,17 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: perly.c,v $ + * Revision 3.0.1.9 90/11/10 01:53:26 lwall + * patch38: random cleanup + * patch38: more msdos/os2 upgrades + * patch38: references to $0 produced core dumps + * patch38: added hooks for unexec() + * * Revision 3.0.1.8 90/10/16 10:14:20 lwall * patch29: *foo now prints as *package'foo * patch29: added waitpid *************** *** 245,251 **** --- 251,265 ---- /* open script */ if (argv[0] == Nullch) + #ifdef MSDOS + { + if ( isatty(fileno(stdin)) ) + moreswitches("v"); argv[0] = "-"; + } + #else + argv[0] = "-"; + #endif if (dosearch && !index(argv[0], '/') && (s = getenv("PATH"))) { char *xfound = Nullch, *xfailed = Nullch; int len; *************** *** 316,322 **** #endif (doextract ? "-e '1,/^#/d\n'" : ""), argv[0], CPPSTDIN, str_get(str), CPPMINUS); ! doextract = FALSE; #ifdef IAMSUID /* actually, this is caught earlier */ if (euid != uid && !euid) /* if running suidperl */ #ifdef SETEUID --- 330,342 ---- #endif (doextract ? "-e '1,/^#/d\n'" : ""), argv[0], CPPSTDIN, str_get(str), CPPMINUS); ! #ifdef DEBUGGING ! if (debug & 64) { ! fputs(buf,stderr); ! fputs("\n",stderr); ! } ! #endif ! doextract = FALSE; #ifdef IAMSUID /* actually, this is caught earlier */ if (euid != uid && !euid) /* if running suidperl */ #ifdef SETEUID *************** *** 639,645 **** (void)hadd(sigstab); } ! magicalize("!#?^~=-%0123456789.+&*()<>,\\/[|`':\024"); userinit(); /* in case linked C routines want magical variables */ amperstab = stabent("&",allstabs); --- 659,665 ---- (void)hadd(sigstab); } ! magicalize("!#?^~=-%123456789.+&*()<>,\\/[|`':\024"); userinit(); /* in case linked C routines want magical variables */ amperstab = stabent("&",allstabs); *************** *** 693,699 **** statname = Str_new(66,0); /* last filename we did stat on */ if (do_undump) ! abort(); just_doit: /* come here if running an undumped a.out */ argc--,argv++; /* skip name of script */ --- 713,719 ---- statname = Str_new(66,0); /* last filename we did stat on */ if (do_undump) ! my_unexec(); just_doit: /* come here if running an undumped a.out */ argc--,argv++; /* skip name of script */ *************** *** 710,716 **** tainted = 1; #endif if (tmpstab = stabent("0",allstabs)) ! str_set(STAB_STR(tmpstab),origfilename); if (argvstab = stabent("ARGV",allstabs)) { argvstab->str_pok |= SP_MULTI; (void)aadd(argvstab); --- 730,736 ---- tainted = 1; #endif if (tmpstab = stabent("0",allstabs)) ! str_set(stab_val(tmpstab),origfilename); if (argvstab = stabent("ARGV",allstabs)) { argvstab->str_pok |= SP_MULTI; (void)aadd(argvstab); *************** *** 1096,1098 **** --- 1116,1143 ---- } return Nullch; } + + /* compliments of Tom Christiansen */ + + /* unexec() can be found in the Gnu emacs distribution */ + + my_unexec() + { + #ifdef UNEXEC + int status; + extern int etext; + static char dumpname[BUFSIZ]; + static char perlpath[256]; + + sprintf (dumpname, "%s.perldump", origfilename); + sprintf (perlpath, "%s/perl", BIN); + + status = unexec(dumpname, perlpath, &etext, sbrk(0), 0); + if (status) + fprintf(stderr, "unexec of %s into %s failed!\n", perlpath, dumpname); + exit(status); + #else + abort(); /* for use with undump */ + #endif + } + Index: regcomp.c Prereq: 3.0.1.7 *** regcomp.c.old Sat Nov 10 02:35:02 1990 --- regcomp.c Sat Nov 10 02:35:11 1990 *************** *** 7,15 **** * blame Henry for some of the lack of readability. */ ! /* $Header: regcomp.c,v 3.0.1.7 90/10/20 02:18:32 lwall Locked $ * * $Log: regcomp.c,v $ * Revision 3.0.1.7 90/10/20 02:18:32 lwall * patch37: /foo.*bar$/ wrongly optimized to do tail matching on "foo" * --- 7,19 ---- * blame Henry for some of the lack of readability. */ ! /* $Header: regcomp.c,v 3.0.1.8 90/11/10 01:57:46 lwall Locked $ * * $Log: regcomp.c,v $ + * Revision 3.0.1.8 90/11/10 01:57:46 lwall + * patch38: patterns with multiple constant strings occasionally malfed + * patch38: patterns like /foo.*foo/ sped up some + * * Revision 3.0.1.7 90/10/20 02:18:32 lwall * patch37: /foo.*bar$/ wrongly optimized to do tail matching on "foo" * *************** *** 149,155 **** register int len; register char *first; int flags; ! int back; int curback; extern char *safemalloc(); extern char *savestr(); --- 153,160 ---- register int len; register char *first; int flags; ! int backish; ! int backest; int curback; extern char *safemalloc(); extern char *savestr(); *************** *** 252,258 **** longest = str_make("",0); len = 0; curback = 0; ! back = 0; while (OP(scan) != END) { if (OP(scan) == BRANCH) { if (OP(regnext(scan)) == BRANCH) { --- 257,264 ---- longest = str_make("",0); len = 0; curback = 0; ! backish = 0; ! backest = 0; while (OP(scan) != END) { if (OP(scan) == BRANCH) { if (OP(regnext(scan)) == BRANCH) { *************** *** 267,273 **** first = scan; while (OP(regnext(scan)) >= CLOSE) scan = regnext(scan); ! if (curback - back == len) { str_ncat(longish, OPERAND(first)+1, *OPERAND(first)); len += *OPERAND(first); --- 273,279 ---- first = scan; while (OP(regnext(scan)) >= CLOSE) scan = regnext(scan); ! if (curback - backish == len) { str_ncat(longish, OPERAND(first)+1, *OPERAND(first)); len += *OPERAND(first); *************** *** 277,283 **** else if (*OPERAND(first) >= len + (curback >= 0)) { len = *OPERAND(first); str_nset(longish, OPERAND(first)+1,len); ! back = curback; curback += len; first = regnext(scan); } --- 283,289 ---- else if (*OPERAND(first) >= len + (curback >= 0)) { len = *OPERAND(first); str_nset(longish, OPERAND(first)+1,len); ! backish = curback; curback += len; first = regnext(scan); } *************** *** 287,301 **** else if (index(varies,OP(scan))) { curback = -30000; len = 0; ! if (longish->str_cur > longest->str_cur) str_sset(longest,longish); str_nset(longish,"",0); } else if (index(simple,OP(scan))) { curback++; len = 0; ! if (longish->str_cur > longest->str_cur) str_sset(longest,longish); str_nset(longish,"",0); } scan = regnext(scan); --- 293,311 ---- else if (index(varies,OP(scan))) { curback = -30000; len = 0; ! if (longish->str_cur > longest->str_cur) { str_sset(longest,longish); + backest = backish; + } str_nset(longish,"",0); } else if (index(simple,OP(scan))) { curback++; len = 0; ! if (longish->str_cur > longest->str_cur) { str_sset(longest,longish); + backest = backish; + } str_nset(longish,"",0); } scan = regnext(scan); *************** *** 303,317 **** /* Prefer earlier on tie, unless we can tail match latter */ ! if (longish->str_cur + (OP(first) == EOL) > longest->str_cur) str_sset(longest,longish); else str_nset(longish,"",0); ! if (longest->str_cur) { r->regmust = longest; ! if (back < 0) ! back = -1; ! r->regback = back; if (longest->str_cur > !(sawstudy || fold || OP(first) == EOL) ) fbmcompile(r->regmust,fold); --- 313,338 ---- /* Prefer earlier on tie, unless we can tail match latter */ ! if (longish->str_cur + (OP(first) == EOL) > longest->str_cur) { str_sset(longest,longish); + backest = backish; + } else str_nset(longish,"",0); ! if (longest->str_cur ! && ! (!r->regstart ! || ! !fbminstr(r->regstart->str_ptr, ! r->regstart->str_ptr + r->regstart->str_cur, ! longest) ! ) ! ) ! { r->regmust = longest; ! if (backest < 0) ! backest = -1; ! r->regback = backest; if (longest->str_cur > !(sawstudy || fold || OP(first) == EOL) ) fbmcompile(r->regmust,fold); Index: regcomp.h Prereq: 3.0.1.1 *** regcomp.h.old Sat Nov 10 02:35:21 1990 --- regcomp.h Sat Nov 10 02:35:23 1990 *************** *** 1,6 **** ! /* $Header: regcomp.h,v 3.0.1.1 90/08/09 05:06:49 lwall Locked $ * * $Log: regcomp.h,v $ * Revision 3.0.1.1 90/08/09 05:06:49 lwall * patch19: sped up {m,n} on simple items * --- 1,9 ---- ! /* $Header: regcomp.h,v 3.0.1.2 90/11/10 01:58:28 lwall Locked $ * * $Log: regcomp.h,v $ + * Revision 3.0.1.2 90/11/10 01:58:28 lwall + * patch38: random cleanup + * * Revision 3.0.1.1 90/08/09 05:06:49 lwall * patch19: sped up {m,n} on simple items * *************** *** 139,145 **** --- 142,150 ---- #ifndef gould #ifndef cray + #ifndef eta10 #define REGALIGN + #endif #endif #endif Index: regexec.c Prereq: 3.0.1.5 *** regexec.c.old Sat Nov 10 02:35:36 1990 --- regexec.c Sat Nov 10 02:35:40 1990 *************** *** 7,15 **** * blame Henry for some of the lack of readability. */ ! /* $Header: regexec.c,v 3.0.1.5 90/10/16 10:25:36 lwall Locked $ * * $Log: regexec.c,v $ * Revision 3.0.1.5 90/10/16 10:25:36 lwall * patch29: /^pat/ occasionally matched in middle of string when $* = 0 * patch29: /.{n,m}$/ could match with fewer than n characters remaining --- 7,19 ---- * blame Henry for some of the lack of readability. */ ! /* $Header: regexec.c,v 3.0.1.6 90/11/10 02:00:57 lwall Locked $ * * $Log: regexec.c,v $ + * Revision 3.0.1.6 90/11/10 02:00:57 lwall + * patch38: patterns like /^foo.*bar/ sped up some + * patch38: /[^whatever]+/ could scan past end of string + * * Revision 3.0.1.5 90/10/16 10:25:36 lwall * patch29: /^pat/ occasionally matched in middle of string when $* = 0 * patch29: /.{n,m}$/ could match with fewer than n characters remaining *************** *** 169,175 **** /* If there is a "must appear" string, look for it. */ s = string; ! if (prog->regmust != Nullstr) { if (stringarg == strbeg && screamer) { if (screamfirst[prog->regmust->str_rare] >= 0) s = screaminstr(screamer,prog->regmust); --- 173,180 ---- /* If there is a "must appear" string, look for it. */ s = string; ! if (prog->regmust != Nullstr && ! (!(prog->reganch & 1) || (multiline && prog->regback >= 0)) ) { if (stringarg == strbeg && screamer) { if (screamfirst[prog->regmust->str_rare] >= 0) s = screaminstr(screamer,prog->regmust); *************** *** 590,598 **** nextchar = UCHARAT(locinput); if (s[nextchar >> 3] & (1 << (nextchar&7))) return(0); ! nextchar = *++locinput; ! if (!nextchar && locinput > regeol) return 0; break; case ALNUM: if (!nextchar) --- 595,603 ---- nextchar = UCHARAT(locinput); if (s[nextchar >> 3] & (1 << (nextchar&7))) return(0); ! if (!nextchar && locinput >= regeol) return 0; + nextchar = *++locinput; break; case ALNUM: if (!nextchar) Index: stab.c Prereq: 3.0.1.9 *** stab.c.old Sat Nov 10 02:35:58 1990 --- stab.c Sat Nov 10 02:36:03 1990 *************** *** 1,4 **** ! /* $Header: stab.c,v 3.0.1.9 90/10/16 10:32:05 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: stab.c,v 3.0.1.10 90/11/10 02:02:05 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: stab.c,v $ + * Revision 3.0.1.10 90/11/10 02:02:05 lwall + * patch38: random cleanup + * * Revision 3.0.1.9 90/10/16 10:32:05 lwall * patch29: added -M, -A and -C * patch29: taintperl now checks for world writable PATH components *************** *** 71,76 **** --- 74,81 ---- #define handlertype int #endif + static handlertype sighandler(); + STR * stab_str(str) STR *str; *************** *** 244,250 **** STAB *stab = mstr->str_u.str_stab; char *s; int i; - static handlertype sighandler(); switch (mstr->str_rare) { case 'E': --- 249,254 ---- *************** *** 295,301 **** CMD *cmd; i = str_true(str); ! str = afetch(stab_xarray(stab),atoi(mstr->str_ptr)); cmd = str->str_magic->str_u.str_cmd; cmd->c_flags &= ~CF_OPTIMIZE; cmd->c_flags |= i? CFT_D1 : CFT_D0; --- 299,305 ---- CMD *cmd; i = str_true(str); ! str = afetch(stab_xarray(stab),atoi(mstr->str_ptr), FALSE); cmd = str->str_magic->str_u.str_cmd; cmd->c_flags &= ~CF_OPTIMIZE; cmd->c_flags |= i? CFT_D1 : CFT_D0; Index: str.c Prereq: 3.0.1.9 *** str.c.old Sat Nov 10 02:36:24 1990 --- str.c Sat Nov 10 02:36:32 1990 *************** *** 1,4 **** ! /* $Header: str.c,v 3.0.1.9 90/10/16 10:41:21 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: str.c,v 3.0.1.10 90/11/10 02:06:29 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,16 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: str.c,v $ + * Revision 3.0.1.10 90/11/10 02:06:29 lwall + * patch38: temp string values are now copied less often + * patch38: array slurps are now faster and take less memory + * patch38: fixed a memory leakage on local(*foo) + * * Revision 3.0.1.9 90/10/16 10:41:21 lwall * patch29: the undefined value could get defined by devious means * patch29: undefined values compared inconsistently *************** *** 232,237 **** --- 237,247 ---- return str->str_u.str_nval; } + /* Note: str_sset() should not be called with a source string that needs + * be reused, since it may destroy the source string if it is marked + * as temporary. + */ + str_sset(dstr,sstr) STR *dstr; register STR *sstr; *************** *** 245,263 **** if (!sstr) dstr->str_pok = dstr->str_nok = 0; else if (sstr->str_pok) { ! str_nset(dstr,sstr->str_ptr,sstr->str_cur); ! if (sstr->str_nok) { ! dstr->str_u.str_nval = sstr->str_u.str_nval; ! dstr->str_nok = 1; ! dstr->str_state = SS_NORM; } ! else if (sstr->str_cur == sizeof(STBP)) { ! char *tmps = sstr->str_ptr; ! if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) { ! if (!dstr->str_magic) { ! dstr->str_magic = str_smake(sstr->str_magic); ! dstr->str_magic->str_rare = 'X'; } } } --- 255,292 ---- if (!sstr) dstr->str_pok = dstr->str_nok = 0; else if (sstr->str_pok) { ! ! /* ! * Check to see if we can just swipe the string. If so, it's a ! * possible small lose on short strings, but a big win on long ones. ! */ ! ! if (sstr->str_pok & SP_TEMP) { /* slated for free anyway? */ ! if (dstr->str_ptr) ! Safefree(dstr->str_ptr); ! #ifdef STRUCTCOPY ! *dstr = *sstr; ! #else ! Copy(sstr, dstr, 1, STR); ! #endif ! Zero(sstr, 1, STR); /* (probably overkill) */ ! dstr->str_pok &= ~SP_TEMP; } ! else { /* have to copy piecemeal */ ! str_nset(dstr,sstr->str_ptr,sstr->str_cur); ! if (sstr->str_nok) { ! dstr->str_u.str_nval = sstr->str_u.str_nval; ! dstr->str_nok = 1; ! dstr->str_state = SS_NORM; ! } ! else if (sstr->str_cur == sizeof(STBP)) { ! char *tmps = sstr->str_ptr; ! if (*tmps == 'S' && bcmp(tmps,"StB",4) == 0) { ! if (!dstr->str_magic) { ! dstr->str_magic = str_smake(sstr->str_magic); ! dstr->str_magic->str_rare = 'X'; ! } } } } *************** *** 590,595 **** --- 619,626 ---- #ifdef TAINT str->str_tainted = nstr->str_tainted; #endif + if (nstr->str_magic) + str_free(nstr->str_magic); Safefree(nstr); } *************** *** 718,723 **** --- 749,755 ---- STRLEN obpx; register int get_paragraph; register char *oldbp; + int shortbuffered; if (str == &str_undef) return Nullch; *************** *** 729,736 **** cnt = fp->_cnt; /* get count into register */ str->str_nok = 0; /* invalidate number */ str->str_pok = 1; /* validate pointer */ ! if (str->str_len <= cnt + 1) /* make sure we have the room */ ! STR_GROW(str, append+cnt+2); /* (remembering cnt can be -1) */ bp = str->str_ptr + append; /* move these two too to registers */ ptr = fp->_ptr; for (;;) { --- 761,778 ---- cnt = fp->_cnt; /* get count into register */ str->str_nok = 0; /* invalidate number */ str->str_pok = 1; /* validate pointer */ ! if (str->str_len <= cnt + 1) { /* make sure we have the room */ ! if (cnt > 80 && str->str_len > 0) { ! shortbuffered = cnt - str->str_len; ! cnt = str->str_len; ! } ! else { ! shortbuffered = 0; ! STR_GROW(str, append+cnt+2);/* (remembering cnt can be -1) */ ! } ! } ! else ! shortbuffered = 0; bp = str->str_ptr + append; /* move these two too to registers */ ptr = fp->_ptr; for (;;) { *************** *** 740,745 **** --- 782,800 ---- goto thats_all_folks; /* screams */ /* sed :-) */ } + if (shortbuffered) { /* oh well, must extend */ + cnt = shortbuffered; + shortbuffered = 0; + if (get_paragraph && oldbp) + obpx = oldbp - str->str_ptr; + bpx = bp - str->str_ptr; /* prepare for possible relocation */ + STR_GROW(str, str->str_len + append + cnt + 2); + bp = str->str_ptr + bpx; /* reconstitute our pointer */ + if (get_paragraph && oldbp) + oldbp = str->str_ptr + obpx; + continue; + } + fp->_cnt = cnt; /* deregisterize cnt and ptr */ fp->_ptr = ptr; i = _filbuf(fp); /* get more characters */ *************** *** 770,775 **** --- 825,832 ---- goto screamer; /* and go back to the fray */ } thats_really_all_folks: + if (shortbuffered) + cnt += shortbuffered; fp->_cnt = cnt; /* put these back or we're in trouble */ fp->_ptr = ptr; *bp = '\0'; *************** *** 1230,1235 **** --- 1287,1294 ---- } } tmps_list[tmps_max] = str; + if (str->str_pok) + str->str_pok |= SP_TEMP; return str; } *************** *** 1251,1256 **** --- 1310,1317 ---- } } tmps_list[tmps_max] = str; + if (str->str_pok) + str->str_pok |= SP_TEMP; return str; } Index: str.h Prereq: 3.0.1.3 *** str.h.old Sat Nov 10 02:36:46 1990 --- str.h Sat Nov 10 02:36:50 1990 *************** *** 1,4 **** ! /* $Header: str.h,v 3.0.1.3 90/10/16 10:44:04 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: str.h,v 3.0.1.4 90/11/10 02:07:52 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: str.h,v $ + * Revision 3.0.1.4 90/11/10 02:07:52 lwall + * patch38: temp string values are now copied less often + * * Revision 3.0.1.3 90/10/16 10:44:04 lwall * patch29: added caller * patch29: scripts now run at almost full speed under the debugger *************** *** 87,92 **** --- 90,96 ---- #define SP_INTRP 16 /* string was compiled for interping */ #define SP_TAIL 32 /* fbm string is tail anchored: /foo$/ */ #define SP_MULTI 64 /* symbol table entry probably isn't a typo */ + #define SP_TEMP 128 /* string slated to die, so can be plundered */ #define Nullstr Null(STR*) Index: lib/syslog.pl *** lib/syslog.pl.old Sat Nov 10 02:28:50 1990 --- lib/syslog.pl Sat Nov 10 02:28:54 1990 *************** *** 2,7 **** --- 2,10 ---- # syslog.pl # # $Log: syslog.pl,v $ + # Revision 3.0.1.4 90/11/10 01:41:11 lwall + # patch38: syslog.pl was referencing an absolute path + # # Revision 3.0.1.3 90/10/15 17:42:18 lwall # patch29: various portability fixes # *************** *** 54,60 **** $host = 'localhost' unless $host; # set $syslog'host to change ! require '/usr/local/lib/perl/syslog.ph'; $maskpri = &LOG_UPTO(&LOG_DEBUG); --- 57,63 ---- $host = 'localhost' unless $host; # set $syslog'host to change ! require 'syslog.ph'; $maskpri = &LOG_UPTO(&LOG_DEBUG); Index: toke.c Prereq: 3.0.1.10 *** toke.c.old Sat Nov 10 02:37:43 1990 --- toke.c Sat Nov 10 02:37:59 1990 *************** *** 1,4 **** ! /* $Header: toke.c,v 3.0.1.10 90/10/16 11:20:46 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: toke.c,v 3.0.1.11 90/11/10 02:13:44 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,15 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: toke.c,v $ + * Revision 3.0.1.11 90/11/10 02:13:44 lwall + * patch38: added alarm function + * patch38: tr was busted in metacharacters on signed char machines + * * Revision 3.0.1.10 90/10/16 11:20:46 lwall * patch29: the length of a search pattern was limited * patch29: added DATA filehandle to read stuff after __END__ *************** *** 680,685 **** --- 684,691 ---- break; case 'a': case 'A': SNARFWORD; + if (strEQ(d,"alarm")) + UNI(O_ALARM); if (strEQ(d,"accept")) FOP22(O_ACCEPT); if (strEQ(d,"atan2")) *************** *** 1923,1929 **** --j; } if (tbl[t[i] & 0377] == -1) ! tbl[t[i] & 0377] = r[j]; } } if (r != t) --- 1929,1935 ---- --j; } if (tbl[t[i] & 0377] == -1) ! tbl[t[i] & 0377] = r[j] & 0377; } } if (r != t) Index: util.c Prereq: 3.0.1.9 *** util.c.old Sat Nov 10 02:38:37 1990 --- util.c Sat Nov 10 02:38:50 1990 *************** *** 1,4 **** ! /* $Header: util.c,v 3.0.1.9 90/10/20 02:21:01 lwall Locked $ * * Copyright (c) 1989, Larry Wall * --- 1,4 ---- ! /* $Header: util.c,v 3.0.1.10 90/11/10 02:19:28 lwall Locked $ * * Copyright (c) 1989, Larry Wall * *************** *** 6,11 **** --- 6,15 ---- * as specified in the README file that comes with the perl 3.0 kit. * * $Log: util.c,v $ + * Revision 3.0.1.10 90/11/10 02:19:28 lwall + * patch38: random cleanup + * patch38: sequence of s/^x//; s/x$//; could screw up malloc + * * Revision 3.0.1.9 90/10/20 02:21:01 lwall * patch37: tried to take strlen of integer on systems without wait4 or waitpid * patch37: unreachable return eliminated *************** *** 97,102 **** --- 101,110 ---- exit(1); } #endif /* MSDOS */ + #ifdef DEBUGGING + if ((long)size < 0) + fatal("panic: malloc"); + #endif ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */ #ifdef DEBUGGING # ifndef I286 *************** *** 110,116 **** if (ptr != Nullch) return ptr; else { ! fputs(nomem,stdout) FLUSH; exit(1); } /*NOTREACHED*/ --- 118,124 ---- if (ptr != Nullch) return ptr; else { ! fputs(nomem,stderr) FLUSH; exit(1); } /*NOTREACHED*/ *************** *** 141,146 **** --- 149,158 ---- #endif /* MSDOS */ if (!where) fatal("Null realloc"); + #ifdef DEBUGGING + if ((long)size < 0) + fatal("panic: realloc"); + #endif ptr = realloc(where,size?size:1); /* realloc(0) is NASTY on our system */ #ifdef DEBUGGING # ifndef I286 *************** *** 158,164 **** if (ptr != Nullch) return ptr; else { ! fputs(nomem,stdout) FLUSH; exit(1); } /*NOTREACHED*/ --- 170,176 ---- if (ptr != Nullch) return ptr; else { ! fputs(nomem,stderr) FLUSH; exit(1); } /*NOTREACHED*/ *************** *** 551,557 **** s = bigend - littlelen; if (*s == *little && bcmp(s,little,littlelen)==0) return (char*)s; /* how sweet it is */ ! else if (bigend[-1] == '\n' && little[littlelen-1] != '\n') { s--; if (*s == *little && bcmp(s,little,littlelen)==0) return (char*)s; --- 563,570 ---- s = bigend - littlelen; if (*s == *little && bcmp(s,little,littlelen)==0) return (char*)s; /* how sweet it is */ ! else if (bigend[-1] == '\n' && little[littlelen-1] != '\n' ! && s > big) { s--; if (*s == *little && bcmp(s,little,littlelen)==0) return (char*)s; *************** *** 1368,1374 **** if (flags) fatal("Can't do waitpid with flags"); else { - int result; register int count; register STR *str; --- 1381,1386 ---- *************** *** 1446,1451 **** --- 1458,1468 ---- { long along; + #ifdef mips + # define BIGDOUBLE 2147483648.0 + if (f >= BIGDOUBLE) + return (unsigned long)(f-(long)(f/BIGDOUBLE)*BIGDOUBLE)|0x80000000; + #endif if (f >= 0.0) return (unsigned long)f; along = (long)f; Index: eg/who *** eg/who.old Sat Nov 10 02:26:20 1990 --- eg/who Sat Nov 10 02:26:21 1990 *************** *** 1,8 **** #!/usr/bin/perl # This assumes your /etc/utmp file looks like ours ! open(utmp,'/etc/utmp'); ! @mo = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec'); ! while (read(utmp,$utmp,36)) { ($line,$name,$host,$time) = unpack('A8A8A16l',$utmp); if ($name) { $host = "($host)" if $host; --- 1,8 ---- #!/usr/bin/perl # This assumes your /etc/utmp file looks like ours ! open(UTMP,'/etc/utmp'); ! @mo = (Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec); ! while (read(UTMP,$utmp,36)) { ($line,$name,$host,$time) = unpack('A8A8A16l',$utmp); if ($name) { $host = "($host)" if $host; *** End of Patch 40 ***