perl 3.0 patch #40
Larry Wall
lwall at jpl-devvax.JPL.NASA.GOV
Sat Nov 10 22:26:08 AEST 1990
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 at 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 ***
More information about the Comp.sources.bugs
mailing list