lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (11/18/89)
System: perl version 3.0
Patch #: 5
Priority: MED-HIGH
Subject: BZERO separate from BCOPY now
Subject: Configure now looks for lstat()
Subject: Configure now looks for <time.h> including <sys/time.h>
Subject: extra test for -lnm removed
Subject: /usr/include/{sun,bsd}, -l{sun,bsd} now supported
Subject: "none -DDEBUGGING" bug fixed
Subject: if xxx=`loc...` practice nonportable
Subject: byteorder try.c didn't work everywhere
Subject: dirnamlen has explicit check now
Subject: voidsig needed to preprocess <signal.h>
Subject: gidtype now checks lint lib
Subject: nested foreach on same array didn't work
Subject: byteorder now is a hex value
Subject: defined $foo{'bar'} should not create element
Subject: some systems have symlink() but not lstat()
Subject: some systems have dirent.h but not readdir()
Subject: grep() occasionally loses arguments or dumps core
Subject: constant numeric subscripts get lost inside ?:
Subject: some machines already define TRUE and FALSE
Subject: fixed some manual typos and indent problems
Subject: added warning about print making an array context
Subject: clarified difference between $! and $@
Subject: fixed possible confusion about current effective gid
Subject: sighandler() needed to be static
Subject: some machines typedef unchar too
Subject: substitution on leading components occasionally caused <> corruption
Subject: op.stat occasionally failed with NFS race condition
Subject: IBM PC/RT compiler can't deal with UNI() and LOP() macros
Subject: } misadjusted expection of subsequent term or operator
Subject: y/abcde// didn't work
Subject: in x2p/Makefile.SH, removed reference to $libnm
Subject: in s2p, line labels without a subsequent statement were done wrong
Subject: s2p left residue in /tmp
Subject: on Pyramids, index(s, '}' + 128) doesn't find meta-}
From:
Description:
Some machines have bcopy() but not bzero(), so Configure
tests for them separately now. Likewise for symlink() and lstat().
Some systems have dirent.h but not readdir(). The symbols BZERO,
LSTAT and READDIR are now used to differentiate.
Some machines have <time.h> including <sys/time.h>. Some do
the opposite. Some don't even have <sys/time.h>. Configure
now looks for both kinds of include, and the saga continues...
Configure tested twice for the presence of -lnm because x2p/Makefile.SH
had a reference to the obsolete $libnm variable. It now tests
only once.
Some machines have goodies stashed in /usr/include/sun,
/usr/include/bsd, -lsun and -lbsd. Configure now checks those
locations.
Configure could sometimes add an option to a default of none,
producing [none -DDEBUGGING] prompts. This is fixed.
Many of the units in metaconfig used the construct
if xxx=`loc...`; then
On most machines the exit status of loc ends up in $?, but on
a few machines, the assignment apparently sets $? to 0, since
it always succeeds. Oh well...
The tests for byte order had difficulties with illegal octal
digits and constants that were too long, as well as not defining
the union in try.c correctly.
When <dirent.h> was missing, it was assumed that the field d_namlen
existed. There is now an explicit check of <sys/dir.h> for the field.
The tests of <signal.h> to see how signal() is declared needed to have
signal.h run through the C preprocessor first because of POSIX ifdefs.
The type returned by getgroups() was defaulting wrong on Suns and
such. Configure now checks against the lint library if it exists
to produce a better default.
The construct
foreach $elem (@array) {
foreach $elem (@array) {
...
}
}
didn't work right because the iterator for the array was stored
with the array rather than with the node in the syntax tree.
If you said
defined $foo{'bar'}
it would create the element $foo{'bar'} while returning the
correct value. It now no longer creates the value.
The grep() function was occasionally losing arguments or dumping core.
This was because it called eval() on each argument but didn't
account for the fact that eval() is capable of reallocating the
stack.
If you said
$something ? $foo[1] : $foo[2]
you ended up (usually) with
$something ? $foo[0] : $foo[0]
because of the way the ?: operator tries to fool the stack into
thinking there's only one argument there instead of three. This
only happened to constant subscripts. Interestingly enough,
$abc[1] ? $foo[1] : $bar[1]
would have worked, since the first argument has the same subscript.
Some machines already define TRUE and FALSE, so we have to undef
them to avoid warnings.
Several people sent in some fixes for manual typos and indent problems.
There was a reqeust to clarify the difference between $! and $@, and
I added a gratuitous warning about print making an array context for
its arguments, since people seem to run into that frequently.
suidperl could correctly emulate a setgid script, but then it could
get confused about what the actual effective gid was.
Some machine or other defines sighandler(), so perl's sighandler()
needed to be made static.
We changed uchar to unchar for Crays, and it turns out that lots
of SysV machines typedef unchar instead. Sigh. It's now un_char.
If you did substitutions to chop leading components off a string,
and then set the string from <filehandle>, under certain circumstances
the input string could be corrupted because str_gets() called
str_grow() without making sure to change the strings current length to
be the number of characters just read, rather than the old length.
op.stat occasionally failed with NFS race condition, so it now waits
two seconds instead of one to guarantee that the NFS server advances
its clock at least one second.
IBM PC/RT compiler can't deal with UNI() and LOP() macros. If you
define CRIPPLED_CC it now will recast those macros as subroutines,
which runs a little slower but doesn't give the compiler heartburn.
The } character can terminate either an associative array subscript
or a BLOCK. These set up different expectations as to whether the
next token might be a term or an operator. There was a faulty
heuristic based on whether there was an intervening newline.
It turns out that if } simply leaves the current expectations along,
the right thing happens.
The command y/abcde// didn't work because the length of the first
part was not correctly copied to the second part.
In s2p, line labels without a subsequent statement were done wrong,
since an extra semicolon needs to be supplied. It wasn't always
suppplied, and when it was supplied, it was in the wrong place.
S2p also needed to remove its /tmp files better.
A2p translates
for (a in b)
to
foreach $a} (keys(%b))
on Pyramids, because index(s, '}' + 128) doesn't find a } with the
top bit set. This has been fixed.
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:
*** DO NOT RECOMPILE--APPLY PATCH 6 NEXT ***
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: 4
1c1
< #define PATCHLEVEL 4
---
> #define PATCHLEVEL 5
Index: Configure
Prereq: 3.0.1.2
*** Configure.old Fri Nov 17 15:54:16 1989
--- Configure Fri Nov 17 15:54:26 1989
***************
*** 8,14 ****
# and edit it to reflect your system. Some packages may include samples
# of config.h for certain machines, so you might look for one of those.)
#
! # $Header: Configure,v 3.0.1.2 89/11/11 04:05:37 lwall Locked $
#
# Yes, you may rip this off to use in other distribution packages.
# (Note: this Configure script was generated automatically. Rather than
--- 8,14 ----
# and edit it to reflect your system. Some packages may include samples
# of config.h for certain machines, so you might look for one of those.)
#
! # $Header: Configure,v 3.0.1.3 89/11/17 15:01:21 lwall Locked $
#
# Yes, you may rip this off to use in other distribution packages.
# (Note: this Configure script was generated automatically. Rather than
***************
*** 101,106 ****
--- 101,107 ----
cppminus=''
d_bcmp=''
d_bcopy=''
+ d_bzero=''
d_charsprf=''
d_crypt=''
cryptlib=''
***************
*** 119,124 ****
--- 120,126 ----
d_index=''
d_ioctl=''
d_killpg=''
+ d_lstat=''
d_memcmp=''
d_memcpy=''
d_mkdir=''
***************
*** 149,154 ****
--- 151,157 ----
d_tminsys=''
i_systime=''
i_timetoo=''
+ i_systimetoo=''
d_varargs=''
d_vfork=''
d_voidsig=''
***************
*** 173,179 ****
i_vfork=''
intsize=''
libc=''
- libnm=''
mallocsrc=''
mallocobj=''
usemymalloc=''
--- 176,181 ----
***************
*** 247,254 ****
pth="/usr/ucb /bin /usr/bin /usr/local /usr/local/bin /usr/lbin /usr/plx /usr/5bin /vol/local/bin /etc /usr/lib /lib /usr/local/lib /sys5.3/bin /sys5.3/usr/bin /bsd4.3/bin /bsd4.3/usr/bin /bsd4.3/usr/ucb"
d_newshome="/usr/NeWS"
defvoidused=7
! libswanted="net nm ndir ndbm dbm c_s"
!
: some greps do not return status, grrr.
echo "grimblepritz" >grimble
if grep blurfldyick grimble >/dev/null 2>&1 ; then
--- 249,256 ----
pth="/usr/ucb /bin /usr/bin /usr/local /usr/local/bin /usr/lbin /usr/plx /usr/5bin /vol/local/bin /etc /usr/lib /lib /usr/local/lib /sys5.3/bin /sys5.3/usr/bin /bsd4.3/bin /bsd4.3/usr/bin /bsd4.3/usr/ucb"
d_newshome="/usr/NeWS"
defvoidused=7
! libswanted="net nm ndir ndbm dbm sun bsd c_s"
! inclwanted='/usr/netinclude /usr/include/sun /usr/include/bsd'
: some greps do not return status, grrr.
echo "grimblepritz" >grimble
if grep blurfldyick grimble >/dev/null 2>&1 ; then
***************
*** 1013,1029 ****
case "$ccflags" in
'') case "$cc" in
*gcc*) dflt='-fpcc-struct-return';;
! *) dflt='none';;
esac
;;
*) dflt="$ccflags";;
esac
! if test -d /usr/netinclude; then
! case "$dflt" in
! *netinclude*);;
! *) dflt="$dflt -I/usr/netinclude";;
! esac
! fi
case "$optimize" in
-g*)
case "$dflt" in
--- 1015,1033 ----
case "$ccflags" in
'') case "$cc" in
*gcc*) dflt='-fpcc-struct-return';;
! *) dflt='';;
esac
;;
*) dflt="$ccflags";;
esac
! for thisincl in $inclwanted; do
! if test -d $thisincl; then
! case "$dflt" in
! *$thisincl*);;
! *) dflt="$dflt -I$thisincl";;
! esac
! fi
! done
case "$optimize" in
-g*)
case "$dflt" in
***************
*** 1032,1037 ****
--- 1036,1044 ----
esac
;;
esac
+ case "$dflt" in
+ '') dflt=none;;
+ esac
cat <<EOH
Your C compiler may want other flags. For this question you should
***************
*** 1097,1116 ****
'') libswanted='c_s';;
esac
for thislib in $libswanted; do
! if xxx=`loc lib$thislib.a X /usr/lib /usr/local/lib /lib`; then
echo "Found -l$thislib."
case "$dflt" in
*-l$thislib*);;
*) dflt="$dflt -l$thislib";;
esac
- elif xxx=`loc lib$thislib.a X $libpth`; then
- echo "Found $xxx."
- case "$dflt" in
- *$xxx*);;
- *) dflt="$dflt $xxx";;
- esac
else
! echo "No -l$thislib."
fi
done
set X $dflt
--- 1104,1136 ----
'') libswanted='c_s';;
esac
for thislib in $libswanted; do
! xxx=`loc lib$thislib.a X /usr/lib /usr/local/lib /lib`
! if test -f $xxx; then
echo "Found -l$thislib."
case "$dflt" in
*-l$thislib*);;
*) dflt="$dflt -l$thislib";;
esac
else
! xxx=`loc lib$thislib.a X $libpth`
! if test -f $xxx; then
! echo "Found $xxx."
! case "$dflt" in
! *$xxx*);;
! *) dflt="$dflt $xxx";;
! esac
! else
! xxx=`loc Slib$thislib.a X /usr/lib /usr/local/lib /lib`
! if test -f $xxx; then
! echo "Found -l$thislib."
! case "$dflt" in
! *-l$thislib*);;
! *) dflt="$dflt -l$thislib";;
! esac
! else
! echo "No -l$thislib."
! fi
! fi
fi
done
set X $dflt
***************
*** 1161,1170 ****
int i;
union {
unsigned long l;
! char c[8];
} u;
! u.l = 0x0807060504030201;
for (i=0; i < sizeof(long); i++)
printf("%c",u.c[i]+'0');
printf("\n");
--- 1181,1193 ----
int i;
union {
unsigned long l;
! char c[sizeof(long)];
} u;
! if (sizeof(long) > 4)
! u.l = 0x0807060504030201;
! else
! u.l = 0x04030201;
for (i=0; i < sizeof(long); i++)
printf("%c",u.c[i]+'0');
printf("\n");
***************
*** 1330,1336 ****
fi
libnames="$libnames $try"
;;
! *) libnames="$libnames $thisname" ;;
esac
done
;;
--- 1353,1359 ----
fi
libnames="$libnames $try"
;;
! *) libnames="$libnames $thislib" ;;
esac
done
;;
***************
*** 1440,1445 ****
--- 1463,1472 ----
set bcopy d_bcopy
eval $inlibc
+ : see if bzero exists
+ set bzero d_bzero
+ eval $inlibc
+
: see if sprintf is declared as int or pointer to char
echo " "
cat >.ucbsprf.c <<'EOF'
***************
*** 1537,1543 ****
fi
else
i_dirent="$undef"
! d_dirnamlen="$define"
echo "No dirent.h found."
fi
--- 1564,1574 ----
fi
else
i_dirent="$undef"
! if $contains 'd_namlen' /usr/include/sys/dir.h >/dev/null 2>&1; then
! d_dirnamlen="$define"
! else
! d_dirnamlen="$undef"
! fi
echo "No dirent.h found."
fi
***************
*** 1657,1662 ****
--- 1688,1697 ----
set killpg d_killpg
eval $inlibc
+ : see if lstat exists
+ set lstat d_lstat
+ eval $inlibc
+
: see if memcmp exists
set memcmp d_memcmp
eval $inlibc
***************
*** 1671,1677 ****
: see if ndbm is available
echo " "
! if xxx=`loc ndbm.h x /usr/include /usr/local/include /usr/netinclude`; then
d_ndbm="$define"
echo "ndbm.h found."
else
--- 1706,1713 ----
: see if ndbm is available
echo " "
! xxx=`loc ndbm.h x /usr/include /usr/local/include $inclwanted`
! if test -f $xxx; then
d_ndbm="$define"
echo "ndbm.h found."
else
***************
*** 1681,1687 ****
: see if we have the old dbm
echo " "
! if xxx=`loc dbm.h x /usr/include /usr/local/include /usr/netinclude`; then
d_odbm="$define"
echo "dbm.h found."
else
--- 1717,1724 ----
: see if we have the old dbm
echo " "
! xxx=`loc dbm.h x /usr/include /usr/local/include $inclwanted`
! if test -f $xxx; then
d_odbm="$define"
echo "dbm.h found."
else
***************
*** 1914,1919 ****
--- 1951,1961 ----
else
i_timetoo="$define"
fi
+ if $contains '^#.*include.*<sys/time\.h>' /usr/include/time.h >/dev/null 2>&1 ; then
+ i_systimetoo="$undef"
+ else
+ i_systimetoo="$define"
+ fi
: see if this is a varargs system
echo " "
***************
*** 1931,1937 ****
: see if signal is declared as pointer to function returning int or void
echo " "
! if $contains 'void.*signal' /usr/include/signal.h >/dev/null 2>&1 ; then
echo "You have void (*signal())() instead of int."
d_voidsig="$define"
else
--- 1973,1980 ----
: see if signal is declared as pointer to function returning int or void
echo " "
! $cppstdin $cppflags < /usr/include/signal.h >$$.tmp
! if $contains 'void.*signal' $$.tmp >/dev/null 2>&1 ; then
echo "You have void (*signal())() instead of int."
d_voidsig="$define"
else
***************
*** 1938,1943 ****
--- 1981,1987 ----
echo "You have int (*signal())() instead of void."
d_voidsig="$undef"
fi
+ rm -f $$.tmp
: see if there is a wait4
set wait4 d_wait4
***************
*** 2014,2023 ****
$rm -f try.* .out
: see what type gids are declared as in the kernel
case "$gidtype" in
'')
! if $contains 'gid_t;' /usr/include/sys/types.h >/dev/null 2>&1 ; then
! dflt='gid_t';
else
set `grep 'groups\[NGROUPS\];' /usr/include/sys/user.h 2>/dev/null` unsigned short
case $1 in
--- 2058,2072 ----
$rm -f try.* .out
: see what type gids are declared as in the kernel
+ echo " "
case "$gidtype" in
'')
! if $contains 'getgroups.*short' /usr/lib/lint/llib-lc >/dev/null 2>&1; then
! dflt='short'
! elif $contains 'getgroups.*int' /usr/lib/lint/llib-lc >/dev/null 2>&1; then
! dflt='int'
! elif $contains 'gid_t;' /usr/include/sys/types.h >/dev/null 2>&1 ; then
! dflt='gid_t'
else
set `grep 'groups\[NGROUPS\];' /usr/include/sys/user.h 2>/dev/null` unsigned short
case $1 in
***************
*** 2030,2036 ****
;;
esac
cont=true
- echo " "
echo "(The following only matters if you have getgroups().)"
rp="What type are the group ids returned by getgroups()? [$dflt]"
$echo $n "$rp $c"
--- 2079,2084 ----
***************
*** 2059,2065 ****
: see if this is a netinet/in.h system
echo " "
! if xxx=`loc netinet/in.h x /usr/include /usr/local/include /usr/netinclude`; then
i_niin="$define"
echo "netinet/in.h found."
else
--- 2107,2114 ----
: see if this is a netinet/in.h system
echo " "
! xxx=`loc netinet/in.h x /usr/include /usr/local/include $inclwanted`
! if test -f $xxx; then
i_niin="$define"
echo "netinet/in.h found."
else
***************
*** 2273,2297 ****
Header='$Header'
- : see if we should include -lnm
- echo " "
- if $test -r /usr/lib/libnm.a || $test -r /usr/local/lib/libnm.a ; then
- echo "New math library found."
- libnm='-lnm'
- else
- ans=`loc libnm.a x $libpth`
- case "$ans" in
- x)
- echo "No nm library found--the normal math library will have to do."
- libnm=''
- ;;
- *)
- echo "New math library found in $ans."
- libnm="$ans"
- ;;
- esac
- fi
-
: determine which malloc to compile in
echo " "
case "$usemymalloc" in
--- 2322,2327 ----
***************
*** 2395,2400 ****
--- 2425,2431 ----
cppminus='$cppminus'
d_bcmp='$d_bcmp'
d_bcopy='$d_bcopy'
+ d_bzero='$d_bzero'
d_charsprf='$d_charsprf'
d_crypt='$d_crypt'
cryptlib='$cryptlib'
***************
*** 2413,2418 ****
--- 2444,2450 ----
d_index='$d_index'
d_ioctl='$d_ioctl'
d_killpg='$d_killpg'
+ d_lstat='$d_lstat'
d_memcmp='$d_memcmp'
d_memcpy='$d_memcpy'
d_mkdir='$d_mkdir'
***************
*** 2443,2448 ****
--- 2475,2481 ----
d_tminsys='$d_tminsys'
i_systime='$i_systime'
i_timetoo='$i_timetoo'
+ i_systimetoo='$i_systimetoo'
d_varargs='$d_varargs'
d_vfork='$d_vfork'
d_voidsig='$d_voidsig'
***************
*** 2467,2473 ****
i_vfork='$i_vfork'
intsize='$intsize'
libc='$libc'
- libnm='$libnm'
mallocsrc='$mallocsrc'
mallocobj='$mallocobj'
usemymalloc='$usemymalloc'
--- 2500,2505 ----
Index: x2p/Makefile.SH
Prereq: 3.0.1.1
*** x2p/Makefile.SH.old Fri Nov 17 16:02:31 1989
--- x2p/Makefile.SH Fri Nov 17 16:02:33 1989
***************
*** 18,26 ****
esac
echo "Extracting x2p/Makefile (with variable substitutions)"
cat >Makefile <<!GROK!THIS!
! # $Header: Makefile.SH,v 3.0.1.1 89/10/26 23:29:11 lwall Locked $
#
# $Log: Makefile.SH,v $
# Revision 3.0.1.1 89/10/26 23:29:11 lwall
# patch1: in x2p/Makefile.SH, added dependency on ../config.sh
#
--- 18,29 ----
esac
echo "Extracting x2p/Makefile (with variable substitutions)"
cat >Makefile <<!GROK!THIS!
! # $Header: Makefile.SH,v 3.0.1.2 89/11/17 15:49:55 lwall Locked $
#
# $Log: Makefile.SH,v $
+ # Revision 3.0.1.2 89/11/17 15:49:55 lwall
+ # patch: in x2p/Makefile.SH, removed reference to $libnm
+ #
# Revision 3.0.1.1 89/10/26 23:29:11 lwall
# patch1: in x2p/Makefile.SH, added dependency on ../config.sh
#
***************
*** 50,56 ****
mallocsrc = $mallocsrc
mallocobj = $mallocobj
! libs = $libnm -lm $libs
!GROK!THIS!
cat >>Makefile <<'!NO!SUBS!'
--- 53,59 ----
mallocsrc = $mallocsrc
mallocobj = $mallocobj
! libs = $libs -lm
!GROK!THIS!
cat >>Makefile <<'!NO!SUBS!'
Index: array.c
Prereq: 3.0
*** array.c.old Fri Nov 17 15:55:16 1989
--- array.c Fri Nov 17 15:55:19 1989
***************
*** 1,4 ****
! /* $Header: array.c,v 3.0 89/10/18 15:08:33 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: array.c,v 3.0.1.1 89/11/17 15:02: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: array.c,v $
+ * Revision 3.0.1.1 89/11/17 15:02:52 lwall
+ * patch5: nested foreach on same array didn't work
+ *
* Revision 3.0 89/10/18 15:08:33 lwall
* 3.0 baseline
*
***************
*** 102,108 ****
ar->ary_magic = Str_new(7,0);
str_magic(ar->ary_magic, stab, '#', Nullch, 0);
ar->ary_fill = -1;
- ar->ary_index = -1;
ar->ary_max = 4;
ar->ary_flags = ARF_REAL;
return ar;
--- 105,110 ----
***************
*** 123,129 ****
ar->ary_magic = Str_new(8,0);
str_magic(ar->ary_magic, stab, '#', Nullch, 0);
ar->ary_fill = size - 1;
- ar->ary_index = -1;
ar->ary_max = size - 1;
ar->ary_flags = 0;
return ar;
--- 125,130 ----
Index: array.h
Prereq: 3.0
*** array.h.old Fri Nov 17 15:55:30 1989
--- array.h Fri Nov 17 15:55:31 1989
***************
*** 1,4 ****
! /* $Header: array.h,v 3.0 89/10/18 15:08:41 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: array.h,v 3.0.1.1 89/11/17 15:03:42 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: array.h,v $
+ * Revision 3.0.1.1 89/11/17 15:03:42 lwall
+ * patch5: nested foreach on same array didn't work
+ *
* Revision 3.0 89/10/18 15:08:41 lwall
* 3.0 baseline
*
***************
*** 17,23 ****
STR *ary_magic;
int ary_max;
int ary_fill;
- int ary_index;
char ary_flags;
};
--- 20,25 ----
Index: cmd.c
Prereq: 3.0.1.2
*** cmd.c.old Fri Nov 17 15:55:41 1989
--- cmd.c Fri Nov 17 15:55:46 1989
***************
*** 1,4 ****
! /* $Header: cmd.c,v 3.0.1.2 89/11/11 04:08:56 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: cmd.c,v 3.0.1.3 89/11/17 15:04:36 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: cmd.c,v $
+ * Revision 3.0.1.3 89/11/17 15:04:36 lwall
+ * patch5: nested foreach on same array didn't work
+ *
* Revision 3.0.1.2 89/11/11 04:08:56 lwall
* patch2: non-BSD machines required two ^D's for <>
* patch2: grow_dlevel() not inside #ifdef DEBUGGING
***************
*** 528,551 ****
retstr = &str_chop;
goto flipmaybe;
case CFT_ARRAY:
! ar = stab_array(cmd->c_expr[1].arg_ptr.arg_stab);
! match = ar->ary_index; /* just to get register */
if (match < 0) { /* first time through here? */
aryoptsave = savestack->ary_fill;
savesptr(&stab_val(cmd->c_stab));
! saveint(&ar->ary_index);
}
if (match >= ar->ary_fill) { /* we're in LAST, probably */
retstr = &str_undef;
! ar->ary_index = -1; /* this is actually redundant */
match = FALSE;
}
else {
match++;
retstr = stab_val(cmd->c_stab) = ar->ary_array[match];
! ar->ary_index = match;
match = TRUE;
}
newsp = -2;
--- 531,556 ----
retstr = &str_chop;
goto flipmaybe;
case CFT_ARRAY:
! match = cmd->c_short->str_u.str_useful; /* just to get register */
if (match < 0) { /* first time through here? */
+ ar = stab_array(cmd->c_expr[1].arg_ptr.arg_stab);
aryoptsave = savestack->ary_fill;
savesptr(&stab_val(cmd->c_stab));
! savelong(&cmd->c_short->str_u.str_useful);
}
+ else
+ ar = stab_xarray(cmd->c_expr[1].arg_ptr.arg_stab);
if (match >= ar->ary_fill) { /* we're in LAST, probably */
retstr = &str_undef;
! cmd->c_short->str_u.str_useful = -1; /* actually redundant */
match = FALSE;
}
else {
match++;
retstr = stab_val(cmd->c_stab) = ar->ary_array[match];
! cmd->c_short->str_u.str_useful = match;
match = TRUE;
}
newsp = -2;
Index: config.h.SH
*** config.h.SH.old Fri Nov 17 15:56:06 1989
--- config.h.SH Fri Nov 17 15:56:13 1989
***************
*** 48,54 ****
* This symbol contains an encoding of the order of bytes in a long.
* Usual values (in octal) are 01234, 04321, 02143, 03412...
*/
! #define BYTEORDER 0$byteorder /**/
/* CPPSTDIN:
* This symbol contains the first part of the string which will invoke
--- 48,54 ----
* This symbol contains an encoding of the order of bytes in a long.
* Usual values (in octal) are 01234, 04321, 02143, 03412...
*/
! #define BYTEORDER 0x$byteorder /**/
/* CPPSTDIN:
* This symbol contains the first part of the string which will invoke
***************
*** 77,82 ****
--- 77,88 ----
*/
#$d_bcopy BCOPY /**/
+ /* BZERO:
+ * This symbol, if defined, indicates that the bzero routine is available
+ * to zero blocks of memory. Otherwise you should probably use memcpy().
+ */
+ #$d_bzero BZERO /**/
+
/* CHARSPRINTF:
* This symbol is defined if this system declares "char *sprintf()" in
* stdio.h. The trend seems to be to declare it as "int sprintf()". It
***************
*** 212,217 ****
--- 218,229 ----
*/
#$d_killpg KILLPG /**/
+ /* LSTAT:
+ * This symbol, if defined, indicates that the lstat() routine is
+ * available to do file locking.
+ */
+ #$d_lstat LSTAT /**/
+
/* MEMCMP:
* This symbol, if defined, indicates that the memcmp routine is available
* to compare blocks of memory. If undefined, roll your own.
***************
*** 386,394 ****
--- 398,411 ----
* This symbol is defined if <sys/time.h> exists but doesn't include
* <time.h>.
*/
+ /* I_SYSTIMETOO:
+ * This symbol is defined if <sys/time.h> exists but isn't included
+ * by <time.h>.
+ */
#$d_tminsys TMINSYS /**/
#$i_systime I_SYSTIME /**/
#$i_timetoo I_TIMETOO /**/
+ #$i_systimetoo I_SYSTIMETOO /**/
/* VARARGS:
* This symbol, if defined, indicates to the C program that it should
Index: cons.c
Prereq: 3.0.1.1
*** cons.c.old Fri Nov 17 15:56:28 1989
--- cons.c Fri Nov 17 15:56:33 1989
***************
*** 1,4 ****
! /* $Header: cons.c,v 3.0.1.1 89/10/26 23:09:01 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: cons.c,v 3.0.1.2 89/11/17 15:08:53 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: cons.c,v $
+ * Revision 3.0.1.2 89/11/17 15:08:53 lwall
+ * patch5: nested foreach on same array didn't work
+ *
* Revision 3.0.1.1 89/10/26 23:09:01 lwall
* patch1: numeric switch optimization was broken
* patch1: unless was broken when run under the debugger
***************
*** 1029,1034 ****
--- 1032,1039 ----
cmd->c_flags &= ~CF_OPTIMIZE; /* clear optimization type */
cmd->c_flags |= CFT_ARRAY; /* and set it to do the iteration */
cmd->c_stab = eachstab;
+ cmd->c_short = str_new(0); /* just to save a field in struct cmd */
+ cmd->c_short->str_u.str_useful = -1;
return cmd;
}
Index: consarg.c
Prereq: 3.0.1.1
*** consarg.c.old Fri Nov 17 15:56:56 1989
--- consarg.c Fri Nov 17 15:56:59 1989
***************
*** 1,4 ****
! /* $Header: consarg.c,v 3.0.1.1 89/11/11 04:14:30 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: consarg.c,v 3.0.1.2 89/11/17 15:11:34 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: consarg.c,v $
+ * Revision 3.0.1.2 89/11/17 15:11:34 lwall
+ * patch5: defined $foo{'bar'} should not create element
+ *
* Revision 3.0.1.1 89/11/11 04:14:30 lwall
* patch2: '-' x 26 made warnings about undefined value
* patch2: eval with no args caused strangeness
***************
*** 634,640 ****
}
}
else if (arg1->arg_type == O_AELEM || arg1->arg_type == O_LAELEM)
! arg1->arg_type = O_LAELEM;
else if (arg1->arg_type == O_ARRAY || arg1->arg_type == O_LARRAY) {
arg1->arg_type = O_LARRAY;
if (arg->arg_len > 1) {
--- 637,646 ----
}
}
else if (arg1->arg_type == O_AELEM || arg1->arg_type == O_LAELEM)
! if (arg->arg_type == O_DEFINED)
! arg1->arg_type = O_AELEM;
! else
! arg1->arg_type = O_LAELEM;
else if (arg1->arg_type == O_ARRAY || arg1->arg_type == O_LARRAY) {
arg1->arg_type = O_LARRAY;
if (arg->arg_len > 1) {
***************
*** 662,668 ****
arg[1].arg_flags |= AF_ARYOK;
}
else if (arg1->arg_type == O_HELEM || arg1->arg_type == O_LHELEM)
! arg1->arg_type = O_LHELEM;
else if (arg1->arg_type == O_HASH || arg1->arg_type == O_LHASH) {
arg1->arg_type = O_LHASH;
if (arg->arg_len > 1) {
--- 668,677 ----
arg[1].arg_flags |= AF_ARYOK;
}
else if (arg1->arg_type == O_HELEM || arg1->arg_type == O_LHELEM)
! if (arg->arg_type == O_DEFINED)
! arg1->arg_type = O_HELEM; /* avoid creating one */
! else
! arg1->arg_type = O_LHELEM;
else if (arg1->arg_type == O_HASH || arg1->arg_type == O_LHASH) {
arg1->arg_type = O_LHASH;
if (arg->arg_len > 1) {
Index: doio.c
Prereq: 3.0.1.2
*** doio.c.old Fri Nov 17 15:57:13 1989
--- doio.c Fri Nov 17 15:57:17 1989
***************
*** 1,4 ****
! /* $Header: doio.c,v 3.0.1.2 89/11/11 04:25:51 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: doio.c,v 3.0.1.3 89/11/17 15:13:06 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: doio.c,v $
+ * Revision 3.0.1.3 89/11/17 15:13:06 lwall
+ * patch5: some systems have symlink() but not lstat()
+ * patch5: some systems have dirent.h but not readdir()
+ *
* Revision 3.0.1.2 89/11/11 04:25:51 lwall
* patch2: orthogonalized the file modes some so we can have <& +<& etc.
* patch2: do_open() now detects sockets passed to process from parent
***************
*** 510,516 ****
else {
str_sset(statname,ary->ary_array[sp]);
statstab = Nullstab;
! #ifdef SYMLINK
if (arg->arg_type == O_LSTAT)
i = lstat(str_get(statname),&statcache);
else
--- 514,520 ----
else {
str_sset(statname,ary->ary_array[sp]);
statstab = Nullstab;
! #ifdef LSTAT
if (arg->arg_type == O_LSTAT)
i = lstat(str_get(statname),&statcache);
else
***************
*** 1717,1723 ****
int gimme;
int *arglast;
{
! #ifdef DIRENT
register ARRAY *ary = stack;
register STR **st = ary->ary_array;
register int sp = arglast[1];
--- 1721,1727 ----
int gimme;
int *arglast;
{
! #if defined(DIRENT) && defined(READDIR)
register ARRAY *ary = stack;
register STR **st = ary->ary_array;
register int sp = arglast[1];
***************
*** 1892,1898 ****
tot--;
}
else { /* don't let root wipe out directories without -U */
! #ifdef SYMLINK
if (lstat(s,&statbuf) < 0 ||
#else
if (stat(s,&statbuf) < 0 ||
--- 1896,1902 ----
tot--;
}
else { /* don't let root wipe out directories without -U */
! #ifdef LSTAT
if (lstat(s,&statbuf) < 0 ||
#else
if (stat(s,&statbuf) < 0 ||
Index: dolist.c
Prereq: 3.0.1.2
*** dolist.c.old Fri Nov 17 15:57:35 1989
--- dolist.c Fri Nov 17 15:57:38 1989
***************
*** 1,4 ****
! /* $Header: dolist.c,v 3.0.1.2 89/11/11 04:28:17 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: dolist.c,v 3.0.1.3 89/11/17 15:14:45 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
***************
*** 6,11 ****
--- 6,14 ----
* as specified in the README file that comes with the perl 3.0 kit.
*
* $Log: dolist.c,v $
+ * Revision 3.0.1.3 89/11/17 15:14:45 lwall
+ * patch5: grep() occasionally loses arguments or dumps core
+ *
* Revision 3.0.1.2 89/11/11 04:28:17 lwall
* patch2: non-existent slice values are now undefined rather than null
*
***************
*** 719,726 ****
int *arglast;
{
STR **st = stack->ary_array;
! register STR **dst = &st[arglast[1]];
! register STR **src = dst + 1;
register int sp = arglast[2];
register int i = sp - arglast[1];
int oldsave = savestack->ary_fill;
--- 722,729 ----
int *arglast;
{
STR **st = stack->ary_array;
! register int dst = arglast[1];
! register int src = dst + 1;
register int sp = arglast[2];
register int i = sp - arglast[1];
int oldsave = savestack->ary_fill;
***************
*** 730,739 ****
dehoist(arg,1);
arg = arg[1].arg_ptr.arg_arg;
while (i-- > 0) {
! stab_val(defstab) = *src;
(void)eval(arg,G_SCALAR,sp);
if (str_true(st[sp+1]))
! *dst++ = *src;
src++;
}
restorelist(oldsave);
--- 733,743 ----
dehoist(arg,1);
arg = arg[1].arg_ptr.arg_arg;
while (i-- > 0) {
! stab_val(defstab) = st[src];
(void)eval(arg,G_SCALAR,sp);
+ st = stack->ary_array;
if (str_true(st[sp+1]))
! st[dst++] = st[src];
src++;
}
restorelist(oldsave);
***************
*** 743,749 ****
st[arglast[0]+1] = str;
return arglast[0]+1;
}
! return arglast[0] + (dst - &st[arglast[1]]);
}
int
--- 747,753 ----
st[arglast[0]+1] = str;
return arglast[0]+1;
}
! return arglast[0] + (dst - arglast[1]);
}
int
Index: eval.c
Prereq: 3.0.1.1
*** eval.c.old Fri Nov 17 15:57:50 1989
--- eval.c Fri Nov 17 15:57:55 1989
***************
*** 1,4 ****
! /* $Header: eval.c,v 3.0.1.1 89/11/11 04:31:51 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: eval.c,v 3.0.1.2 89/11/17 15:19:34 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: eval.c,v $
+ * Revision 3.0.1.2 89/11/17 15:19:34 lwall
+ * patch5: simplified a too-complex expression for some machine or other
+ *
* Revision 3.0.1.1 89/11/11 04:31:51 lwall
* patch2: mkdir and rmdir needed to quote argument when passed to shell
* patch2: mkdir and rmdir now return better error codes
***************
*** 557,564 ****
str = afetch(ary,maxarg - 1,FALSE);
break;
case O_AELEM:
! str = afetch(stab_array(arg[1].arg_ptr.arg_stab),
! ((int)str_gnum(st[2])) - arybase,FALSE);
if (!str)
goto say_undef;
break;
--- 560,567 ----
str = afetch(ary,maxarg - 1,FALSE);
break;
case O_AELEM:
! anum = ((int)str_gnum(st[2])) - arybase;
! str = afetch(stab_array(arg[1].arg_ptr.arg_stab),anum,FALSE);
if (!str)
goto say_undef;
break;
***************
*** 1739,1745 ****
goto say_no;
#endif
case O_FTLINK:
! #ifdef SYMLINK
if (lstat(str_get(st[1]),&statcache) < 0)
goto say_undef;
if ((statcache.st_mode & S_IFMT) == S_IFLNK )
--- 1742,1748 ----
goto say_no;
#endif
case O_FTLINK:
! #ifdef LSTAT
if (lstat(str_get(st[1]),&statcache) < 0)
goto say_undef;
if ((statcache.st_mode & S_IFMT) == S_IFLNK )
Index: evalargs.xc
Prereq: 3.0.1.2
*** evalargs.xc.old Fri Nov 17 15:58:13 1989
--- evalargs.xc Fri Nov 17 15:58:16 1989
***************
*** 2,10 ****
* kit sizes from getting too big.
*/
! /* $Header: evalargs.xc,v 3.0.1.2 89/11/11 04:33:05 lwall Locked $
*
* $Log: evalargs.xc,v $
* Revision 3.0.1.2 89/11/11 04:33:05 lwall
* patch2: Configure now locates csh
*
--- 2,13 ----
* kit sizes from getting too big.
*/
! /* $Header: evalargs.xc,v 3.0.1.3 89/11/17 15:25:07 lwall Locked $
*
* $Log: evalargs.xc,v $
+ * Revision 3.0.1.3 89/11/17 15:25:07 lwall
+ * patch5: constant numeric subscripts disappeared in ?:
+ *
* Revision 3.0.1.2 89/11/11 04:33:05 lwall
* patch2: Configure now locates csh
*
***************
*** 55,79 ****
break;
case A_LARYSTAB:
++sp;
str = afetch(stab_array(argptr.arg_stab),
! arg[anum].arg_len - arybase, TRUE);
#ifdef DEBUGGING
if (debug & 8) {
(void)sprintf(buf,"LARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
! arg[anum].arg_len);
tmps = buf;
}
#endif
goto do_crement;
case A_ARYSTAB:
st[++sp] = afetch(stab_array(argptr.arg_stab),
! arg[anum].arg_len - arybase, FALSE);
if (!st[sp])
st[sp] = &str_undef;
#ifdef DEBUGGING
if (debug & 8) {
(void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
! arg[anum].arg_len);
tmps = buf;
}
#endif
--- 58,92 ----
break;
case A_LARYSTAB:
++sp;
+ switch (optype) {
+ case O_ITEM2: argtype = 2; break;
+ case O_ITEM3: argtype = 3; break;
+ default: argtype = anum; break;
+ }
str = afetch(stab_array(argptr.arg_stab),
! arg[argtype].arg_len - arybase, TRUE);
#ifdef DEBUGGING
if (debug & 8) {
(void)sprintf(buf,"LARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
! arg[argtype].arg_len);
tmps = buf;
}
#endif
goto do_crement;
case A_ARYSTAB:
+ switch (optype) {
+ case O_ITEM2: argtype = 2; break;
+ case O_ITEM3: argtype = 3; break;
+ default: argtype = anum; break;
+ }
st[++sp] = afetch(stab_array(argptr.arg_stab),
! arg[argtype].arg_len - arybase, FALSE);
if (!st[sp])
st[sp] = &str_undef;
#ifdef DEBUGGING
if (debug & 8) {
(void)sprintf(buf,"ARYSTAB $%s[%d]",stab_name(argptr.arg_stab),
! arg[argtype].arg_len);
tmps = buf;
}
#endif
Index: handy.h
Prereq: 3.0
*** handy.h.old Fri Nov 17 15:58:23 1989
--- handy.h Fri Nov 17 15:58:25 1989
***************
*** 1,4 ****
! /* $Header: handy.h,v 3.0 89/10/18 15:18:24 lwall Locked $
*
* Copyright (c) 1989, Larry Wall
*
--- 1,4 ----
! /* $Header: handy.h,v 3.0.1.1 89/11/17 15:25:55 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: handy.h,v $
+ * Revision 3.0.1.1 89/11/17 15:25:55 lwall
+ * patch5: some machines already define TRUE and FALSE
+ *
* Revision 3.0 89/10/18 15:18:24 lwall
* 3.0 baseline
*
***************
*** 27,32 ****
--- 30,42 ----
#define bool int
#else
#define bool char
+ #endif
+
+ #ifdef TRUE
+ #undef TRUE
+ #endif
+ #ifdef FALSE
+ #undef FALSE
#endif
#define TRUE (1)
#define FALSE (0)
Index: t/op.stat
Prereq: 3.0.1.1
*** t/op.stat.old Fri Nov 17 16:01:41 1989
--- t/op.stat Fri Nov 17 16:01:42 1989
***************
*** 1,6 ****
#!./perl
! # $Header: op.stat,v 3.0.1.1 89/11/11 05:02:46 lwall Locked $
print "1..56\n";
--- 1,6 ----
#!./perl
! # $Header: op.stat,v 3.0.1.2 89/11/17 15:39:27 lwall Locked $
print "1..56\n";
***************
*** 15,22 ****
print foo "Now is the time for all good men to come to.\n";
close(foo);
! $base = time;
! while (time == $base) {}
`rm -f Op.stat.tmp2; ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`;
--- 15,21 ----
print foo "Now is the time for all good men to come to.\n";
close(foo);
! sleep 2;
`rm -f Op.stat.tmp2; ln Op.stat.tmp Op.stat.tmp2; chmod 644 Op.stat.tmp`;
chris@ccsrd3.UUCP (Chris Andersen ("The Dangerous Guy")) (11/20/89)
Did I miss something? I never saw patches 2-4.
--
Chris Andersen (..!{sun,tektronix}!sequent!ccssrv!chris)
Home: (503) 620-4176 Work: (503) 641-8128
"Join the Danger Patrol!"kgd@inf.rl.ac.uk (K G Dancey) (11/21/89)
In article <847@ccsrd3.UUCP> chris@ccssrv.UUCP (Chris Andersen ("The Dangerous Guy")) writes: >Did I miss something? I never saw patches 2-4. >Chris Andersen (..!{sun,tektronix}!sequent!ccssrv!chris) ...and neither did I.