lroot@jpl-devvax.JPL.NASA.GOV (The Superuser) (08/04/88)
System: perl version 2.0 Patch #: 11 Priority: MEDIUM-RARE Subject: in Configure, more portability for libc scanning Subject: in Configure, default on setuid emulation is now "no" Subject: in Configure, cleared up some difficuties in void support detection Subject: in Configure, randbits default was sometimes too big Subject: in Configure, manual pages can now default to manl Subject: in Configure, you can now specify which C compiler to use Subject: make install doesn't modify current directory any more Subject: join of null array could leave destination string non-null Subject: new open for read/write mode from Bruce Simons Subject: workaround for Ultrix 1.2 end-of-file bug Subject: unlink needed to use lstat instead of stat (if available) Subject: fixed some possible null dereferences in debugging code Subject: couldn't mix two ways of returning values from subroutines Subject: "last" didn't properly terminate a "foreach" Subject: support for incompetent 386 compiler Subject: support for Sun compiler that can't cast double to unsigned long Subject: support for busted compilers that can't cast relational to double Subject: some support for crippled compilers that don't grok str_get macro Subject: support for botched C compilers that ungrok && outside of conditionals Subject: guarded an lstat with #ifdef SYMLINK instead of S_IFLNK, which lies Subject: str_peek improperly reused a buffer Subject: declared j() Subject: fixed join('a','b') Subject: suidperl would only run scripts setuid to something other than root Subject: removed a spurious call to safemalloc() Subject: new multiple subscript feature didn't work right Subject: do $filename; got mixed up in the eval cache Subject: deleted regchar() Subject: fixed some pointer arithmetic that didn't work on the 286 Subject: fixed $+ to work as documented Subject: added sanity check on $- going negative Subject: added test for multiple subscript arrays Subject: removed unsupported join syntax Subject: in op.stat, noted that Xenix 386 thinks /dev/null is a tty Subject: unterminated literal strings blew up tokener in eval Subject: in a2p, newlines weren't allowed following comma Subject: in a2p, numbers couldn't start with '.' Subject: a2p was being really stupid about comparisons with literal strings Subject: a2p tried to make a local declaration on a null argument list Subject: in a2p, fixed possible null pointer dereference Description: In Configure, the scan of the libc library now supports several new forms of nm output--particularly the new System V format. The default on setuid emulation is now "no", since most systems probably haven't disabled setuid scripts, or don't have #! scripts in the first place. The void support detection has been cleaned up some, and the randbits detection had a bug that could make it look like your rand() returned more bits than it really does. Last but not least, you can now specify which C compiler to use. That's mostly for people who want to use Gnu cc. Saying "make install" doesn't modify current directory any more. It used to chmod +x makedir and cat the parts of the perl manual together. This makes it hard on people who compile under one uid and install under root like they ought. Inside of a loop, joining a null array could leave the destination string non-null if the last time through the loop joined a non-null array. Got that? Bruce Simons has donated a new feature: if you say open(active,"+</usr/lib/news/active"); # note the "+" you can do both reads and writes on the file. Likewise for "+>" and "+>>". Perl now compensates for Ultrix 1.2 systems that wrongly bump the file pointer every time you do <> at end-of-file. The unlink operator wouldn't let you unlink a symbolic link to something that didn't exist because the stat() failed on it. Now it used lstat() instead. (The lstat() is necessary to prevent perl from unlinking directories inadvertently.) The debugging code in cmd.c could print dereference nulls when entering or exiting loops without labels. You couldn't use a return statement in a subroutine, and also return a value at the end of the subroutine without using another return statement. Now you can. This was particularly embarrassing because a2p went to some length to optimize away that last return, since it's a little less efficient. The "last" operator didn't properly exit from a "foreach", so that you couldn't restart the loop next time. Now it does. You still can only bomb out to the end of the foreach loop--bombing out to an outer loop still has the same problem, which involves longjmp() bypassing some code that needs to run. One of these months I'll fix that. Some incompetent 386 compilers get heartburn over some of the pointer expressions in arg.c. There's some special code that's enclosed in #ifdef M_I386 for such compilers. It seems the Sun compiler can't cast double to unsigned long. Casting to long works and preserves the sign bit. At the risk of some lint complaints perl now does bitwise operations by casting doubles to long and then assigning that to an unsigned long variable. I hope it works everywhere else. Some C compilers can't cast the result of a relational operator to a double. Perl now uses "(expr)? 1.0 : 0.0" to get around that. Some C compilers can't parse the str_get macro. If you define CRIPPLED_CC you can have it as a subroutine instead, which will be somewhat slower. Some silly C compilers improperly optimize out of existence the left side of an && if it isn't used inside a conditional. The STABSET macro made use of this, so I made it use an if instead, to the detriment of the usefulness of the STABSET macro. There was a call to lstat() that was inside an #ifdef S_IFLNK. Unfortunately there are machines that define S_IFLNK that don't have lstat() or symlink(). I made it depend on SYMLINK instead. The str_peek() macro reused a buffer that other debugging code was also trying to use, resulting in bogus trace messages on assignments. The useless construct join('a','b') stumbled into some obsolete code and blew up. It now returns 'b' as expected. The optional suidperl is intended to emulate setuid processing on machines where setuid shell scripts are disabled for security reasons. Unfortunately I had the code a little too tight, and suidperl would only run scripts setuid to anything other than root. At my site, the passwd program is a perl script, and it didn't work too hot not being setuid root... The new multiple subscript feature didn't work right because I only tested it by eyeballing the syntax tree, and I missed the fact that it neglected to transform comma operators into a list, so the implicit join only joined the last subscript. There's now a test in the validation suite for it. When I added s/foo/bar/e I put in a 1-deep cache for the last string eval'ed. Unfortunated there was some destructive interference with the "do $filename;" operation, which shares some of the same code. The regchar() function was no longer used, so it's gone. regexp.c had some code (put there by me, not Henry Spencer) that assumed you could do pointer arithmetic between strings in different structures. No workee on the 286, which has segments. $+ was busted since we converted to the regexp code. Instead of giving the last paren matched it was giving the first paren of the last top-level alternative, because I forgot that it actually matches parens right to left in the backtracking phase. There was an undocumented syntax for join left over from the dark ages. I've removed it. Xenix 386 thinks /dev/null is a tty. This causes test 39 of op.stat to fail. I just made it print a little reassurance for 386 users. If you called eval on a string containing unbalanced quotes, the tokener didn't properly produce an EOF indication, except to blow up. The a2p program couldn't parse newlines or comments after a comma, nor numbers beginning with a '.'. If you had a subroutine that took no arguments, a2p produced "local() = @_;". Thanks: to all you nitpickers out there. Keep those cards and letters coming. You may make perl a useful program yet. 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 NOTHING *** Apply patch 12 before recompiling. 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: 10 1c1 < #define PATCHLEVEL 10 --- > #define PATCHLEVEL 11 Index: Configure Prereq: 2.0.1.2 *** Configure.old Wed Aug 3 22:54:53 1988 --- Configure Wed Aug 3 22:54:56 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.2 88/07/11 22:16:34 root Exp $ # # 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.3 88/08/03 21:59:07 root Exp $ # # Yes, you may rip this off to use in other distribution packages. # (Note: this Configure script was generated automatically. Rather than *************** *** 158,166 **** attrlist="$attrlist vax pdp11 i8086 z8000 u3b2 u3b5 u3b20 u3b200" attrlist="$attrlist ns32000 ns16000 iAPX286 mc300 mc500 mc700 sparc" attrlist="$attrlist nsc32000 sinix xenix venix posix ansi M_XENIX" ! attrlist="$attrlist $mc68k __STDC__" pth="/usr/ucb /bin /usr/bin /usr/local /usr/local/bin /usr/lbin /etc /usr/lib /lib" ! d_newshome="../../NeWS" defvoidused=7 : some greps do not return status, grrr. --- 158,166 ---- attrlist="$attrlist vax pdp11 i8086 z8000 u3b2 u3b5 u3b20 u3b200" attrlist="$attrlist ns32000 ns16000 iAPX286 mc300 mc500 mc700 sparc" attrlist="$attrlist nsc32000 sinix xenix venix posix ansi M_XENIX" ! attrlist="$attrlist $mc68k __STDC__ UTS M_I8086 M_I186 M_I286 M_I386" pth="/usr/ucb /bin /usr/bin /usr/local /usr/local/bin /usr/lbin /etc /usr/lib /lib" ! d_newshome="/usr/NeWS" defvoidused=7 : some greps do not return status, grrr. *************** *** 474,484 **** fi echo " " $echo $n "Extracting names from $libc for later perusal...$c" ! nm $libc 2>/dev/null | sed -n -e 's/^.* T _//p' -e 's/^.* T //p' > libc.list if $contains '^printf$' libc.list >/dev/null 2>&1; then echo "done" else ! nm $libc 2>/dev/null | sed -n -e 's/^.* D _//p' -e 's/^.* D //p' > libc.list if $contains '^printf$' libc.list >/dev/null 2>&1; then echo "done" else --- 474,488 ---- fi echo " " $echo $n "Extracting names from $libc for later perusal...$c" ! nm $libc 2>/dev/null >libc.tmp ! sed -n -e 's/^.* [AT] _//p' -e 's/^.* [AT] //p' <libc.tmp >libc.list if $contains '^printf$' libc.list >/dev/null 2>&1; then echo "done" else ! sed -n -e 's/^.* D _//p' -e 's/^.* D //p' <libc.tmp >libc.list ! $contains '^printf$' libc.list >/dev/null 2>&1 || \ ! sed -n -e 's/^_//' \ ! -e 's/^\([a-zA-Z_0-9]*\).*xtern.*text.*/\1/p' <libc.tmp >libc.list if $contains '^printf$' libc.list >/dev/null 2>&1; then echo "done" else *************** *** 485,491 **** echo " " echo "nm didn't seem to work right." echo "Trying ar instead..." - rmlist="$rmlist libc.tmp" if ar t $libc > libc.tmp; then sed -e 's/\.o$//' < libc.tmp > libc.list echo "Ok." --- 489,494 ---- *************** *** 501,507 **** fi fi fi ! rmlist="$rmlist libc.list" : make some quick guesses about what we are up against echo " " --- 504,510 ---- fi fi fi ! rmlist="$rmlist libc.tmp libc.list" : make some quick guesses about what we are up against echo " " *************** *** 748,759 **** : now see if they want to do setuid emulation case "$d_dosuid" in ! '') if bsd; then ! dflt=y ! else ! dflt=n ! fi ! ;; *undef*) dflt=n;; *) dflt=y;; esac --- 751,757 ---- : now see if they want to do setuid emulation case "$d_dosuid" in ! '') dflt=n;; *undef*) dflt=n;; *) dflt=y;; esac *************** *** 1028,1041 **** #else main() { #endif ! extern void *moo(); ! void *(*goo)(); #if TRY & 2 void (*foo[10])(); #endif #if TRY & 4 ! if(*goo == moo) { exit(0); } #endif --- 1026,1039 ---- #else main() { #endif ! extern void moo(); /* function returning void */ ! void (*goo)(); /* ptr to func returning void */ #if TRY & 2 void (*foo[10])(); #endif #if TRY & 4 ! if(goo == moo) { exit(0); } #endif *************** *** 1170,1176 **** { register int i; register unsigned long tmp; ! register unsigned long max; for (i=1000; i; i--) { tmp = (unsigned long)rand(); --- 1168,1174 ---- { register int i; register unsigned long tmp; ! register unsigned long max = 0L; for (i=1000; i; i--) { tmp = (unsigned long)rand(); *************** *** 1268,1274 **** : determine where manual pages go case "$mansrc" in '') ! dflt=`loc . /usr/man/man1 /usr/man/mann /usr/man/local/man1 /usr/man/u_man/man1 /usr/man/man1` ;; *) dflt="$mansrc" ;; --- 1266,1272 ---- : determine where manual pages go case "$mansrc" in '') ! dflt=`loc . /usr/man/man1 /usr/man/mann /usr/man/manl /usr/man/local/man1 /usr/man/u_man/man1 /usr/man/man1` ;; *) dflt="$mansrc" ;; *************** *** 1569,1575 **** references that happen to have the same name. On some such systems the "Mcc" command may be used to force these to be resolved. On other systems a "cc -M" command is required. (Note that the -M flag on other systems ! indicates a memory model to use!) What command will force resolution on EOM $echo $n "this system? [$dflt] $c" rp="Command to resolve multiple refs? [$dflt]" --- 1567,1574 ---- references that happen to have the same name. On some such systems the "Mcc" command may be used to force these to be resolved. On other systems a "cc -M" command is required. (Note that the -M flag on other systems ! indicates a memory model to use!) If you have the Gnu C compiler, you ! might wish to use that instead. What command will force resolution on EOM $echo $n "this system? [$dflt] $c" rp="Command to resolve multiple refs? [$dflt]" *************** *** 1576,1583 **** . myread cc="$ans" else ! echo "Not a USG system--assuming cc can resolve multiple definitions." ! cc=cc fi : see if we should include -lnm --- 1575,1588 ---- . myread cc="$ans" else ! case "$cc" in ! '') dflt=cc;; ! *) dflt="$cc";; ! esac ! rp="Use which C compiler? [$dflt]" ! $echo $n "$rp $c" ! . myread ! cc="$ans" fi : see if we should include -lnm Index: Makefile.SH Prereq: 2.0.1.3 *** Makefile.SH.old Wed Aug 3 22:55:03 1988 --- Makefile.SH Wed Aug 3 22:55:04 1988 *************** *** 25,33 **** echo "Extracting Makefile (with variable substitutions)" cat >Makefile <<!GROK!THIS! ! # $Header: Makefile.SH,v 2.0.1.3 88/07/12 17:11:56 root Exp $ # # $Log: Makefile.SH,v $ # Revision 2.0.1.3 88/07/12 17:11:56 root # patch6: Now it's 23 shift/reduce errors # --- 25,37 ---- echo "Extracting Makefile (with variable substitutions)" cat >Makefile <<!GROK!THIS! ! # $Header: Makefile.SH,v 2.0.1.4 88/08/03 22:00:44 root Exp $ # # $Log: Makefile.SH,v $ + # Revision 2.0.1.4 88/08/03 22:00:44 root + # + # patch11: make install doesn't modify current directory any more + # # Revision 2.0.1.3 88/07/12 17:11:56 root # patch6: Now it's 23 shift/reduce errors # *************** *** 97,103 **** .c.o: $(CC) -c $(CFLAGS) $(LARGE) $*.c ! all: $(public) $(private) $(util) touch all perl: perly.o $(obj) perl.o --- 101,107 ---- .c.o: $(CC) -c $(CFLAGS) $(LARGE) $*.c ! all: $(public) $(private) $(util) perl.man touch all perl: perly.o $(obj) perl.o *************** *** 139,145 **** perl.man: perl.man.1 perl.man.2 cat perl.man.1 perl.man.2 >perl.man ! install: perl perl.man # won't work with csh export PATH || exit 1 - mv $(bin)/perl $(bin)/perl.old 2>/dev/null --- 143,149 ---- perl.man: perl.man.1 perl.man.2 cat perl.man.1 perl.man.2 >perl.man ! install: all # won't work with csh export PATH || exit 1 - mv $(bin)/perl $(bin)/perl.old 2>/dev/null *************** *** 161,168 **** cat >>Makefile <<'!NO!SUBS!' - test $(bin) = /usr/bin || rm -f /usr/bin/perl - test $(bin) = /usr/bin || $(SLN) $(bin)/perl /usr/bin || cp $(bin)/perl /usr/bin ! chmod +x makedir ! - ./makedir $(lib) - \ if test `pwd` != $(lib); then \ cp $(private) lib/*.pl $(lib); \ --- 165,171 ---- cat >>Makefile <<'!NO!SUBS!' - test $(bin) = /usr/bin || rm -f /usr/bin/perl - test $(bin) = /usr/bin || $(SLN) $(bin)/perl /usr/bin || cp $(bin)/perl /usr/bin ! - sh ./makedir $(lib) - \ if test `pwd` != $(lib); then \ cp $(private) lib/*.pl $(lib); \ Index: Wishlist *** Wishlist.old Wed Aug 3 22:55:07 1988 --- Wishlist Wed Aug 3 22:55:08 1988 *************** *** 1,4 **** date support case statement ioctl() support ! random numbers --- 1,9 ---- date support case statement ioctl() support ! general expressions in formats ! round ! better format pictures ! setpgrp ! getppid ! nice Index: x2p/a2p.y Prereq: 2.0.1.1 *** x2p/a2p.y.old Wed Aug 3 22:57:54 1988 --- x2p/a2p.y Wed Aug 3 22:57:55 1988 *************** *** 1,7 **** %{ ! /* $Header: a2p.y,v 2.0.1.1 88/07/11 23:20:14 root Exp $ * * $Log: a2p.y,v $ * Revision 2.0.1.1 88/07/11 23:20:14 root * patch2: changes to support translation of 1985 awk * --- 1,10 ---- %{ ! /* $Header: a2p.y,v 2.0.1.2 88/08/03 22:49:27 root Exp $ * * $Log: a2p.y,v $ + * Revision 2.0.1.2 88/08/03 22:49:27 root + * patch11: in a2p, newlines weren't allowed following comma + * * Revision 2.0.1.1 88/07/11 23:20:14 root * patch2: changes to support translation of 1985 awk * *************** *** 266,275 **** { $$ = Nullop; } ; ! clist : expr ',' expr ! { $$ = oper2(OCOMMA,$1,$3); } ! | clist ',' expr ! { $$ = oper2(OCOMMA,$1,$3); } | '(' clist ')' /* these parens are invisible */ { $$ = $2; } ; --- 269,278 ---- { $$ = Nullop; } ; ! clist : expr ',' maybe expr ! { $$ = oper3(OCOMMA,$1,$3,$4); } ! | clist ',' maybe expr ! { $$ = oper3(OCOMMA,$1,$3,$4); } | '(' clist ')' /* these parens are invisible */ { $$ = $2; } ; Index: x2p/a2py.c Prereq: 2.0.1.1 *** x2p/a2py.c.old Wed Aug 3 22:58:00 1988 --- x2p/a2py.c Wed Aug 3 22:58:01 1988 *************** *** 1,6 **** ! /* $Header: a2py.c,v 2.0.1.1 88/07/11 23:25:33 root Exp $ * * $Log: a2py.c,v $ * Revision 2.0.1.1 88/07/11 23:25:33 root * patch2: changes to support translation of 1985 awk * patch2: now fixes any perl reserved words it finds --- 1,9 ---- ! /* $Header: a2py.c,v 2.0.1.2 88/08/03 22:50:05 root Exp $ * * $Log: a2py.c,v $ + * Revision 2.0.1.2 88/08/03 22:50:05 root + * patch11: in a2p, numbers couldn't start with '.' + * * Revision 2.0.1.1 88/07/11 23:25:33 root * patch2: changes to support translation of 1985 awk * patch2: now fixes any perl reserved words it finds *************** *** 370,376 **** XTERM(tmp); case '0': case '1': case '2': case '3': case '4': ! case '5': case '6': case '7': case '8': case '9': s = scannum(s); XOP(NUMBER); case '"': --- 373,379 ---- XTERM(tmp); case '0': case '1': case '2': case '3': case '4': ! case '5': case '6': case '7': case '8': case '9': case '.': s = scannum(s); XOP(NUMBER); case '"': Index: arg.c Prereq: 2.0.1.2 *** arg.c.old Wed Aug 3 22:55:15 1988 --- arg.c Wed Aug 3 22:55:17 1988 *************** *** 1,6 **** ! /* $Header: arg.c,v 2.0.1.2 88/07/12 17:13:14 root Exp $ * * $Log: arg.c,v $ * Revision 2.0.1.2 88/07/12 17:13:14 root * patch6: removed useless assignment * --- 1,13 ---- ! /* $Header: arg.c,v 2.0.1.3 88/08/03 22:06:41 root Exp $ * * $Log: arg.c,v $ + * Revision 2.0.1.3 88/08/03 22:06:41 root + * patch11: support for broken 386 compiler + * patch11: join of null array could leave destination string non-null + * patch11: new open for read/write mode from Bruce Simons + * patch11: workaround for Ultrix 1.2 end-of-file bug + * patch11: unlink needed to use lstat instead of stat (if available) + * * Revision 2.0.1.2 88/07/12 17:13:14 root * patch6: removed useless assignment * *************** *** 146,156 **** --- 153,173 ---- gotcha: if (retary && curspat == spat) { int iters, i, len; + #ifdef M_I386 + int tmpint; + char *tmpptr; + #endif /* M_I386 */ iters = spat->spat_regexp->nparens; *ptrmaxsarg = iters + sargoff; + #ifndef M_I386 sarg = (STR**)saferealloc((char*)(sarg - sargoff), (iters+2+cushion+sargoff)*sizeof(STR*)) + sargoff; + #else + tmpint=(iters+2+cushion+sargoff)*sizeof(STR*); + tmpptr=(char *)(sarg-sargoff); + sarg = (STR**)saferealloc(tmpptr, tmpint) + sargoff; + #endif /* M_I386 */ for (i = 1; i <= iters; i++) { sarg[i] = str_static(&str_no); *************** *** 402,411 **** --- 419,437 ---- iters--; } if (retary) { + #ifndef M_I386 *ptrmaxsarg = iters + sargoff; sarg = (STR**)saferealloc((char*)(sarg - sargoff), (iters+2+cushion+sargoff)*sizeof(STR*)) + sargoff; + #else + int tmpint; + char *tmpptr; + *ptrmaxsarg = iters + sargoff; + tmpint=(iters+2+cushion+sargoff)*sizeof(STR*); + tmpptr=(char *)(sarg-sargoff); + sarg = (STR**)saferealloc(tmpptr, tmpint) + sargoff; + #endif /* M_I386 */ for (i = 1; i <= iters; i++) sarg[i] = afetch(ary,i-1); *retary = sarg; *************** *** 428,433 **** --- 454,461 ---- elem = tmpary+1; if (items-- > 0) str_sset(str,*elem++); + else + str_set(str,""); for (; items > 0; items--,elem++) { str_cat(str,delim); str_scat(str,*elem); *************** *** 490,495 **** --- 518,524 ---- char *myname = savestr(name); int result; int fd; + char mode[3]; /* stdio file mode ("r\0" or "r+\0") */ name = myname; forkprocess = 1; /* assume true if no fork */ *************** *** 510,515 **** --- 539,552 ---- stab->stab_name); stio->fp = Nullfp; } + if (*name == '+' && len > 1 && name[len-1] != '|') { /* scary */ + mode[1] = *name++; + mode[2] = '\0'; + --len; + } + else { + mode[1] = '\0'; + } stio->type = *name; if (*name == '|') { for (name++; isspace(*name); name++) ; *************** *** 522,530 **** } } else if (*name == '>' && name[1] == '>') { ! stio->type = 'a'; for (name += 2; isspace(*name); name++) ; ! fp = fopen(name,"a"); } else if (*name == '>' && name[1] == '&') { for (name += 2; isspace(*name); name++) ; --- 559,567 ---- } } else if (*name == '>' && name[1] == '>') { ! mode[0] = stio->type = 'a'; for (name += 2; isspace(*name); name++) ; ! fp = fopen(name, mode); } else if (*name == '>' && name[1] == '&') { for (name += 2; isspace(*name); name++) ; *************** *** 548,555 **** fp = stdout; stio->type = '-'; } ! else ! fp = fopen(name,"w"); } else { if (*name == '<') { --- 585,594 ---- fp = stdout; stio->type = '-'; } ! else { ! mode[0] = 'w'; ! fp = fopen(name,mode); ! } } else { if (*name == '<') { *************** *** 558,565 **** fp = stdin; stio->type = '-'; } ! else ! fp = fopen(name,"r"); } else if (name[len-1] == '|') { name[--len] = '\0'; --- 597,606 ---- fp = stdin; stio->type = '-'; } ! else { ! mode[0] = 'r'; ! fp = fopen(name,mode); ! } } else if (name[len-1] == '|') { name[--len] = '\0'; *************** *** 725,731 **** while (stio->fp) { #ifdef STDSTDIO /* (the code works without this) */ ! if (stio->fp->_cnt) /* cheat a little, since */ return FALSE; /* this is the most usual case */ #endif --- 766,772 ---- while (stio->fp) { #ifdef STDSTDIO /* (the code works without this) */ ! if (stio->fp->_cnt > 0) /* cheat a little, since */ return FALSE; /* this is the most usual case */ #endif *************** *** 757,762 **** --- 798,806 ---- if (!stio || !stio->fp) goto phooey; + if (feof(stio->fp)) + (void)fseek (stio->fp, 0L, 2); /* ultrix 1.2 workaround */ + return ftell(stio->fp); phooey: *************** *** 780,785 **** --- 824,832 ---- if (!stio || !stio->fp) goto nuts; + if (feof(stio->fp)) + (void)fseek (stio->fp, 0L, 2); /* ultrix 1.2 workaround */ + return fseek(stio->fp, pos, whence) >= 0; nuts: *************** *** 815,822 **** --- 862,877 ---- max = (int)str_gnum(*tmpary); if (retary) { + #ifndef M_I386 sarg = (STR**)saferealloc((char*)(sarg - sargoff), (max+2+cushion+sargoff)*sizeof(STR*)) + sargoff; + #else + int tmpint; + char *tmpptr; + tmpint=(max+2+cushion+sargoff)*sizeof(STR*); + tmpptr=(char *)(sarg-sargoff); + sarg = (STR**)saferealloc(tmpptr, tmpint) + sargoff; + #endif /* M_I386 */ for (i = 1; i <= max; i++) sarg[i] = tmpary[i]; *retary = sarg; *************** *** 903,908 **** --- 958,967 ---- max = 0; if (retary) { + #ifdef M_I386 + int tmpint; + char *tmpptr; + #endif /* M_I386 */ if (max) { apush(ary,str_nmake((double)statbuf.st_dev)); apush(ary,str_nmake((double)statbuf.st_ino)); *************** *** 924,931 **** --- 983,996 ---- #endif } *ptrmaxsarg = max + sargoff; + #ifndef M_I386 sarg = (STR**)saferealloc((char*)(sarg - sargoff), (max+2+cushion+sargoff)*sizeof(STR*)) + sargoff; + #else + tmpint=(max+2+cushion+sargoff)*sizeof(STR*); + tmpptr=(char *)(sarg-sargoff); + sarg = (STR**)saferealloc(tmpptr, tmpint) + sargoff; + #endif /* M_I386 */ for (i = 1; i <= max; i++) sarg[i] = afetch(ary,i-1); *retary = sarg; *************** *** 1330,1336 **** --- 1395,1405 ---- items--; } else { /* don't let root wipe out directories without -U */ + #ifdef SYMLINK + if (lstat(s,&statbuf) < 0 || + #else if (stat(s,&statbuf) < 0 || + #endif (statbuf.st_mode & S_IFMT) == S_IFDIR ) items--; else { *************** *** 1526,1534 **** --- 1595,1614 ---- apush(ary,str_make(str_get(hiterval(entry)))); } if (retary) { /* array wanted */ + #ifdef M_I386 + int tmpint; + char *tmpptr; + #endif /* M_I386 */ + *ptrmaxsarg = max + sargoff; + #ifndef M_I386 sarg = (STR**)saferealloc((char*)(sarg - sargoff), (max+2+cushion+sargoff)*sizeof(STR*)) + sargoff; + #else + tmpint=(max+2+cushion+sargoff)*sizeof(STR*); + tmpptr=(char *)(sarg-sargoff); + sarg = (STR**)saferealloc(tmpptr, tmpint) + sargoff; + #endif /* M_I386 */ for (i = 1; i <= max; i++) sarg[i] = afetch(ary,i-1); *retary = sarg; *************** *** 1617,1623 **** #ifdef STDSTDIO if (stio->fp->_cnt <= 0) { i = getc(stio->fp); ! ungetc(i,stio->fp); } if (stio->fp->_cnt <= 0) /* null file is anything */ return &str_yes; --- 1697,1704 ---- #ifdef STDSTDIO if (stio->fp->_cnt <= 0) { i = getc(stio->fp); ! if (i != EOF) ! ungetc(i,stio->fp); } if (stio->fp->_cnt <= 0) /* null file is anything */ return &str_yes; Index: array.c Prereq: 2.0 *** array.c.old Wed Aug 3 22:55:24 1988 --- array.c Wed Aug 3 22:55:24 1988 *************** *** 1,6 **** ! /* $Header: array.c,v 2.0 88/06/05 00:08:17 root Exp $ * * $Log: array.c,v $ * Revision 2.0 88/06/05 00:08:17 root * Baseline version 2.0. * --- 1,9 ---- ! /* $Header: array.c,v 2.0.1.1 88/08/03 22:07:51 root Exp $ * * $Log: array.c,v $ + * Revision 2.0.1.1 88/08/03 22:07:51 root + * patch11: commented out unsupported subroutine + * * Revision 2.0 88/06/05 00:08:17 root * Baseline version 2.0. * *************** *** 184,189 **** --- 187,193 ---- astore(ar,fill,Nullstr); } + #ifdef NOTUSED void ajoin(ar,delim,str) register ARRAY *ar; *************** *** 211,213 **** --- 215,218 ---- } STABSET(str); } + #endif Index: cmd.c Prereq: 2.0.1.1 *** cmd.c.old Wed Aug 3 22:55:28 1988 --- cmd.c Wed Aug 3 22:55:29 1988 *************** *** 1,6 **** ! /* $Header: cmd.c,v 2.0.1.1 88/07/11 22:27:13 root Exp $ * * $Log: cmd.c,v $ * Revision 2.0.1.1 88/07/11 22:27:13 root * patch2: $& not set right due to optimization (also added $` and $') * --- 1,11 ---- ! /* $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 + * patch11: "last" didn't properly terminate a "foreach" + * * Revision 2.0.1.1 88/07/11 22:27:13 root * patch2: $& not set right due to optimization (also added $` and $') * *************** *** 105,111 **** #ifdef DEBUGGING if (debug & 4) { deb("(Pushing label #%d %s)\n", ! loop_ptr,cmd->c_label); } #endif } --- 110,116 ---- #ifdef DEBUGGING if (debug & 4) { deb("(Pushing label #%d %s)\n", ! loop_ptr, cmd->c_label ? cmd->c_label : ""); } #endif } *************** *** 139,145 **** debdelim[dlevel++] = '_'; } #endif ! cmd_exec(cmd->ucmd.ccmd.cc_true); } if (!goto_targ) { go_to = Nullch; --- 144,150 ---- debdelim[dlevel++] = '_'; } #endif ! retstr = cmd_exec(cmd->ucmd.ccmd.cc_true); } if (!goto_targ) { go_to = Nullch; *************** *** 155,161 **** debdelim[dlevel++] = '_'; } #endif ! cmd_exec(cmd->ucmd.ccmd.cc_alt); } if (goto_targ) break; --- 160,166 ---- debdelim[dlevel++] = '_'; } #endif ! retstr = cmd_exec(cmd->ucmd.ccmd.cc_alt); } if (goto_targ) break; *************** *** 169,176 **** if (cmdflags & CF_ONCE) { #ifdef DEBUGGING if (debug & 4) { deb("(Popping label #%d %s)\n",loop_ptr, ! loop_stack[loop_ptr].loop_label); } #endif loop_ptr--; --- 174,182 ---- if (cmdflags & CF_ONCE) { #ifdef DEBUGGING if (debug & 4) { + tmps = loop_stack[loop_ptr].loop_label; deb("(Popping label #%d %s)\n",loop_ptr, ! tmps ? tmps : "" ); } #endif loop_ptr--; *************** *** 506,512 **** #ifdef DEBUGGING if (debug & 4) { deb("(Pushing label #%d %s)\n", ! loop_ptr,cmd->c_label); } #endif } --- 512,518 ---- #ifdef DEBUGGING if (debug & 4) { deb("(Pushing label #%d %s)\n", ! loop_ptr, cmd->c_label ? cmd->c_label : ""); } #endif } *************** *** 538,544 **** debdelim[dlevel++] = '_'; } #endif ! cmd_exec(cmd->ucmd.ccmd.cc_true); } /* actually, this spot is rarely reached anymore since the above * cmd_exec() returns through longjmp(). Hooray for structure. --- 544,550 ---- debdelim[dlevel++] = '_'; } #endif ! retstr = cmd_exec(cmd->ucmd.ccmd.cc_true); } /* actually, this spot is rarely reached anymore since the above * cmd_exec() returns through longjmp(). Hooray for structure. *************** *** 554,560 **** debdelim[dlevel++] = '_'; } #endif ! cmd_exec(cmd->ucmd.ccmd.cc_alt); } finish_while: curspat = oldspat; --- 560,566 ---- debdelim[dlevel++] = '_'; } #endif ! retstr = cmd_exec(cmd->ucmd.ccmd.cc_alt); } finish_while: curspat = oldspat; *************** *** 577,589 **** if (cmdflags & CF_ONCE) { #ifdef DEBUGGING if (debug & 4) { ! deb("(Popping label #%d %s)\n",loop_ptr, ! loop_stack[loop_ptr].loop_label); } #endif loop_ptr--; if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY) { cmd->c_stab->stab_val = cmd->c_short; } } cmd = cmd->c_next; --- 583,597 ---- if (cmdflags & CF_ONCE) { #ifdef DEBUGGING if (debug & 4) { ! tmps = loop_stack[loop_ptr].loop_label; ! deb("(Popping label #%d %s)\n",loop_ptr, tmps ? tmps : ""); } #endif loop_ptr--; if ((cmdflags & CF_OPTIMIZE) == CFT_ARRAY) { cmd->c_stab->stab_val = cmd->c_short; + ar = cmd->c_expr[1].arg_ptr.arg_stab->stab_array; + ar->ary_index = -1; } } cmd = cmd->c_next; Index: eval.c Prereq: 2.0.1.4 *** eval.c.old Wed Aug 3 22:55:38 1988 --- eval.c Wed Aug 3 22:55:41 1988 *************** *** 1,6 **** ! /* $Header: eval.c,v 2.0.1.4 88/07/15 01:30:08 root Exp $ * * $Log: eval.c,v $ * Revision 2.0.1.4 88/07/15 01:30:08 root * patch9: delete $ENV{$var} didn't delete environment variable * --- 1,13 ---- ! /* $Header: eval.c,v 2.0.1.5 88/08/03 22:17:04 root Exp $ * * $Log: eval.c,v $ + * Revision 2.0.1.5 88/08/03 22:17:04 root + * patch11: support for incompetent 386 compiler + * patch11: support for Sun compiler that can't cast double to unsigned long. + * patch11: support for busted compilers that can't cast relational to double + * patch11: removed some fossilized join code + * patch11: guarded an lstat with #ifdef SYMLINK instead of S_IFLNK, which lies + * * Revision 2.0.1.4 88/07/15 01:30:08 root * patch9: delete $ENV{$var} didn't delete environment variable * *************** *** 79,87 **** --- 86,106 ---- maxsarg = maxarg = arg->arg_len; if (maxsarg > 3 || retary) { if (sargoff >= 0) { /* array already exists, just append to it */ + #ifdef M_I386 + int tmpint; + char *tmpptr; + #endif /* M_I386 */ + cushion = 10; + #ifndef M_I386 sarg = (STR **)saferealloc((char*)*retary, (maxsarg+sargoff+2+cushion) * sizeof(STR*)) + sargoff; + #else + tmpint=(maxsarg+sargoff+2+cushion)*sizeof(STR*); + tmpptr=(char*)*retary; + sarg = (STR **)saferealloc(tmpptr, tmpint); + sarg += sargoff; + #endif /* M_I386 */ /* Note that sarg points into the middle of the array */ } else { *************** *** 333,342 **** --- 352,373 ---- sarg[anum] = str_static(sarg[anum]); anum++; if (anum > maxarg) { + #ifdef M_I386 + int tmpint; + char *tmpptr; + #endif /* M_I386 */ + maxarg = anum + anum; maxsarg = maxarg + sargoff; + #ifndef M_I386 sarg = (STR **)saferealloc((char*)(sarg-sargoff), (maxsarg+2+cushion) * sizeof(STR*)) + sargoff; + #else + tmpint=(maxsarg+2+cushion)*sizeof(STR*); + tmpptr=(char *)(sarg-sargoff); + sarg = (STR **)saferealloc(tmpptr, tmpint); + sarg += sargoff; + #endif /* M_I386 */ } goto keepgoing; } *************** *** 456,465 **** value = str_gnum(sarg[1]) / value; goto donumset; case O_MODULO: ! if ((tmplong = (unsigned long) str_gnum(sarg[2])) == 0L) fatal("Illegal modulus zero"); value = str_gnum(sarg[1]); ! value = (double)(((unsigned long)value) % tmplong); goto donumset; case O_ADD: value = str_gnum(sarg[1]); --- 487,496 ---- value = str_gnum(sarg[1]) / value; goto donumset; case O_MODULO: ! if ((tmplong = (long) str_gnum(sarg[2])) == 0L) fatal("Illegal modulus zero"); value = str_gnum(sarg[1]); ! value = (double)(((long)value) % tmplong); goto donumset; case O_ADD: value = str_gnum(sarg[1]); *************** *** 472,522 **** case O_LEFT_SHIFT: value = str_gnum(sarg[1]); anum = (int)str_gnum(sarg[2]); ! value = (double)(((unsigned long)value) << anum); goto donumset; case O_RIGHT_SHIFT: value = str_gnum(sarg[1]); anum = (int)str_gnum(sarg[2]); ! value = (double)(((unsigned long)value) >> anum); goto donumset; case O_LT: value = str_gnum(sarg[1]); ! value = (double)(value < str_gnum(sarg[2])); goto donumset; case O_GT: value = str_gnum(sarg[1]); ! value = (double)(value > str_gnum(sarg[2])); goto donumset; case O_LE: value = str_gnum(sarg[1]); ! value = (double)(value <= str_gnum(sarg[2])); goto donumset; case O_GE: value = str_gnum(sarg[1]); ! value = (double)(value >= str_gnum(sarg[2])); goto donumset; case O_EQ: value = str_gnum(sarg[1]); ! value = (double)(value == str_gnum(sarg[2])); goto donumset; case O_NE: value = str_gnum(sarg[1]); ! value = (double)(value != str_gnum(sarg[2])); goto donumset; case O_BIT_AND: value = str_gnum(sarg[1]); ! value = (double)(((unsigned long)value) & ! (unsigned long)str_gnum(sarg[2])); goto donumset; case O_XOR: value = str_gnum(sarg[1]); ! value = (double)(((unsigned long)value) ^ ! (unsigned long)str_gnum(sarg[2])); goto donumset; case O_BIT_OR: value = str_gnum(sarg[1]); ! value = (double)(((unsigned long)value) | ! (unsigned long)str_gnum(sarg[2])); goto donumset; case O_AND: if (str_true(sarg[1])) { --- 503,550 ---- case O_LEFT_SHIFT: value = str_gnum(sarg[1]); anum = (int)str_gnum(sarg[2]); ! value = (double)(((long)value) << anum); goto donumset; case O_RIGHT_SHIFT: value = str_gnum(sarg[1]); anum = (int)str_gnum(sarg[2]); ! value = (double)(((long)value) >> anum); goto donumset; case O_LT: value = str_gnum(sarg[1]); ! value = (value < str_gnum(sarg[2])) ? 1.0 : 0.0; goto donumset; case O_GT: value = str_gnum(sarg[1]); ! value = (value > str_gnum(sarg[2])) ? 1.0 : 0.0; goto donumset; case O_LE: value = str_gnum(sarg[1]); ! value = (value <= str_gnum(sarg[2])) ? 1.0 : 0.0; goto donumset; case O_GE: value = str_gnum(sarg[1]); ! value = (value >= str_gnum(sarg[2])) ? 1.0 : 0.0; goto donumset; case O_EQ: value = str_gnum(sarg[1]); ! value = (value == str_gnum(sarg[2])) ? 1.0 : 0.0; goto donumset; case O_NE: value = str_gnum(sarg[1]); ! value = (value != str_gnum(sarg[2])) ? 1.0 : 0.0; goto donumset; case O_BIT_AND: value = str_gnum(sarg[1]); ! value = (double)(((long)value) & (long)str_gnum(sarg[2])); goto donumset; case O_XOR: value = str_gnum(sarg[1]); ! value = (double)(((long)value) ^ (long)str_gnum(sarg[2])); goto donumset; case O_BIT_OR: value = str_gnum(sarg[1]); ! value = (double)(((long)value) | (long)str_gnum(sarg[2])); goto donumset; case O_AND: if (str_true(sarg[1])) { *************** *** 672,679 **** --- 700,716 ---- maxarg = ary->ary_fill; maxsarg = maxarg + sargoff; if (retary) { /* array wanted */ + #ifndef M_I386 sarg = (STR **)saferealloc((char*)(sarg-sargoff), (maxsarg+3+cushion)*sizeof(STR*)) + sargoff; + #else + int tmpint; + char *tmpptr; + tmpint=(maxsarg+3+cushion)*sizeof(STR*); + tmpptr=(char *)(sarg-sargoff); + sarg = (STR **)saferealloc(tmpptr, tmpint); + sarg += sargoff; + #endif /* M_I386 */ for (anum = 0; anum <= maxarg; anum++) { sarg[anum+1] = str = afetch(ary,anum); } *************** *** 790,799 **** str_set(str, tmps); break; case O_JOIN: ! if (arg[2].arg_flags & AF_SPECIAL && arg[2].arg_type == A_EXPR) ! do_join(arg,str_get(sarg[1]),str); ! else ! ajoin(arg[2].arg_ptr.arg_stab->stab_array,str_get(sarg[1]),str); break; case O_SLT: tmps = str_get(sarg[1]); --- 827,833 ---- str_set(str, tmps); break; case O_JOIN: ! do_join(arg,str_get(sarg[1]),str); break; case O_SLT: tmps = str_get(sarg[1]); *************** *** 1075,1081 **** if (!tmps || !*tmps) sleep((32767<<16)+32767); else ! sleep((unsigned)atoi(tmps)); value = (double)when; time(&when); value = ((double)when) - value; --- 1109,1115 ---- if (!tmps || !*tmps) sleep((32767<<16)+32767); else ! sleep((unsigned int)atoi(tmps)); value = (double)when; time(&when); value = ((double)when) - value; *************** *** 1335,1341 **** break; #endif case O_FTLINK: ! #ifdef S_IFLNK if (lstat(str_get(sarg[1]),&statbuf) >= 0 && (statbuf.st_mode & S_IFMT) == S_IFLNK ) str = &str_yes; --- 1369,1375 ---- break; #endif case O_FTLINK: ! #ifdef SYMLINK if (lstat(str_get(sarg[1]),&statbuf) >= 0 && (statbuf.st_mode & S_IFMT) == S_IFLNK ) str = &str_yes; Index: t/op.each Prereq: 2.0 *** t/op.each.old Wed Aug 3 22:57:25 1988 --- t/op.each Wed Aug 3 22:57:26 1988 *************** *** 1,13 **** #!./perl ! # $Header: op.each,v 2.0 88/06/05 00:13:38 root Exp $ print "1..3\n"; $h{'abc'} = 'ABC'; $h{'def'} = 'DEF'; ! $h{'jkl'} = 'JKL'; ! $h{'xyz'} = 'XYZ'; $h{'a'} = 'A'; $h{'b'} = 'B'; $h{'c'} = 'C'; --- 1,13 ---- #!./perl ! # $Header: op.each,v 2.0.1.1 88/08/03 22:44:29 root Exp $ print "1..3\n"; $h{'abc'} = 'ABC'; $h{'def'} = 'DEF'; ! $h{'jkl','mno'} = "JKL\034MNO"; ! $h{'a',2,3,4,5} = join("\034",'A',2,3,4,5); $h{'a'} = 'A'; $h{'b'} = 'B'; $h{'c'} = 'C'; Index: t/op.list Prereq: 2.0.1.1 *** t/op.list.old Wed Aug 3 22:57:29 1988 --- t/op.list Wed Aug 3 22:57:30 1988 *************** *** 1,6 **** #!./perl ! # $Header: op.list,v 2.0.1.1 88/07/11 23:08:42 root Exp $ print "1..24\n"; --- 1,6 ---- #!./perl ! # $Header: op.list,v 2.0.1.2 88/08/03 22:45:06 root Exp $ print "1..24\n"; *************** *** 7,13 **** @foo = (1, 2, 3, 4); if ($foo[0] == 1 && $foo[3] == 4) {print "ok 1\n";} else {print "not ok 1\n";} ! $_ = join(foo,':'); if ($_ eq '1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";} ($a,$b,$c,$d) = (1,2,3,4); --- 7,13 ---- @foo = (1, 2, 3, 4); if ($foo[0] == 1 && $foo[3] == 4) {print "ok 1\n";} else {print "not ok 1\n";} ! $_ = join(':',@foo); if ($_ eq '1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";} ($a,$b,$c,$d) = (1,2,3,4); Index: t/op.push Prereq: 2.0 *** t/op.push.old Wed Aug 3 22:57:32 1988 --- t/op.push Wed Aug 3 22:57:33 1988 *************** *** 1,11 **** #!./perl ! # $Header: op.push,v 2.0 88/06/05 00:14:23 root Exp $ print "1..2\n"; @x = (1,2,3); push(@x,@x); ! if (join(x,':') eq '1:2:3:1:2:3') {print "ok 1\n";} else {print "not ok 1\n";} push(x,4); ! if (join(x,':') eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";} --- 1,11 ---- #!./perl ! # $Header: op.push,v 2.0.1.1 88/08/03 22:45:14 root Exp $ print "1..2\n"; @x = (1,2,3); push(@x,@x); ! if (join(':',@x) eq '1:2:3:1:2:3') {print "ok 1\n";} else {print "not ok 1\n";} push(x,4); ! if (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";} Index: t/op.stat Prereq: 2.0 *** t/op.stat.old Wed Aug 3 22:57:35 1988 --- t/op.stat Wed Aug 3 22:57:36 1988 *************** *** 1,6 **** #!./perl ! # $Header: op.stat,v 2.0 88/06/05 00:14:43 root Exp $ print "1..56\n"; --- 1,6 ---- #!./perl ! # $Header: op.stat,v 2.0.1.1 88/08/03 22:46:11 root Exp $ print "1..56\n"; *************** *** 105,111 **** close(tty); if (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";} open(null,"/dev/null"); ! if (! -t null) {print "ok 39\n";} else {print "not ok 39\n";} close(null); if (-t) {print "ok 40\n";} else {print "not ok 40\n";} --- 105,111 ---- close(tty); if (! -t tty) {print "ok 38\n";} else {print "not ok 38\n";} open(null,"/dev/null"); ! if (! -t null) {print "ok 39\n";} else {print "not ok 39 except on Xenix 386\n";} close(null); if (-t) {print "ok 40\n";} else {print "not ok 40\n";} Index: perl.h Prereq: 2.0.1.1 *** perl.h.old Wed Aug 3 22:55:48 1988 --- perl.h Wed Aug 3 22:55:48 1988 *************** *** 1,6 **** ! /* $Header: perl.h,v 2.0.1.1 88/07/11 22:34:31 root Exp $ * * $Log: perl.h,v $ * Revision 2.0.1.1 88/07/11 22:34:31 root * patch2: added $`, $& and $' * --- 1,11 ---- ! /* $Header: perl.h,v 2.0.1.2 88/08/03 22:19:11 root Exp $ * * $Log: perl.h,v $ + * Revision 2.0.1.2 88/08/03 22:19:11 root + * patch11: some support for crippled compilers that don't grok str_get macro + * patch11: str_peek improperly reused a buffer + * patch11: declared j() + * * Revision 2.0.1.1 88/07/11 22:34:31 root * patch2: added $`, $& and $' * *************** *** 81,90 **** #define str_true(str) (Str = (str), (Str->str_pok ? True(Str->str_ptr) : (Str->str_nok ? (Str->str_nval != 0.0) : 0 ))) #ifdef DEBUGGING ! #define str_peek(str) (Str = (str), (Str->str_pok ? Str->str_ptr : (Str->str_nok ? (sprintf(buf,"num(%g)",Str->str_nval),(char*)buf) : "" ))) #endif #define str_get(str) (Str = (str), (Str->str_pok ? Str->str_ptr : str_2ptr(Str))) #define str_gnum(str) (Str = (str), (Str->str_nok ? Str->str_nval : str_2num(Str))) EXT STR *Str; --- 86,100 ---- #define str_true(str) (Str = (str), (Str->str_pok ? True(Str->str_ptr) : (Str->str_nok ? (Str->str_nval != 0.0) : 0 ))) #ifdef DEBUGGING ! #define str_peek(str) (Str = (str), (Str->str_pok ? Str->str_ptr : (Str->str_nok ? (sprintf(tokenbuf,"num(%g)",Str->str_nval),(char*)tokenbuf) : "" ))) #endif + #ifdef CRIPPLED_CC + char *str_get(); + #else #define str_get(str) (Str = (str), (Str->str_pok ? Str->str_ptr : str_2ptr(Str))) + #endif + #define str_gnum(str) (Str = (str), (Str->str_nok ? Str->str_nval : str_2num(Str))) EXT STR *Str; *************** *** 115,120 **** --- 125,131 ---- ARG *flipflip(); ARG *listish(); ARG *localize(); + ARG *j(); ARG *l(); ARG *mod_match(); ARG *make_list();