lwall@jpl-devvax.JPL.NASA.GOV (Larry Wall) (11/01/88)
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@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 */
news@investor.UUCP ( Bob Peirce) (11/10/88)
So what happened to patches 7-14? Did I miss them or are they coming? -- Bob Peirce, Pittsburgh, PA 412-471-5320 uucp: ...!{allegra, bellcore, cadre, idis, psuvax1}!pitt!investor!rbp NOTE: Mail must be < 30K bytes/message
yun@ceetm1.UUCP (Yun-seng Chao) (11/11/88)
From article <1037@investor.UUCP>, by news@investor.UUCP ( Bob Peirce): > So what happened to patches 7-14? Did I miss them or are they coming? > They have come and gone. Anyway, there is a slight error in #15 in the patch for utils.c. I am on an AT&T 3B2/400 with SVR3.0. The "util.c" file with patch15 won't compile. I've enclosed the diff between the original version and mine. %diff util.c util.old.c 644c644 < int vsprintf(); > char *vsprintf(); <varargs.h> in the _UNIX System V Programmer's Reference Manual_ has the following entries under "vprintf(3S)": int vsprintf(s, format, ap) char *s, *format; va_list ap; Other than that, everything went as smoothly as usual. -- =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= Yun-seng Chao; Cincinnati Electronics, Corp.; Cincinnati, Ohio UUCP: {uccba.uc.edu, decuac!uccba, uunet!sdrc, ukma!spca6}!cesbws!yun VOICE: (513)-733-6370