perl 2.0 patch #15
Larry Wall
lwall at jpl-devvax.JPL.NASA.GOV
Tue Nov 1 11:26:52 AEST 1988
System: perl version 2.0
Patch #: 15
Priority:
Subject: support for libc in more places
Subject: some support for defective 286 compilers
Subject: printf "%%" now works more consistently
Subject: close $foo; didn't work right
Subject: support for varargs and vprintf
Subject: clarified location of array iterators.
Subject: documented interpolation of variables into patterns.
Subject: Documented that $a and $b are passed by reference in sort specs
Subject: Documented that only one study is active at at time
Subject: now suppresses -S if / is anywhere in script name.
Subject: fix for signed/unsigned conflicts introduced in patch 14
Subject: in a2p, deleted some duplicate $ characters
Description:
Perl now makes use of varargs and vprintf where available.
Configure checks whether they are. Configure also looks for libc
(or clib) in more places (like /lib/large, /usr/lib/large, etc.).
There's now some support for at least one broken 286 compiler.
If this doesn't fix your 286 compiler's problems, lemme know.
printf with a format containing "%%" sometimes make %% and sometime
just %. It now makes % all the time.
close $foo; (an indirect close) caused a core dump. This is now
fixed.
In the documentation I made some clarifications regarding array
iterators, interpolation of variables into patterns, the way $a
and $b are passed to a sort specification subroutine, and how
study works.
Previously -S (path search) was suppressed if the script name began
with '/'. Now it is suppressed if there is a '/' anywhere in the
script name.
Patch 14 introduced some irritating but non-destructive warnings
about conflicts between signed and unsigned characters. I put
in some casts to suppress some of the chatter. No doubt somebody's
compiler will now complain elsewhere.
In a2p, certain symbols came out with an extra $ sign on the front.
This has been remedied.
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 2.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.8.43).
Index: patchlevel.h
Prereq: 14
1c1
< #define PATCHLEVEL 14
---
> #define PATCHLEVEL 15
Index: Configure
Prereq: 2.0.1.5
*** Configure.old Mon Oct 31 16:52:31 1988
--- Configure Mon Oct 31 16:52:35 1988
***************
*** 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 2.0.1.5 88/09/07 16:28:09 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 2.0.1.6 88/10/31 16:21:11 lwall Locked $
#
# Yes, you may rip this off to use in other distribution packages.
# (Note: this Configure script was generated automatically. Rather than
***************
*** 94,101 ****
--- 94,103 ----
d_strctcpy=''
d_symlink=''
d_tminsys=''
+ d_varargs=''
d_vfork=''
d_voidsig=''
+ d_vprintf=''
gidtype=''
libc=''
libnm=''
***************
*** 137,143 ****
define='define'
undef='undef'
! libpth='/usr/lib /usr/local/lib /lib'
smallmach='pdp11 i8086 z8000 i80286 iAPX286'
rmlist='kit[1-9]isdone kit[1-9][0-9]isdone'
trap 'echo " "; rm -f $rmlist; exit 1' 1 2 3
--- 139,145 ----
define='define'
undef='undef'
! libpth='/usr/lib /usr/local/lib /lib /usr/lib/large /lib/large /usr/lib/small /lib/small'
smallmach='pdp11 i8086 z8000 i80286 iAPX286'
rmlist='kit[1-9]isdone kit[1-9][0-9]isdone'
trap 'echo " "; rm -f $rmlist; exit 1' 1 2 3
***************
*** 445,454 ****
else
ans=`loc libc.a blurfl/dyick $libpth`
if test ! -f $ans; then
! ans=`loc clib blurfl/dyick $libpth`
fi
if test ! -f $ans; then
! ans=`loc libc blurfl/dyick $libpth`
fi
if test -f $ans; then
echo "Your C library is in $ans, of all places."
--- 447,456 ----
else
ans=`loc libc.a blurfl/dyick $libpth`
if test ! -f $ans; then
! ans=`loc libc blurfl/dyick $libpth`
fi
if test ! -f $ans; then
! ans=`loc clib blurfl/dyick $libpth`
fi
if test -f $ans; then
echo "Your C library is in $ans, of all places."
***************
*** 1315,1320 ****
--- 1317,1332 ----
d_tminsys="$define"
fi
+ : see if this is a varargs system
+ echo " "
+ if $test -r /usr/include/varargs.h ; then
+ d_varargs="$define"
+ echo "varargs.h found."
+ else
+ d_varargs="$undef"
+ echo "No varargs.h found, but that's ok (I hope)."
+ fi
+
: see if there is a vfork
echo " "
if $contains '^vfork$' libc.list >/dev/null 2>&1 ; then
***************
*** 1335,1340 ****
--- 1347,1362 ----
d_voidsig="$undef"
fi
+ : see if vprintf exists
+ echo " "
+ if $contains '^vprintf$' libc.list >/dev/null 2>&1; then
+ echo 'vprintf() found.'
+ d_vprintf="$define"
+ else
+ echo 'vprintf() not found.'
+ d_vprintf="$undef"
+ fi
+
: check for void type
echo " "
$cat <<EOM
***************
*** 1668,1675 ****
--- 1690,1699 ----
d_strctcpy='$d_strctcpy'
d_symlink='$d_symlink'
d_tminsys='$d_tminsys'
+ d_varargs='$d_varargs'
d_vfork='$d_vfork'
d_voidsig='$d_voidsig'
+ d_vprintf='$d_vprintf'
gidtype='$gidtype'
libc='$libc'
libnm='$libnm'
Index: x2p/a2py.c
Prereq: 2.0.1.3
*** x2p/a2py.c.old Mon Oct 31 16:55:16 1988
--- x2p/a2py.c Mon Oct 31 16:55:18 1988
***************
*** 1,6 ****
! /* $Header: a2py.c,v 2.0.1.3 88/09/07 17:15:57 lwall Exp $
*
* $Log: a2py.c,v $
* Revision 2.0.1.3 88/09/07 17:15:57 lwall
* patch14: walk() needed to be declared outside of main()
*
--- 1,9 ----
! /* $Header: a2py.c,v 2.0.1.4 88/10/31 16:52:13 lwall Locked $
*
* $Log: a2py.c,v $
+ * Revision 2.0.1.4 88/10/31 16:52:13 lwall
+ * patch15: deleted some duplicate $ characters
+ *
* Revision 2.0.1.3 88/09/07 17:15:57 lwall
* patch14: walk() needed to be declared outside of main()
*
***************
*** 589,602 ****
SNARFWORD;
if (strEQ(d,"ORS")) {
saw_ORS = TRUE;
! d = "$\\";
}
if (strEQ(d,"OFS")) {
saw_OFS = TRUE;
! d = "$,";
}
if (strEQ(d,"OFMT")) {
! d = "$#";
}
if (strEQ(d,"open"))
*d = toupper(*d);
--- 592,605 ----
SNARFWORD;
if (strEQ(d,"ORS")) {
saw_ORS = TRUE;
! d = "\\";
}
if (strEQ(d,"OFS")) {
saw_OFS = TRUE;
! d = ",";
}
if (strEQ(d,"OFMT")) {
! d = "#";
}
if (strEQ(d,"open"))
*d = toupper(*d);
***************
*** 624,630 ****
case 'r': case 'R':
SNARFWORD;
if (strEQ(d,"RS")) {
! d = "$/";
saw_RS = TRUE;
}
if (strEQ(d,"rand")) {
--- 627,633 ----
case 'r': case 'R':
SNARFWORD;
if (strEQ(d,"RS")) {
! d = "/";
saw_RS = TRUE;
}
if (strEQ(d,"rand")) {
***************
*** 659,665 ****
XTERM(FUN1);
}
if (strEQ(d,"SUBSEP")) {
! d = "$;";
}
if (strEQ(d,"sin")) {
yylval = OSIN;
--- 662,668 ----
XTERM(FUN1);
}
if (strEQ(d,"SUBSEP")) {
! d = ";";
}
if (strEQ(d,"sin")) {
yylval = OSIN;
Index: arg.c
Prereq: 2.0.1.4
*** arg.c.old Mon Oct 31 16:52:50 1988
--- arg.c Mon Oct 31 16:52:54 1988
***************
*** 1,6 ****
! /* $Header: arg.c,v 2.0.1.4 88/09/07 16:46:25 lwall Exp $
*
* $Log: arg.c,v $
* Revision 2.0.1.4 88/09/07 16:46:25 lwall
* patch14: case insensitive search speedup
* patch14: plugged memory leak on searches compiled at run time
--- 1,11 ----
! /* $Header: arg.c,v 2.0.1.5 88/10/31 16:24:18 lwall Locked $
*
* $Log: arg.c,v $
+ * Revision 2.0.1.5 88/10/31 16:24:18 lwall
+ * patch15: some support for defective 286 compilers
+ * patch15: printf "%%" now works more consistently
+ * patch15: close $foo; didn't work right
+ *
* Revision 2.0.1.4 88/09/07 16:46:25 lwall
* patch14: case insensitive search speedup
* patch14: plugged memory leak on searches compiled at run time
***************
*** 436,443 ****
--- 441,464 ----
astore(ary, iters++, dstr);
}
else {
+ #ifndef I286
while (iters > 0 && !*str_get(afetch(ary,iters-1)))
iters--;
+ #else
+ char *zaps;
+ int zapb;
+
+ zaps = str_get(afetch(ary,iters-1));
+ zapb = (int) *zaps;
+
+ while (iters > 0 && (!zapb)) {
+ iters--;
+ if (iters > 0) {
+ zaps = str_get(afetch(ary,iters-1));
+ zapb = (int) *zaps;
+ }
+ }
+ #endif
}
if (retary) {
#ifndef M_I386
***************
*** 1187,1194 ****
}
str_cat(str,buf);
}
! if (*s)
! str_cat(str,s);
STABSET(str);
}
--- 1208,1217 ----
}
str_cat(str,buf);
}
! if (*s) {
! sprintf(buf,s,0,0,0,0);
! str_cat(str,buf);
! }
STABSET(str);
}
***************
*** 1879,1885 ****
opargs[O_OPEN] = A(1,1,0);
opargs[O_TRANS] = A(1,0,0);
opargs[O_NTRANS] = A(1,0,0);
! opargs[O_CLOSE] = A(0,0,0);
opargs[O_ARRAY] = A(1,0,0);
opargs[O_HASH] = A(1,0,0);
opargs[O_LARRAY] = A(1,0,0);
--- 1902,1908 ----
opargs[O_OPEN] = A(1,1,0);
opargs[O_TRANS] = A(1,0,0);
opargs[O_NTRANS] = A(1,0,0);
! opargs[O_CLOSE] = A(1,0,0);
opargs[O_ARRAY] = A(1,0,0);
opargs[O_HASH] = A(1,0,0);
opargs[O_LARRAY] = A(1,0,0);
Index: cmd.c
Prereq: 2.0.1.2
*** cmd.c.old Mon Oct 31 16:53:04 1988
--- cmd.c Mon Oct 31 16:53:06 1988
***************
*** 1,6 ****
! /* $Header: cmd.c,v 2.0.1.2 88/08/03 22:11:09 root Exp $
*
* $Log: cmd.c,v $
* Revision 2.0.1.2 88/08/03 22:11:09 root
* patch11: fixed some possible null dereferences in debugging code
* patch11: couldn't mix two ways of returning values from subroutines
--- 1,10 ----
! /* $Header: cmd.c,v 2.0.1.3 88/10/31 16:26:07 lwall Locked $
*
* $Log: cmd.c,v $
+ * Revision 2.0.1.3 88/10/31 16:26:07 lwall
+ * patch15: varargs supported
+ * patch15: some support for defective 286 compilers
+ *
* Revision 2.0.1.2 88/08/03 22:11:09 root
* patch11: fixed some possible null dereferences in debugging code
* patch11: couldn't mix two ways of returning values from subroutines
***************
*** 17,22 ****
--- 21,30 ----
#include "EXTERN.h"
#include "perl.h"
+ #ifdef VARARGS
+ # include <varargs.h>
+ #endif
+
static STR str_chop;
/* This is the main command loop. We try to spend as much time in this loop
***************
*** 241,246 ****
--- 249,255 ----
/* FALL THROUGH */
case CFT_STROP: /* string op optimization */
retstr = STAB_STR(cmd->c_stab);
+ #ifndef I286
if (*cmd->c_short->str_ptr == *str_get(retstr) &&
strnEQ(cmd->c_short->str_ptr, str_get(retstr),
cmd->c_slen) ) {
***************
*** 266,271 ****
--- 275,315 ----
retstr = &str_no;
goto flipmaybe;
}
+ #else
+ {
+ char *zap1, *zap2, zap1c, zap2c;
+ int zaplen;
+
+ zap1 = cmd->c_short->str_ptr;
+ zap2 = str_get(retstr);
+ zap1c = *zap1;
+ zap2c = *zap2;
+ zaplen = cmd->c_slen;
+ if ((zap1c == zap2c) && (strnEQ(zap1, zap2, zaplen))) {
+ if (cmdflags & CF_EQSURE) {
+ if (sawampersand && cmd->c_slen < 30000) {
+ curspat = Nullspat;
+ if (leftstab)
+ str_nset(leftstab->stab_val,"",0);
+ if (amperstab)
+ str_sset(amperstab->stab_val,cmd->c_short);
+ if (rightstab)
+ str_nset(rightstab->stab_val,
+ retstr->str_ptr + cmd->c_slen,
+ retstr->str_cur - cmd->c_slen);
+ }
+ match = !(cmdflags & CF_FIRSTNEG);
+ retstr = &str_yes;
+ goto flipmaybe;
+ }
+ }
+ else if (cmdflags & CF_NESURE) {
+ match = cmdflags & CF_FIRSTNEG;
+ retstr = &str_no;
+ goto flipmaybe;
+ }
+ }
+ #endif
break; /* must evaluate */
case CFT_SCAN: /* non-anchored search */
***************
*** 599,604 ****
--- 643,649 ----
}
#ifdef DEBUGGING
+ # ifndef VARARGS
/*VARARGS1*/
deb(pat,a1,a2,a3,a4,a5,a6,a7,a8)
char *pat;
***************
*** 610,615 ****
--- 655,679 ----
fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
fprintf(stderr,pat,a1,a2,a3,a4,a5,a6,a7,a8);
}
+ # else
+ /*VARARGS1*/
+ deb(va_alist)
+ va_dcl
+ {
+ va_list args;
+ char *pat;
+ register int i;
+
+ va_start(args);
+ fprintf(stderr,"%-4ld",(long)line);
+ for (i=0; i<dlevel; i++)
+ fprintf(stderr,"%c%c ",debname[i],debdelim[i]);
+
+ pat = va_arg(args, char *);
+ (void) vfprintf(stderr,pat,args);
+ va_end( args );
+ }
+ # endif
#endif
copyopt(cmd,which)
Index: config.h.SH
*** config.h.SH.old Mon Oct 31 16:53:13 1988
--- config.h.SH Mon Oct 31 16:53:14 1988
***************
*** 200,205 ****
--- 200,211 ----
*/
#$d_tminsys TMINSYS /**/
+ /* VARARGS:
+ * This symbol, if defined, indicates to the C program that it should
+ * include varargs.h.
+ */
+ #$d_varargs VARARGS /**/
+
/* vfork:
* This symbol, if defined, remaps the vfork routine to fork if the
* vfork() routine isn't supported here.
***************
*** 213,218 ****
--- 219,231 ----
* symbol.
*/
#$d_voidsig VOIDSIG /**/
+
+ /* VPRINTF:
+ * This symbol, if defined, indicates that the vprintf routine is available
+ * to printf with a pointer to an argument list. If unavailable, you
+ * may need to write your own, probably in terms of _doprnt().
+ */
+ #$d_vprintf VPRINTF /**/
/* GIDTYPE:
* This symbol has a value like gid_t, int, ushort, or whatever type is
Index: eval.c
Prereq: 2.0.1.6
*** eval.c.old Mon Oct 31 16:53:23 1988
--- eval.c Mon Oct 31 16:53:27 1988
***************
*** 1,6 ****
! /* $Header: eval.c,v 2.0.1.6 88/09/07 16:49:52 lwall Exp $
*
* $Log: eval.c,v $
* Revision 2.0.1.6 88/09/07 16:49:52 lwall
* patch14: % should now work with a negative left argument
* patch14: srand always returns true now
--- 1,9 ----
! /* $Header: eval.c,v 2.0.1.7 88/10/31 16:27:56 lwall Locked $
*
* $Log: eval.c,v $
+ * Revision 2.0.1.7 88/10/31 16:27:56 lwall
+ * patch15: some support for defective 286 compilers
+ *
* Revision 2.0.1.6 88/09/07 16:49:52 lwall
* patch14: % should now work with a negative left argument
* patch14: srand always returns true now
***************
*** 1109,1115 ****
--- 1112,1128 ----
}
goto donumset;
case O_ORD:
+ #ifndef I286
value = (double) *str_get(sarg[1]);
+ #else
+ { int zapc;
+ char *zaps;
+
+ zaps = str_get(sarg[1]);
+ zapc = (int) *zaps;
+ value = (double) zapc;
+ }
+ #endif
goto donumset;
case O_SLEEP:
tmps = str_get(sarg[1]);
Index: handy.h
Prereq: 2.0.1.1
*** handy.h.old Mon Oct 31 16:53:33 1988
--- handy.h Mon Oct 31 16:53:34 1988
***************
*** 1,6 ****
! /* $Header: handy.h,v 2.0.1.1 88/07/15 18:08:42 root Exp $
*
* $Log: handy.h,v $
* Revision 2.0.1.1 88/07/15 18:08:42 root
* patch10: UTS can't cast char to double
*
--- 1,9 ----
! /* $Header: handy.h,v 2.0.1.2 88/10/31 16:29:01 lwall Locked $
*
* $Log: handy.h,v $
+ * Revision 2.0.1.2 88/10/31 16:29:01 lwall
+ * patch15: some support for defective 286 compilers
+ *
* Revision 2.0.1.1 88/07/15 18:08:42 root
* patch10: UTS can't cast char to double
*
***************
*** 12,18 ****
#ifdef NULL
#undef NULL
#endif
! #define NULL 0
#define Null(type) ((type)NULL)
#define Nullch Null(char*)
#define Nullfp Null(FILE*)
--- 15,25 ----
#ifdef NULL
#undef NULL
#endif
! #ifndef I286
! # define NULL 0
! #else
! # define NULL 0L
! #endif
#define Null(type) ((type)NULL)
#define Nullch Null(char*)
#define Nullfp Null(FILE*)
Index: malloc.c
Prereq: 2.0
*** malloc.c.old Mon Oct 31 16:53:38 1988
--- malloc.c Mon Oct 31 16:53:39 1988
***************
*** 1,6 ****
! /* $Header: malloc.c,v 2.0 88/06/05 00:09:16 root Exp $
*
* $Log: malloc.c,v $
* Revision 2.0 88/06/05 00:09:16 root
* Baseline version 2.0.
*
--- 1,9 ----
! /* $Header: malloc.c,v 2.0.1.1 88/10/31 16:29:42 lwall Locked $
*
* $Log: malloc.c,v $
+ * Revision 2.0.1.1 88/10/31 16:29:42 lwall
+ * patch15: some support for defective 286 compilers
+ *
* Revision 2.0 88/06/05 00:09:16 root
* Baseline version 2.0.
*
***************
*** 128,134 ****
--- 131,141 ----
return (NULL);
/* remove from linked list */
if (*((int*)p) > 0x10000000)
+ #ifndef I286
fprintf(stderr,"Corrupt malloc ptr 0x%x at 0x%x\n",*((int*)p),p);
+ #else
+ fprintf(stderr,"Corrupt malloc ptr 0x%lx at 0x%lx\n",*((int*)p),p);
+ #endif
nextf[bucket] = nextf[bucket]->ov_next;
p->ov_magic = MAGIC;
p->ov_index= bucket;
***************
*** 168,177 ****
--- 175,195 ----
* make getpageize call?
*/
op = (union overhead *)sbrk(0);
+ #ifndef I286
if ((int)op & 0x3ff)
sbrk(1024 - ((int)op & 0x3ff));
+ #else
+ /* The sbrk(0) call on the I286 always returns the next segment */
+ #endif
+
+ #ifndef I286
/* take 2k unless the block is bigger than that */
rnu = (bucket <= 8) ? 11 : bucket + 3;
+ #else
+ /* take 16k unless the block is bigger than that
+ (80286s like large segments!) */
+ rnu = (bucket <= 11) ? 14 : bucket + 3;
+ #endif
nblks = 1 << (rnu - (bucket + 3)); /* how many blocks to get */
if (rnu < bucket)
rnu = bucket;
***************
*** 183,192 ****
--- 201,214 ----
* Round up to minimum allocation size boundary
* and deduct from block count to reflect.
*/
+ #ifndef I286
if ((int)op & 7) {
op = (union overhead *)(((int)op + 8) &~ 7);
nblks--;
}
+ #else
+ /* Again, this should always be ok on an 80286 */
+ #endif
/*
* Add new memory allocated to that on
* free list for this hash bucket.
Index: perl.h
Prereq: 2.0.1.3
*** perl.h.old Mon Oct 31 16:53:43 1988
--- perl.h Mon Oct 31 16:53:45 1988
***************
*** 1,6 ****
! /* $Header: perl.h,v 2.0.1.3 88/09/07 16:51:18 lwall Exp $
*
* $Log: perl.h,v $
* Revision 2.0.1.3 88/09/07 16:51:18 lwall
* patch14: added sawi variable to optimize study when no //i found
*
--- 1,9 ----
! /* $Header: perl.h,v 2.0.1.4 88/10/31 16:30:40 lwall Locked $
*
* $Log: perl.h,v $
+ * Revision 2.0.1.4 88/10/31 16:30:40 lwall
+ * patch15: some support for defective 286 compilers
+ *
* Revision 2.0.1.3 88/09/07 16:51:18 lwall
* patch14: added sawi variable to optimize study when no //i found
*
***************
*** 75,80 ****
--- 78,87 ----
#include "array.h"
#include "hash.h"
+ #if defined(iAPX286) || defined(M_I286) || defined(I80286)
+ # define I286
+ #endif
+
#ifdef CHARSPRINTF
char *sprintf();
#else
***************
*** 127,132 ****
--- 134,140 ----
ARG *make_split();
ARG *flipflip();
ARG *listish();
+ ARG *maybelistish();
ARG *localize();
ARG *j();
ARG *l();
Index: perl.man.1
Prereq: 2.0.1.5
*** perl.man.1.old Mon Oct 31 16:53:55 1988
--- perl.man.1 Mon Oct 31 16:53:59 1988
***************
*** 1,7 ****
.rn '' }`
! ''' $Header: perl.man.1,v 2.0.1.5 88/09/07 16:52:04 lwall Locked $
'''
''' $Log: perl.man.1,v $
''' Revision 2.0.1.5 88/09/07 16:52:04 lwall
''' patch14: documented setting $? by closing pipe
'''
--- 1,11 ----
.rn '' }`
! ''' $Header: perl.man.1,v 2.0.1.6 88/10/31 16:33:00 lwall Locked $
'''
''' $Log: perl.man.1,v $
+ ''' Revision 2.0.1.6 88/10/31 16:33:00 lwall
+ ''' patch15: clarified location of array iterators.
+ ''' patch15: documented interpolation of variables into patterns.
+ '''
''' Revision 2.0.1.5 88/09/07 16:52:04 lwall
''' patch14: documented setting $? by closing pipe
'''
***************
*** 816,822 ****
--- 820,829 ----
foreach $item (split(/:[\e\e\en:]*/, $ENV{\'TERMCAP\'}) {
print "Item: $item\en";
}
+
.fi
+ (NB: there is only one iterator for each array, so you can't nest
+ iterators on the same array currently.)
.PP
The BLOCK by itself (labeled or not) is equivalent to a loop that executes
once.
***************
*** 1138,1143 ****
--- 1145,1152 ----
This is particularly useful for matching Unix path names that contain \*(L'/\*(R'.
If the final delimiter is followed by the optional letter \*(L'i\*(R', the matching is
done in a case-insensitive manner.
+ PATTERN may contain references to scalar variables, which will be interpolated
+ (and the pattern recompiled) every time the pattern search is evaluated.
.Sp
If used in a context that requires an array value, a pattern match returns an
array consisting of the subexpressions matched by the parentheses in pattern,
Index: perl.man.2
Prereq: 2.0.1.6
*** perl.man.2.old Mon Oct 31 16:54:13 1988
--- perl.man.2 Mon Oct 31 16:54:19 1988
***************
*** 1,7 ****
''' Beginning of part 2
! ''' $Header: perl.man.2,v 2.0.1.6 88/09/07 16:54:49 lwall Locked $
'''
''' $Log: perl.man.2,v $
''' Revision 2.0.1.6 88/09/07 16:54:49 lwall
''' patch14: spelled caesar right
''' patch14: generalized $? slightly
--- 1,11 ----
''' Beginning of part 2
! ''' $Header: perl.man.2,v 2.0.1.7 88/10/31 16:41:21 lwall Locked $
'''
''' $Log: perl.man.2,v $
+ ''' Revision 2.0.1.7 88/10/31 16:41:21 lwall
+ ''' patch15: Documented that $a and $b are passed by reference in sort specs
+ ''' patch15: Documented that only one study is active at at time
+ '''
''' Revision 2.0.1.6 88/09/07 16:54:49 lwall
''' patch14: spelled caesar right
''' patch14: generalized $? slightly
***************
*** 541,546 ****
--- 545,551 ----
is bypassed, with the following effects: the subroutine may not be a recursive
subroutine, and the two elements to be compared are passed into the subroutine
not via @_ but as $a and $b (see example below).
+ They are passed by reference so don't modify $a and $b.
SUBROUTINE may be a scalar variable name, in which case the value provides
the name of the subroutine to use.
Examples:
***************
*** 650,655 ****
--- 655,662 ----
without it to see which runs faster.
Those loops which scan for many short constant strings (including the constant
parts of more complex patterns) will benefit most.
+ You may have only one study active at a time\*(--if you study a different
+ scalar the first is \*(L"unstudied\*(R".
(The way study works is this: a linked list of every character in the string
to be searched is made, so we know, for example, where all the \*(L'k\*(R' characters
are.
***************
*** 886,895 ****
--- 893,904 ----
either very high or very low depending on whether you look at the left
side of operator or the right side of it.
For example, in
+ .nf
@ary = (1, 3, sort 4, 2);
print @ary; # prints 1324
+ .fi
the commas on the right of the sort are evaluated before the sort, but
the commas on the left are evaluated after.
In other words, list operators tend to gobble up all the arguments that
***************
*** 982,990 ****
Alternatives may be separated by |.
The bracketing construct \|(\ .\|.\|.\ \|) may also be used, in which case \e<digit>
matches the digit'th substring, where digit can range from 1 to 9.
! (Outside of patterns, use $ instead of \e in front of the digit.
The scope of $<digit> extends to the end of the enclosing BLOCK, or to
! the next pattern match with subexpressions.)
$+ returns whatever the last bracket match matched.
$& returns the entire matched string.
($0 normally returns the same thing, but don't depend on it.)
--- 991,1001 ----
Alternatives may be separated by |.
The bracketing construct \|(\ .\|.\|.\ \|) may also be used, in which case \e<digit>
matches the digit'th substring, where digit can range from 1 to 9.
! (Outside of the pattern, always use $ instead of \e in front of the digit.
The scope of $<digit> extends to the end of the enclosing BLOCK, or to
! the next pattern match with subexpressions.
! The \e<digit> notation sometimes works outside the current pattern, but should
! be relied upon.)
$+ returns whatever the last bracket match matched.
$& returns the entire matched string.
($0 normally returns the same thing, but don't depend on it.)
***************
*** 1299,1305 ****
.ne 3
$_ = \'abcdefghi\';
/def/;
! print "$\`:$&:$\'\n"; # prints abc:def:ghi
.fi
.Ip $+ 8 4
--- 1310,1316 ----
.ne 3
$_ = \'abcdefghi\';
/def/;
! print "$\`:$&:$\'\en"; # prints abc:def:ghi
.fi
.Ip $+ 8 4
***************
*** 1635,1642 ****
Associative arrays really ought to be first class objects.
.PP
.I Perl
! is at the mercy of the C compiler's definitions of various operations
! such atof().
.PP
If your stdio requires an seek or eof between reads and writes on a particular
stream, so does
--- 1646,1653 ----
Associative arrays really ought to be first class objects.
.PP
.I Perl
! is at the mercy of your machine's definitions of various operations
! such as type casting, atof() and sprintf().
.PP
If your stdio requires an seek or eof between reads and writes on a particular
stream, so does
Index: perl.y
Prereq: 2.0.1.4
*** perl.y.old Mon Oct 31 16:54:29 1988
--- perl.y Mon Oct 31 16:54:31 1988
***************
*** 1,6 ****
! /* $Header: perl.y,v 2.0.1.4 88/09/07 16:55:41 lwall Exp $
*
* $Log: perl.y,v $
* Revision 2.0.1.4 88/09/07 16:55:41 lwall
* patch14: case insensitive search speedup
*
--- 1,9 ----
! /* $Header: perl.y,v 2.0.1.5 88/10/31 16:42:23 lwall Locked $
*
* $Log: perl.y,v $
+ * Revision 2.0.1.5 88/10/31 16:42:23 lwall
+ * patch15: printf "%%" is now more consistent
+ *
* Revision 2.0.1.4 88/09/07 16:55:41 lwall
* patch14: case insensitive search speedup
*
***************
*** 676,682 ****
stab2arg(A_WORD,Nullstab),
Nullarg,0); }
| LISTOP expr
! { $$ = make_op($1,2,make_list($2),
stab2arg(A_WORD,Nullstab),
Nullarg,1); }
| LISTOP WORD
--- 679,685 ----
stab2arg(A_WORD,Nullstab),
Nullarg,0); }
| LISTOP expr
! { $$ = make_op($1,2,maybelistish($1,make_list($2)),
stab2arg(A_WORD,Nullstab),
Nullarg,1); }
| LISTOP WORD
***************
*** 685,695 ****
stab2arg(A_WORD,stabent($2,TRUE)),
Nullarg,1); }
| LISTOP WORD expr
! { $$ = make_op($1,2,make_list($3),
stab2arg(A_WORD,stabent($2,TRUE)),
Nullarg,1); }
| LISTOP REG expr
! { $$ = make_op($1,2,make_list($3),
stab2arg(A_STAB,$2),
Nullarg,1); }
;
--- 688,698 ----
stab2arg(A_WORD,stabent($2,TRUE)),
Nullarg,1); }
| LISTOP WORD expr
! { $$ = make_op($1,2,maybelistish($1,make_list($3)),
stab2arg(A_WORD,stabent($2,TRUE)),
Nullarg,1); }
| LISTOP REG expr
! { $$ = make_op($1,2,maybelistish($1,make_list($3)),
stab2arg(A_STAB,$2),
Nullarg,1); }
;
Index: perly.c
Prereq: 2.0.1.7
*** perly.c.old Mon Oct 31 16:54:45 1988
--- perly.c Mon Oct 31 16:54:52 1988
***************
*** 1,6 ****
! char rcsid[] = "$Header: perly.c,v 2.0.1.7 88/09/07 16:57:47 lwall Exp $";
/*
* $Log: perly.c,v $
* Revision 2.0.1.7 88/09/07 16:57:47 lwall
* patch14: $foo = `echo $foo` now works right
* patch14: % should now work with a negative left argument
--- 1,11 ----
! char rcsid[] = "$Header: perly.c,v 2.0.1.8 88/10/31 16:44:49 lwall Locked $";
/*
* $Log: perly.c,v $
+ * Revision 2.0.1.8 88/10/31 16:44:49 lwall
+ * patch15: now suppresses -S if / is anywhere in script name.
+ * patch15: some support for defective 286 compilers
+ * patch15: printf "%%" is now more consistent
+ *
* Revision 2.0.1.7 88/09/07 16:57:47 lwall
* patch14: $foo = `echo $foo` now works right
* patch14: % should now work with a negative left argument
***************
*** 203,209 ****
if (argv[0] == Nullch)
argv[0] = "-";
! if (dosearch && argv[0][0] != '/' && (s = getenv("PATH"))) {
char *xfound = Nullch, *xfailed = Nullch;
while (*s) {
--- 208,214 ----
if (argv[0] == Nullch)
argv[0] = "-";
! if (dosearch && !index(argv[0], '/') && (s = getenv("PATH"))) {
char *xfound = Nullch, *xfailed = Nullch;
while (*s) {
***************
*** 1410,1416 ****
--- 1415,1432 ----
str_numset(str,value);
break;
case O_ORD:
+ #ifndef I286
str_numset(str,(double)(*str_get(s1)));
+ #else
+ {
+ int zapc;
+ char *zaps;
+
+ zaps = str_get(s1);
+ zapc = (int) *zaps;
+ str_numset(str,(double)(zapc));
+ }
+ #endif
break;
}
if (str) {
***************
*** 1631,1636 ****
--- 1647,1662 ----
arg = make_op(O_LIST,1,arg,Nullarg,Nullarg,0);
arg[1].arg_flags &= ~AF_SPECIAL;
}
+ return arg;
+ }
+
+ ARG *
+ maybelistish(optype, arg)
+ unsigned int optype;
+ ARG *arg;
+ {
+ if (optype == O_PRTF)
+ arg = listish(arg);
return arg;
}
Index: util.c
Prereq: 2.0.1.4
*** util.c.old Mon Oct 31 16:55:06 1988
--- util.c Mon Oct 31 16:55:08 1988
***************
*** 1,6 ****
! /* $Header: util.c,v 2.0.1.4 88/09/07 17:12:49 lwall Exp $
*
* $Log: util.c,v $
* Revision 2.0.1.4 88/09/07 17:12:49 lwall
* patch14: case insensitive search speedup
* patch14: searches should now work on chars with the 128 bit set
--- 1,11 ----
! /* $Header: util.c,v 2.0.1.5 88/10/31 16:51:04 lwall Locked $
*
* $Log: util.c,v $
+ * Revision 2.0.1.5 88/10/31 16:51:04 lwall
+ * patch15: some support for defective 286 compilers
+ * patch15: support for varargs and vprintf
+ * patch15: fix for signed/unsigned conflicts introduced in patch 14
+ *
* Revision 2.0.1.4 88/09/07 17:12:49 lwall
* patch14: case insensitive search speedup
* patch14: searches should now work on chars with the 128 bit set
***************
*** 22,27 ****
--- 27,36 ----
#include "EXTERN.h"
#include "perl.h"
+ #ifdef VARARGS
+ # include <varargs.h>
+ #endif
+
#define FLUSH
static char nomem[] = "Out of memory!\n";
***************
*** 41,48 ****
--- 50,62 ----
ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */
#ifdef DEBUGGING
+ # ifndef I286
if (debug & 128)
fprintf(stderr,"0x%x: (%05d) malloc %d bytes\n",ptr,an++,size);
+ # else
+ if (debug & 128)
+ fprintf(stderr,"0x%lx: (%05d) malloc %d bytes\n",ptr,an++,size);
+ # endif
#endif
if (ptr != Nullch)
return ptr;
***************
*** 67,76 ****
--- 81,97 ----
fatal("Null realloc");
ptr = realloc(where,size?size:1); /* realloc(0) is NASTY on our system */
#ifdef DEBUGGING
+ # ifndef I286
if (debug & 128) {
fprintf(stderr,"0x%x: (%05d) rfree\n",where,an++);
fprintf(stderr,"0x%x: (%05d) realloc %d bytes\n",ptr,an++,size);
}
+ # else
+ if (debug & 128) {
+ fprintf(stderr,"0x%lx: (%05d) rfree\n",where,an++);
+ fprintf(stderr,"0x%lx: (%05d) realloc %d bytes\n",ptr,an++,size);
+ }
+ # endif
#endif
if (ptr != Nullch)
return ptr;
***************
*** 87,94 ****
--- 108,120 ----
char *where;
{
#ifdef DEBUGGING
+ # ifndef I286
if (debug & 128)
fprintf(stderr,"0x%x: (%05d) free\n",where,an++);
+ # else
+ if (debug & 128)
+ fprintf(stderr,"0x%lx: (%05d) free\n",where,an++);
+ # endif
#endif
if (where) {
free(where);
***************
*** 306,323 ****
int frequency = 256;
str_grow(str,len+256);
! table = str->str_ptr + len; /* actually points at final '\0' */
s = table - 1;
for (i = 1; i < 256; i++) {
table[i] = len;
}
i = 0;
! while (s >= str->str_ptr) {
if (!isascii(*s))
return;
if (table[*s] == len) {
if (iflag)
table[*s] = table[fold[*s]] = i;
else
table[*s] = i;
}
--- 332,358 ----
int frequency = 256;
str_grow(str,len+256);
! table = (unsigned char*)str->str_ptr + len; /* really points at final '\0'*/
s = table - 1;
for (i = 1; i < 256; i++) {
table[i] = len;
}
i = 0;
! while (s >= (unsigned char*)str->str_ptr) {
if (!isascii(*s))
return;
if (table[*s] == len) {
+ #ifndef pdp11
if (iflag)
table[*s] = table[fold[*s]] = i;
+ #else
+ if (iflag) {
+ int j;
+ j = fold[*s];
+ table[j] = i;
+ table[*s] = i;
+ }
+ #endif /* pdp11 */
else
table[*s] = i;
}
***************
*** 325,331 ****
}
str->str_pok |= 2; /* deep magic */
! s = str->str_ptr; /* deeper magic */
if (iflag) {
register int tmp, foldtmp;
str->str_pok |= 8;
--- 360,366 ----
}
str->str_pok |= 2; /* deep magic */
! s = (unsigned char*)str->str_ptr; /* deeper magic */
if (iflag) {
register int tmp, foldtmp;
str->str_pok |= 8;
***************
*** 366,372 ****
register int tmp;
register char *little = littlestr->str_ptr;
int littlelen = littlestr->str_cur;
! register char *table = little + littlelen;
s = big + biglen - littlelen;
while (s >= big) {
--- 401,407 ----
register int tmp;
register char *little = littlestr->str_ptr;
int littlelen = littlestr->str_cur;
! register char *table = (unsigned char*)little + littlelen;
s = big + biglen - littlelen;
while (s >= big) {
***************
*** 385,392 ****
char *
fbminstr(big, bigend, littlestr)
! char *big;
! register char *bigend;
STR *littlestr;
{
register unsigned char *s;
--- 420,427 ----
char *
fbminstr(big, bigend, littlestr)
! unsigned char *big;
! register unsigned char *bigend;
STR *littlestr;
{
register unsigned char *s;
***************
*** 402,408 ****
return instr(big,littlestr->str_ptr);
littlelen = littlestr->str_cur;
! table = littlestr->str_ptr + littlelen;
s = big + --littlelen;
oldlittle = little = table - 1;
if (littlestr->str_pok & 8) { /* case insensitive? */
--- 437,443 ----
return instr(big,littlestr->str_ptr);
littlelen = littlestr->str_cur;
! table = (unsigned char*)littlestr->str_ptr + littlelen;
s = big + --littlelen;
oldlittle = little = table - 1;
if (littlestr->str_pok & 8) { /* case insensitive? */
***************
*** 423,429 ****
goto top1;
return Nullch;
}
! return s;
}
}
}
--- 458,464 ----
goto top1;
return Nullch;
}
! return (char *)s;
}
}
}
***************
*** 445,451 ****
goto top2;
return Nullch;
}
! return s;
}
}
}
--- 480,486 ----
goto top2;
return Nullch;
}
! return (char *)s;
}
}
}
***************
*** 458,464 ****
STR *littlestr;
{
register unsigned char *s, *x;
! register unsigned char *big = bigstr->str_ptr;
register int pos;
register int previous;
register int first;
--- 493,499 ----
STR *littlestr;
{
register unsigned char *s, *x;
! register unsigned char *big = (unsigned char *)bigstr->str_ptr;
register int pos;
register int previous;
register int first;
***************
*** 466,472 ****
if ((pos = screamfirst[littlestr->str_rare]) < 0)
return Nullch;
! little = littlestr->str_ptr;
first = *little++;
previous = littlestr->str_prev;
big -= previous;
--- 501,507 ----
if ((pos = screamfirst[littlestr->str_rare]) < 0)
return Nullch;
! little = (unsigned char *)littlestr->str_ptr;
first = *little++;
previous = littlestr->str_prev;
big -= previous;
***************
*** 487,493 ****
}
}
if (!*s)
! return big+pos;
} while (pos += screamnext[pos]);
}
else {
--- 522,528 ----
}
}
if (!*s)
! return (char *)big+pos;
} while (pos += screamnext[pos]);
}
else {
***************
*** 503,509 ****
}
}
if (!*s)
! return big+pos;
} while (pos += screamnext[pos]);
}
return Nullch;
--- 538,544 ----
}
}
if (!*s)
! return (char *)big+pos;
} while (pos += screamnext[pos]);
}
return Nullch;
***************
*** 540,545 ****
--- 575,581 ----
extern int errno;
+ #ifndef VARARGS
/*VARARGS1*/
mess(pat,a1,a2,a3,a4)
char *pat;
***************
*** 598,604 ****
--- 634,709 ----
fputs(buf,stderr);
fflush(stderr);
}
+ #else
+ /*VARARGS1*/
+ mess(args)
+ va_list args;
+ {
+ char *pat;
+ char *s;
+ char *vsprintf();
+ s = buf;
+ pat = va_arg(args, char *);
+ (void) vsprintf(s,pat,args);
+
+ s += strlen(s);
+ if (s[-1] != '\n') {
+ if (line) {
+ sprintf(s," at %s line %ld",
+ in_eval?filename:origfilename, (long)line);
+ s += strlen(s);
+ }
+ if (last_in_stab &&
+ last_in_stab->stab_io &&
+ last_in_stab->stab_io->lines ) {
+ sprintf(s,", <%s> line %ld",
+ last_in_stab == argvstab ? "" : last_in_stab->stab_name,
+ (long)last_in_stab->stab_io->lines);
+ s += strlen(s);
+ }
+ strcpy(s,".\n");
+ }
+ }
+
+ /*VARARGS1*/
+ fatal(va_alist)
+ va_dcl
+ {
+ va_list args;
+ extern FILE *e_fp;
+ extern char *e_tmpname;
+
+ va_start(args);
+ mess(args);
+ va_end(args);
+ if (in_eval) {
+ str_set(stabent("@",TRUE)->stab_val,buf);
+ longjmp(eval_env,1);
+ }
+ fputs(buf,stderr);
+ fflush(stderr);
+ if (e_fp)
+ UNLINK(e_tmpname);
+ statusvalue >>= 8;
+ exit(errno?errno:(statusvalue?statusvalue:255));
+ }
+
+ /*VARARGS1*/
+ warn(va_alist)
+ va_dcl
+ {
+ va_list args;
+
+ va_start(args);
+ mess(args);
+ va_end(args);
+
+ fputs(buf,stderr);
+ fflush(stderr);
+ }
+ #endif
+
static bool firstsetenv = TRUE;
extern char **environ;
***************
*** 696,698 ****
--- 801,831 ----
}
#endif
#endif
+
+ #ifdef VARARGS
+ #ifndef VPRINTF
+
+ char *
+ vsprintf(dest, pat, args)
+ char *dest, *pat, *args;
+ {
+ FILE fakebuf;
+
+ fakebuf._ptr = dest;
+ fakebuf._cnt = 32767;
+ fakebuf._flag = _IOWRT|_IOSTRG;
+ _doprnt(pat, args, &fakebuf); /* what a kludge */
+ putc('\0', &fakebuf);
+ return(dest);
+ }
+
+ int
+ vfprintf(fd, pat, args)
+ FILE *fd;
+ char *pat, *args;
+ {
+ _doprnt(pat, args, fd);
+ return 0; /* wrong, but perl doesn't use the return value */
+ }
+ #endif /* VPRINTF */
+ #endif /* VARARGS */
More information about the Comp.sources.bugs
mailing list