Xref: utzoo comp.sources.bugs:2653 comp.lang.perl:2924 Path: utzoo!attcan!uunet!fernwood!portal!apple!decwrl!elroy.jpl.nasa.gov!jpl-devvax!lwall From: lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) Newsgroups: comp.sources.bugs,comp.lang.perl Subject: perl 3.0 patch #40 Summary: This is an official patch for perl 3.0. Please apply it. Message-ID: <10317@jpl-devvax.JPL.NASA.GOV> Date: 10 Nov 90 11:26:08 GMT Organization: Jet Propulsion Laboratory, Pasadena, CA Lines: 1530 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 #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(OUT, ">&STDOUT"); # so we don't dongle stdout + select(OUT); + $| = 1; # for DB'OUT + select(STDOUT); + --- 36,43 ---- + # + # + + ! open(IN, "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 ***