From: Larry Wall Date: Thu, 21 Dec 1989 07:38:27 +0000 (+0000) Subject: perl 3.0 patch #8 patch 7 continued X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=663a0e373fc859394758ec18df61983d1fad6d0a;p=p5sagit%2Fp5-mst-13.2.git perl 3.0 patch #8 patch 7 continued See patch 7. --- diff --git a/cons.c b/cons.c index 6d4084a..6db876c 100644 --- a/cons.c +++ b/cons.c @@ -1,4 +1,4 @@ -/* $Header: cons.c,v 3.0.1.2 89/11/17 15:08:53 lwall Locked $ +/* $Header: cons.c,v 3.0.1.3 89/12/21 19:20:25 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: cons.c,v $ + * Revision 3.0.1.3 89/12/21 19:20:25 lwall + * patch7: made nested or recursive foreach work right + * * Revision 3.0.1.2 89/11/17 15:08:53 lwall * patch5: nested foreach on same array didn't work * @@ -1194,20 +1197,26 @@ int willsave; /* willsave passes down the tree */ /* Here we check to see if the temporary array generated for * a foreach needs to be localized because of recursion. */ - if (tmpsave && (cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY && - lastcmd && - lastcmd->c_type == C_EXPR && - lastcmd->ucmd.acmd.ac_expr) { - ARG *arg = lastcmd->ucmd.acmd.ac_expr; - - if (arg->arg_type == O_ASSIGN && - arg[1].arg_type == A_LEXPR && - arg[1].arg_ptr.arg_arg->arg_type == O_LARRAY && - strnEQ("_GEN_", - stab_name(arg[1].arg_ptr.arg_arg[1].arg_ptr.arg_stab), - 5)) { /* array generated for foreach */ - (void)localize(arg[1].arg_ptr.arg_arg); + if (tmpsave && (cmd->c_flags & CF_OPTIMIZE) == CFT_ARRAY) { + if (lastcmd && + lastcmd->c_type == C_EXPR && + lastcmd->ucmd.acmd.ac_expr) { + ARG *arg = lastcmd->ucmd.acmd.ac_expr; + + if (arg->arg_type == O_ASSIGN && + arg[1].arg_type == A_LEXPR && + arg[1].arg_ptr.arg_arg->arg_type == O_LARRAY && + strnEQ("_GEN_", + stab_name( + arg[1].arg_ptr.arg_arg[1].arg_ptr.arg_stab), + 5)) { /* array generated for foreach */ + (void)localize(arg[1].arg_ptr.arg_arg); + } } + + /* in any event, save the iterator */ + + (void)apush(tosave,cmd->c_short); } shouldsave |= tmpsave; } diff --git a/doarg.c b/doarg.c index 6a45dd6..7e7bfc8 100644 --- a/doarg.c +++ b/doarg.c @@ -1,4 +1,4 @@ -/* $Header: doarg.c,v 3.0.1.1 89/11/11 04:17:20 lwall Locked $ +/* $Header: doarg.c,v 3.0.1.2 89/12/21 19:52:15 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,10 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: doarg.c,v $ + * Revision 3.0.1.2 89/12/21 19:52:15 lwall + * patch7: a pattern wouldn't match a null string before the first character + * patch7: certain patterns didn't match correctly at end of string + * * Revision 3.0.1.1 89/11/11 04:17:20 lwall * patch2: printf %c, %D, %X and %O didn't work right * patch2: printf of unsigned vs signed needed separate casts on some machines @@ -127,7 +131,7 @@ int sp; clen = dstr->str_cur; if (clen <= spat->spat_slen + spat->spat_regexp->regback) { /* can do inplace substitution */ - if (regexec(spat->spat_regexp, s, strend, orig, 1, + if (regexec(spat->spat_regexp, s, strend, orig, 0, str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) { if (spat->spat_regexp->subbase) /* oops, no we can't */ goto long_way; @@ -201,8 +205,8 @@ int sp; d += clen; } s = spat->spat_regexp->endp[0]; - } while (regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr, - TRUE)); + } while (regexec(spat->spat_regexp, s, strend, orig, s == m, + Nullstr, TRUE)); /* (don't match same null twice) */ if (s != d) { i = strend - s; str->str_cur = d - str->str_ptr + i; @@ -220,7 +224,7 @@ int sp; } else c = Nullch; - if (regexec(spat->spat_regexp, s, strend, orig, 1, + if (regexec(spat->spat_regexp, s, strend, orig, 0, str->str_pok & SP_STUDIED ? str : Nullstr, safebase)) { long_way: dstr = Str_new(25,str_len(str)); @@ -252,7 +256,7 @@ int sp; } if (once) break; - } while (regexec(spat->spat_regexp, s, strend, orig, 1, Nullstr, + } while (regexec(spat->spat_regexp, s, strend, orig, s == m, Nullstr, safebase)); str_ncat(dstr,s,strend - s); str_replace(str,dstr); diff --git a/doio.c b/doio.c index 3884035..853347a 100644 --- a/doio.c +++ b/doio.c @@ -1,4 +1,4 @@ -/* $Header: doio.c,v 3.0.1.3 89/11/17 15:13:06 lwall Locked $ +/* $Header: doio.c,v 3.0.1.4 89/12/21 19:55:10 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,12 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: doio.c,v $ + * Revision 3.0.1.4 89/12/21 19:55:10 lwall + * patch7: select now works on big-endian machines + * patch7: errno may now be a macro with an lvalue + * patch7: ANSI strerror() is now supported + * patch7: Configure now detects DG/UX thingies like [sg]etpgrp2 and utime.h + * * Revision 3.0.1.3 89/11/17 15:13:06 lwall * patch5: some systems have symlink() but not lstat() * patch5: some systems have dirent.h but not readdir() @@ -36,15 +42,15 @@ #include #endif -#include #ifdef I_PWD #include #endif #ifdef I_GRP #include #endif - -extern int errno; +#ifdef I_UTIME +#include +#endif bool do_open(stab,name) @@ -1475,20 +1481,52 @@ int *arglast; int nfound; struct timeval timebuf; struct timeval *tbuf = &timebuf; + int growsize; +#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678 + int masksize; + int offset; + char *fd_sets[4]; + int k; + +#if BYTEORDER & 0xf0000 +#define ORDERBYTE (0x88888888 - BYTEORDER) +#else +#define ORDERBYTE (0x4444 - BYTEORDER) +#endif + +#endif for (i = 1; i <= 3; i++) { - j = st[sp+i]->str_len; + j = st[sp+i]->str_cur; if (maxlen < j) maxlen = j; } + +#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 + growsize = maxlen; /* little endians can use vecs directly */ +#else +#ifdef NFDBITS + +#ifndef NBBY +#define NBBY 8 +#endif + + masksize = NFDBITS / NBBY; +#else + masksize = sizeof(long); /* documented int, everyone seems to use long */ +#endif + growsize = maxlen + (masksize - (maxlen % masksize)); + Zero(&fd_sets[0], 4, char*); +#endif + for (i = 1; i <= 3; i++) { str = st[sp+i]; j = str->str_len; - if (j < maxlen) { + if (j < growsize) { if (str->str_pok) { - str_grow(str,maxlen); + str_grow(str,growsize); s = str_get(str) + j; - while (++j <= maxlen) { + while (++j <= growsize) { *s++ = '\0'; } } @@ -1497,6 +1535,16 @@ int *arglast; str->str_ptr = Nullch; } } +#if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678 + s = str->str_ptr; + if (s) { + New(403, fd_sets[i], growsize, char); + for (offset = 0; offset < growsize; offset += masksize) { + for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4)) + fd_sets[i][j+offset] = s[(k % masksize) + offset]; + } + } +#endif } str = st[sp+4]; if (str->str_nok || str->str_pok) { @@ -1510,12 +1558,31 @@ int *arglast; else tbuf = Null(struct timeval*); +#if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678 nfound = select( maxlen * 8, st[sp+1]->str_ptr, st[sp+2]->str_ptr, st[sp+3]->str_ptr, tbuf); +#else + nfound = select( + maxlen * 8, + fd_sets[1], + fd_sets[2], + fd_sets[3], + tbuf); + for (i = 1; i <= 3; i++) { + if (fd_sets[i]) { + str = st[sp+i]; + s = str->str_ptr; + for (offset = 0; offset < growsize; offset += masksize) { + for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4)) + s[(k % masksize) + offset] = fd_sets[i][j+offset]; + } + } + } +#endif st[++sp] = str_static(&str_no); str_numset(st[sp], (double)nfound); @@ -1915,13 +1982,21 @@ int *arglast; taintproper("Insecure dependency in utime"); #endif if (items > 2) { +#ifdef I_UTIME + struct utimbuf utbuf; +#else struct { - long atime, - mtime; + long actime; + long modtime; } utbuf; +#endif - utbuf.atime = (long)str_gnum(st[++sp]); /* time accessed */ - utbuf.mtime = (long)str_gnum(st[++sp]); /* time modified */ + utbuf.actime = (long)str_gnum(st[++sp]); /* time accessed */ + utbuf.modtime = (long)str_gnum(st[++sp]); /* time modified */ +#ifdef I_UTIME + utbuf.acusec = 0; /* hopefully I_UTIME implies these */ + utbuf.modusec = 0; +#endif items -= 2; #ifndef lint tot = items; diff --git a/dolist.c b/dolist.c index 7808151..4823231 100644 --- a/dolist.c +++ b/dolist.c @@ -1,4 +1,4 @@ -/* $Header: dolist.c,v 3.0.1.3 89/11/17 15:14:45 lwall Locked $ +/* $Header: dolist.c,v 3.0.1.4 89/12/21 19:58:46 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,10 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: dolist.c,v $ + * Revision 3.0.1.4 89/12/21 19:58:46 lwall + * patch7: grep(1,@array) didn't work + * patch7: /$pat/; //; wrongly freed runtime pattern twice + * * Revision 3.0.1.3 89/11/17 15:14:45 lwall * patch5: grep() occasionally loses arguments or dumps core * @@ -81,7 +85,8 @@ int *arglast; if (!*spat->spat_regexp->precomp && lastspat) spat = lastspat; if (spat->spat_flags & SPAT_KEEP) { - arg_free(spat->spat_runtime); /* it won't change, so */ + if (spat->spat_runtime) + arg_free(spat->spat_runtime); /* it won't change, so */ spat->spat_runtime = Nullarg; /* no point compiling again */ } if (!spat->spat_regexp->nparens) @@ -729,8 +734,11 @@ int *arglast; int oldsave = savestack->ary_fill; savesptr(&stab_val(defstab)); - if ((arg[1].arg_type & A_MASK) != A_EXPR) + if ((arg[1].arg_type & A_MASK) != A_EXPR) { + arg[1].arg_type &= A_MASK; dehoist(arg,1); + arg[1].arg_type |= A_DONT; + } arg = arg[1].arg_ptr.arg_arg; while (i-- > 0) { stab_val(defstab) = st[src]; diff --git a/eval.c b/eval.c index 25a6c79..95870b1 100644 --- a/eval.c +++ b/eval.c @@ -1,4 +1,4 @@ -/* $Header: eval.c,v 3.0.1.2 89/11/17 15:19:34 lwall Locked $ +/* $Header: eval.c,v 3.0.1.3 89/12/21 20:03:05 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,8 +6,14 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: eval.c,v $ + * Revision 3.0.1.3 89/12/21 20:03:05 lwall + * patch7: errno may now be a macro with an lvalue + * patch7: ANSI strerror() is now supported + * patch7: send() didn't allow a TO argument + * patch7: ord() now always returns positive even on signed char machines + * * Revision 3.0.1.2 89/11/17 15:19:34 lwall - * patch5: simplified a too-complex expression for some machine or other + * patch5: constant numeric subscripts get lost inside ?: * * Revision 3.0.1.1 89/11/11 04:31:51 lwall * patch2: mkdir and rmdir needed to quote argument when passed to shell @@ -23,14 +29,11 @@ #include "perl.h" #include -#include #ifdef I_VFORK # include #endif -extern int errno; - #ifdef VOIDSIG static void (*ihand)(); static void (*qhand)(); @@ -50,9 +53,6 @@ double sin(), cos(), atan2(), pow(); char *getlogin(); -extern int sys_nerr; -extern char *sys_errlist[]; - int eval(arg,gimme,sp) register ARG *arg; @@ -962,7 +962,13 @@ register int sp; errno = 0; if (optype > 4) warn("Too many args on send"); - if (optype >= 4) { + stio = stab_io(stab); + if (!stio || !stio->ifp) { + anum = -1; + if (dowarn) + warn("Send on closed socket"); + } + else if (optype >= 4) { tmps2 = str_get(st[4]); anum = sendto(fileno(stab_io(stab)->ifp), tmps, st[2]->str_cur, anum, tmps2, st[4]->str_cur); @@ -1197,10 +1203,10 @@ register int sp; else tmps = str_get(st[1]); #ifndef I286 - value = (double) *tmps; + value = (double) (*tmps & 255); #else anum = (int) *tmps; - value = (double) anum; + value = (double) (anum & 255); #endif goto donumset; case O_SLEEP: diff --git a/hash.c b/hash.c index fb8e36f..5f18937 100644 --- a/hash.c +++ b/hash.c @@ -1,4 +1,4 @@ -/* $Header: hash.c,v 3.0.1.1 89/11/11 04:34:18 lwall Locked $ +/* $Header: hash.c,v 3.0.1.2 89/12/21 20:03:39 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: hash.c,v $ + * Revision 3.0.1.2 89/12/21 20:03:39 lwall + * patch7: errno may now be a macro with an lvalue + * * Revision 3.0.1.1 89/11/11 04:34:18 lwall * patch2: CX/UX needed to set the key each time in associative iterators * @@ -16,9 +19,6 @@ #include "EXTERN.h" #include "perl.h" -#include - -extern int errno; STR * hfetch(tb,key,klen,lval) diff --git a/patchlevel.h b/patchlevel.h index e19cd94..a6997a9 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -1 +1 @@ -#define PATCHLEVEL 7 +#define PATCHLEVEL 8 diff --git a/perl.h b/perl.h index a9e3f14..038d41a 100644 --- a/perl.h +++ b/perl.h @@ -1,4 +1,4 @@ -/* $Header: perl.h,v 3.0.1.3 89/11/17 15:28:57 lwall Locked $ +/* $Header: perl.h,v 3.0.1.4 89/12/21 20:07:35 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,15 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: perl.h,v $ + * Revision 3.0.1.4 89/12/21 20:07:35 lwall + * patch7: arranged for certain registers to be restored after longjmp() + * patch7: Configure now compiles a test program to figure out time.h fiasco + * patch7: Configure now detects DG/UX thingies like [sg]etpgrp2 and utime.h + * patch7: memcpy() and memset() return void in __STDC__ + * patch7: errno may now be a macro with an lvalue + * patch7: ANSI strerror() is now supported + * patch7: Xenix support for sys/ndir.h, cross compilation + * * Revision 3.0.1.3 89/11/17 15:28:57 lwall * patch5: byteorder now is a hex value * patch5: Configure now looks for including @@ -26,6 +35,14 @@ * */ +#ifdef __STDC__ +#define VOLATILE volatile +#define VREG +#else +#define VOLATILE +#define VREG register +#endif + #define VOIDUSED 1 #include "config.h" @@ -39,12 +56,32 @@ # define vfork fork #endif +#ifdef GETPGRP2 +# ifndef GETPGRP +# define GETPGRP +# endif +# define getpgrp getpgrp2 +#endif + +#ifdef SETPGRP2 +# ifndef SETPGRP +# define SETPGRP +# endif +# define setpgrp setpgrp2 +#endif + #if defined(MEMCMP) && defined(mips) && BYTEORDER == 0x1234 #undef MEMCMP #endif #ifdef MEMCPY +#ifndef memcpy +#ifdef __STDC__ +extern void *memcpy(), *memset(); +#else extern char *memcpy(), *memset(); +#endif +#endif #define bcopy(s1,s2,l) memcpy(s2,s1,l) #define bzero(s,l) memset(s,0,l) #endif @@ -69,20 +106,39 @@ extern char *memcpy(), *memset(); #include -#if defined(TMINSYS) || defined(I_SYSTIME) -#include -#ifdef I_TIMETOO -#include -#endif -#else -#include -#ifdef I_SYSTIMETOO -#include +#ifdef I_TIME +# include #endif + +#ifdef I_SYSTIME +# ifdef SYSTIMEKERNEL +# define KERNEL +# endif +# include +# ifdef SYSTIMEKERNEL +# undef KERNEL +# endif #endif #include +#if defined(STRERROR) && (!defined(MKDIR) || !defined(RMDIR)) +#undef STRERROR +#endif + +#include +#ifndef errno +extern int errno; /* ANSI allows errno to be an lvalue expr */ +#endif + +#ifdef STRERROR +char *strerror(); +#else +extern int sys_nerr; +extern char *sys_errlist[]; +#define strerror(e) ((e) < 0 || (e) >= sys_nerr ? "(unknown)" : sys_errlist[e]) +#endif + #ifdef I_SYSIOCTL #ifndef _IOCTL_ #include @@ -135,18 +191,23 @@ EXT int dbmlen; #define ntohi ntohl #endif -#ifdef I_DIRENT -#include -#define DIRENT dirent -#else -#ifdef I_SYSDIR -#ifdef hp9000s500 -#include /* may be wrong in the future */ +#if defined(I_DIRENT) && !defined(xenix) +# include +# define DIRENT dirent #else -#include -#endif -#define DIRENT direct -#endif +# ifdef I_SYSDIR +# ifdef hp9000s500 +# include /* may be wrong in the future */ +# else +# include +# endif +# define DIRENT direct +# else +# ifdef I_SYSNDIR +# include +# define DIRENT direct +# endif +# endif #endif typedef struct arg ARG; diff --git a/perl.man.3 b/perl.man.3 index c5359f9..bd64915 100644 --- a/perl.man.3 +++ b/perl.man.3 @@ -1,7 +1,11 @@ ''' Beginning of part 3 -''' $Header: perl.man.3,v 3.0.1.2 89/11/17 15:31:05 lwall Locked $ +''' $Header: perl.man.3,v 3.0.1.3 89/12/21 20:10:12 lwall Locked $ ''' ''' $Log: perl.man.3,v $ +''' Revision 3.0.1.3 89/12/21 20:10:12 lwall +''' patch7: documented that s`pat`repl` does command substitution on replacement +''' patch7: documented that $timeleft from select() is likely not implemented +''' ''' Revision 3.0.1.2 89/11/17 15:31:05 lwall ''' patch5: fixed some manual typos and indent problems ''' patch5: added warning about print making an array context @@ -467,7 +471,8 @@ the replacement string is to be evaluated as an expression rather than just as a double-quoted string. Any delimiter may replace the slashes; if single quotes are used, no interpretation is done on the replacement string (the e modifier overrides -this, however). +this, however); if backquotes are used, the replacement string is a command +to execute whose output will be used as the actual replacement text. If no string is specified via the =~ or !~ operator, the $_ string is searched and modified. (The string specified with =~ must be a scalar variable, an array element, @@ -582,6 +587,8 @@ or to block until something becomes ready: .fi Any of the bitmasks can also be undef. The timeout, if specified, is in seconds, which may be fractional. +NOTE: not all implementations are capable of returning the $timeleft. +If not, they always return $timeleft equal to the supplied $timeout. .Ip "setpgrp(PID,PGRP)" 8 4 Sets the current process group for the specified PID, 0 for the current process. @@ -707,15 +714,15 @@ For example: .fi produces the output \*(L'h:i:t:h:e:r:e\*(R'. .Sp -The NUM parameter can be used to partially split a line +The LIMIT parameter can be used to partially split a line .nf ($login, $passwd, $remainder) = split(\|/\|:\|/\|, $_, 3); .fi -(When assigning to a list, if NUM is omitted, perl supplies a NUM one +(When assigning to a list, if LIMIT is omitted, perl supplies a LIMIT one larger than the number of variables in the list, to avoid unnecessary work. -For the list above NUM would have been 4 by default. +For the list above LIMIT would have been 4 by default. In time critical applications it behooves you not to split into more fields than you really need.) .Sp diff --git a/perl.man.4 b/perl.man.4 index 5f768aa..a3ab60c 100644 --- a/perl.man.4 +++ b/perl.man.4 @@ -1,7 +1,11 @@ ''' Beginning of part 4 -''' $Header: perl.man.4,v 3.0.1.3 89/11/17 15:32:25 lwall Locked $ +''' $Header: perl.man.4,v 3.0.1.4 89/12/21 20:12:39 lwall Locked $ ''' ''' $Log: perl.man.4,v $ +''' Revision 3.0.1.4 89/12/21 20:12:39 lwall +''' patch7: documented that package'filehandle works as well as $package'variable +''' patch7: documented which identifiers are always in package main +''' ''' Revision 3.0.1.3 89/11/17 15:32:25 lwall ''' patch5: fixed some manual typos and indent problems ''' patch5: clarified difference between $! and $@ @@ -912,9 +916,21 @@ Typically it would be the first declaration in a file to be included by the \*(L"do FILE\*(R" operator. You can switch into a package in more than one place; it merely influences which symbol table is used by the compiler for the rest of that block. -You can refer to variables in other packages by prefixing the name with -the package name and a single quote. +You can refer to variables and filehandles in other packages by prefixing +the identifier with the package name and a single quote. If the package name is null, the \*(L"main\*(R" package as assumed. +.PP +Only identifiers starting with letters are stored in the packages symbol +table. +All other symbols are kept in package \*(L"main\*(R". +In addition, the identifiers STDIN, STDOUT, STDERR, ARGV, ARGVOUT, ENV, INC +and SIG are forced to be in package \*(L"main\*(R", even when used for +other purposes than their built-in one. +Note also that, if you have a package called \*(L"m\*(R", \*(L"s\*(R" +or \*(L"y\*(R", the you can't use the qualified form of an identifier since it +will be interpreted instead as a pattern match, a substitution +or a translation. +.PP Eval'ed strings are compiled in the package in which the eval was compiled in. (Assignments to $SIG{}, however, assume the signal handler specified is in the @@ -978,7 +994,7 @@ Here is dumpvar.pl from the perl library: .fi Note that, even though the subroutine is compiled in package dumpvar, the -name of the subroutine is qualified so that it's name is inserted into package +name of the subroutine is qualified so that its name is inserted into package \*(L"main\*(R". .Sh "Style" Each programmer will, of course, have his or her own preferences in regards diff --git a/perl.y b/perl.y index 2b1e917..57e1bfc 100644 --- a/perl.y +++ b/perl.y @@ -1,4 +1,4 @@ -/* $Header: perl.y,v 3.0.1.2 89/11/11 04:49:04 lwall Locked $ +/* $Header: perl.y,v 3.0.1.3 89/12/21 20:13:41 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: perl.y,v $ + * Revision 3.0.1.3 89/12/21 20:13:41 lwall + * patch7: send() didn't allow a TO argument + * * Revision 3.0.1.2 89/11/11 04:49:04 lwall * patch2: moved yydebug to where its type doesn't matter * patch2: !$foo++ was unreasonably illegal @@ -596,7 +599,7 @@ term : '-' term %prec UMINUS | FILOP2 '(' handle cexpr ')' { $$ = make_op($1, 2, $3, $4, Nullarg); } | FILOP3 '(' handle csexpr cexpr ')' - { $$ = make_op($1, 3, $3, $4, $5); } + { $$ = make_op($1, 3, $3, $4, make_list($5)); } | FILOP22 '(' handle ',' handle ')' { $$ = make_op($1, 2, $3, $5, Nullarg); } | FILOP4 '(' handle csexpr csexpr cexpr ')' diff --git a/perly.c b/perly.c index db62100..1471ff6 100644 --- a/perly.c +++ b/perly.c @@ -1,4 +1,4 @@ -char rcsid[] = "$Header: perly.c,v 3.0.1.2 89/11/17 15:34:42 lwall Locked $\nPatch level: ###\n"; +char rcsid[] = "$Header: perly.c,v 3.0.1.3 89/12/21 20:15:41 lwall Locked $\nPatch level: ###\n"; /* * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,11 @@ char rcsid[] = "$Header: perly.c,v 3.0.1.2 89/11/17 15:34:42 lwall Locked $\nPat * as specified in the README file that comes with the perl 3.0 kit. * * $Log: perly.c,v $ + * Revision 3.0.1.3 89/12/21 20:15:41 lwall + * patch7: ANSI strerror() is now supported + * patch7: errno may now be a macro with an lvalue + * patch7: allowed setuid scripts to have a space after #! + * * Revision 3.0.1.2 89/11/17 15:34:42 lwall * patch5: fixed possible confusion about current effective gid * @@ -292,9 +297,6 @@ a copy of which can be found with the Perl 3.0 distribution kit.\n",stdout); else rsfp = fopen(argv[0],"r"); if (rsfp == Nullfp) { - extern char *sys_errlist[]; - extern int errno; - #ifdef DOSUID #ifndef IAMSUID /* in case script is not readable before setuid */ if (euid && stat(filename,&statbuf) >= 0 && @@ -306,7 +308,7 @@ a copy of which can be found with the Perl 3.0 distribution kit.\n",stdout); #endif #endif fatal("Can't open perl script \"%s\": %s\n", - filename, sys_errlist[errno]); + filename, strerror(errno)); } str_free(str); /* free -I directories */ @@ -398,7 +400,9 @@ a copy of which can be found with the Perl 3.0 distribution kit.\n",stdout); if (fgets(tokenbuf,sizeof tokenbuf, rsfp) == Nullch || strnNE(tokenbuf,"#!",2) ) /* required even on Sys V */ fatal("No #! line"); - for (s = tokenbuf+2; !isspace(*s); s++) ; + s = tokenbuf+2; + if (*s == ' ') s++; + while (!isspace(*s)) s++; if (strnNE(s-4,"perl",4)) /* sanity check */ fatal("Not a perl script"); while (*s == ' ' || *s == '\t') s++; @@ -722,7 +726,7 @@ int *arglast; SPAT *oldspat = curspat; static char *last_eval = Nullch; static CMD *last_root = Nullcmd; - int sp = arglast[0]; + VOLATILE int sp = arglast[0]; tmps_base = tmps_max; if (curstash != stash) { diff --git a/regexec.c b/regexec.c index 37fe129..0ccc830 100644 --- a/regexec.c +++ b/regexec.c @@ -7,9 +7,12 @@ * blame Henry for some of the lack of readability. */ -/* $Header: regexec.c,v 3.0.1.1 89/11/11 04:52:04 lwall Locked $ +/* $Header: regexec.c,v 3.0.1.2 89/12/21 20:16:27 lwall Locked $ * * $Log: regexec.c,v $ + * Revision 3.0.1.2 89/12/21 20:16:27 lwall + * patch7: certain patterns didn't match correctly at end of string + * * Revision 3.0.1.1 89/11/11 04:52:04 lwall * patch2: /\b$foo/ didn't work * @@ -341,7 +344,8 @@ int safebase; /* no need to remember string in subbase */ } } else { - dontbother = minend; + if (minlen) + dontbother = minlen - 1; strend -= dontbother; /* We don't know much -- general case. */ do { diff --git a/stab.c b/stab.c index 5b06198..2a5c5a3 100644 --- a/stab.c +++ b/stab.c @@ -1,4 +1,4 @@ -/* $Header: stab.c,v 3.0.1.2 89/11/17 15:35:37 lwall Locked $ +/* $Header: stab.c,v 3.0.1.3 89/12/21 20:18:40 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,11 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: stab.c,v $ + * Revision 3.0.1.3 89/12/21 20:18:40 lwall + * patch7: ANSI strerror() is now supported + * patch7: errno may now be a macro with an lvalue + * patch7: in stab.c, sighandler() may now return either void or int + * * Revision 3.0.1.2 89/11/17 15:35:37 lwall * patch5: sighandler() needed to be static * @@ -26,9 +31,11 @@ static char *sig_name[] = { SIG_NAME,0 }; -extern int errno; -extern int sys_nerr; -extern char *sys_errlist[]; +#ifdef VOIDSIG +#define handlertype void +#else +#define handlertype int +#endif STR * stab_str(str) @@ -143,8 +150,7 @@ STR *str; break; case '!': str_numset(stab_val(stab), (double)errno); - str_set(stab_val(stab), - errno < 0 || errno >= sys_nerr ? "(unknown)" : sys_errlist[errno]); + str_set(stab_val(stab), strerror(errno)); stab_val(stab)->str_nok = 1; /* what a wonderful hack! */ break; case '<': @@ -189,7 +195,7 @@ STR *str; STAB *stab = mstr->str_u.str_stab; char *s; int i; - static int sighandler(); + static handlertype sighandler(); switch (mstr->str_rare) { case 'E': @@ -422,7 +428,7 @@ char *sig; return 0; } -static int +static handlertype sighandler(sig) int sig; { diff --git a/stab.h b/stab.h index 2c43ab1..3cf7e9c 100644 --- a/stab.h +++ b/stab.h @@ -1,4 +1,4 @@ -/* $Header: stab.h,v 3.0 89/10/18 15:23:30 lwall Locked $ +/* $Header: stab.h,v 3.0.1.1 89/12/21 20:19:53 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: stab.h,v $ + * Revision 3.0.1.1 89/12/21 20:19:53 lwall + * patch7: in stab.h, added some CRIPPLED_CC support for Microport + * * Revision 3.0 89/10/18 15:23:30 lwall * 3.0 baseline * @@ -24,18 +27,30 @@ struct stabptrs { char stbp_flags; }; +#if defined(CRIPPLED_CC) && (defined(iAPX286) || defined(M_I286) || defined(I80286)) +#define MICROPORT +#endif + #define stab_magic(stab) (((STBP*)(stab->str_ptr))->stbp_magic) #define stab_val(stab) (((STBP*)(stab->str_ptr))->stbp_val) #define stab_io(stab) (((STBP*)(stab->str_ptr))->stbp_io) #define stab_form(stab) (((STBP*)(stab->str_ptr))->stbp_form) #define stab_xarray(stab) (((STBP*)(stab->str_ptr))->stbp_array) +#ifdef MICROPORT /* Microport 2.4 hack */ +ARRAY *stab_array(); +#else #define stab_array(stab) (((STBP*)(stab->str_ptr))->stbp_array ? \ ((STBP*)(stab->str_ptr))->stbp_array : \ ((STBP*)(aadd(stab)->str_ptr))->stbp_array) +#endif #define stab_xhash(stab) (((STBP*)(stab->str_ptr))->stbp_hash) +#ifdef MICROPORT /* Microport 2.4 hack */ +HASH *stab_hash(); +#else #define stab_hash(stab) (((STBP*)(stab->str_ptr))->stbp_hash ? \ ((STBP*)(stab->str_ptr))->stbp_hash : \ ((STBP*)(hadd(stab)->str_ptr))->stbp_hash) +#endif /* Microport 2.4 hack */ #define stab_sub(stab) (((STBP*)(stab->str_ptr))->stbp_sub) #define stab_lastexpr(stab) (((STBP*)(stab->str_ptr))->stbp_lastexpr) #define stab_line(stab) (((STBP*)(stab->str_ptr))->stbp_line) diff --git a/str.c b/str.c index 06d185e..71a31b3 100644 --- a/str.c +++ b/str.c @@ -1,4 +1,4 @@ -/* $Header: str.c,v 3.0.1.3 89/11/17 15:38:23 lwall Locked $ +/* $Header: str.c,v 3.0.1.4 89/12/21 20:21:35 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,10 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: str.c,v $ + * Revision 3.0.1.4 89/12/21 20:21:35 lwall + * patch7: errno may now be a macro with an lvalue + * patch7: made nested or recursive foreach work right + * * Revision 3.0.1.3 89/11/17 15:38:23 lwall * patch5: some machines typedef unchar too * patch5: substitution on leading components occasionally caused <> corruption @@ -115,8 +119,6 @@ double num; #endif } -extern int errno; - char * str_2ptr(str) register STR *str; @@ -212,8 +214,14 @@ register STR *sstr; } else if (sstr->str_nok) str_numset(dstr,sstr->str_u.str_nval); - else + else { +#ifdef STRUCTCOPY + dstr->str_u = sstr->str_u; +#else + dstr->str_u.str_nval = sstr->str_u.str_nval; +#endif dstr->str_pok = dstr->str_nok = 0; + } } str_nset(str,ptr,len) diff --git a/toke.c b/toke.c index e295a87..67376ed 100644 --- a/toke.c +++ b/toke.c @@ -1,4 +1,4 @@ -/* $Header: toke.c,v 3.0.1.3 89/11/17 15:43:15 lwall Locked $ +/* $Header: toke.c,v 3.0.1.4 89/12/21 20:26:56 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,11 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: toke.c,v $ + * Revision 3.0.1.4 89/12/21 20:26:56 lwall + * patch7: -d switch incompatible with -p or -n + * patch7: " ''$foo'' " didn't parse right + * patch7: grandfathered m'pat' and s'pat'repl' to not be package qualifiers + * * Revision 3.0.1.3 89/11/17 15:43:15 lwall * patch5: IBM PC/RT compiler can't deal with UNI() and LOP() macros * patch5: } misadjusted expection of subsequent term or operator @@ -196,6 +201,7 @@ yylex() str_cat(linestr,"}"); oldoldbufptr = oldbufptr = s = str_get(linestr); bufend = linestr->str_ptr + linestr->str_cur; + minus_n = minus_p = 0; goto retry; } oldoldbufptr = oldbufptr = s = str_get(linestr); @@ -429,7 +435,7 @@ yylex() while (isascii(*s) && \ (isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')) \ *d++ = *s++; \ - if (d[-1] == '\'') \ + while (d[-1] == '\'') \ d--,s--; \ *d = '\0'; \ d = tokenbuf; @@ -758,7 +764,13 @@ yylex() FOP(O_LSTAT); break; case 'm': case 'M': - SNARFWORD; + if (s[1] == '\'') { + d = "m"; + s++; + } + else { + SNARFWORD; + } if (strEQ(d,"m")) { s = scanpat(s-1); if (yylval.arg) @@ -849,7 +861,13 @@ yylex() UNI(O_READLINK); break; case 's': case 'S': - SNARFWORD; + if (s[1] == '\'') { + d = "s"; + s++; + } + else { + SNARFWORD; + } if (strEQ(d,"s")) { s = scansubst(s); if (yylval.arg) @@ -1088,7 +1106,13 @@ yylex() MOP(O_REPEAT); break; case 'y': case 'Y': - SNARFWORD; + if (s[1] == '\'') { + d = "y"; + s++; + } + else { + SNARFWORD; + } if (strEQ(d,"y")) { s = scantrans(s); TERM(TRANS); @@ -1151,7 +1175,7 @@ char *dest; while (isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'') *d++ = *s++; } - if (d > dest+1 && d[-1] == '\'') + while (d > dest+1 && d[-1] == '\'') d--,s--; *d = '\0'; d = dest; @@ -1675,7 +1699,11 @@ register char *s; out: (void)sprintf(tokenbuf,"%ld",i); arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf)); +#ifdef MICROPORT /* Microport 2.4 hack */ + { double zz = str_2num(arg[1].arg_ptr.arg_str); } +#else (void)str_2num(arg[1].arg_ptr.arg_str); +#endif /* Microport 2.4 hack */ } break; case '1': case '2': case '3': case '4': case '5': @@ -1707,7 +1735,11 @@ register char *s; } *d = '\0'; arg[1].arg_ptr.arg_str = str_make(tokenbuf, d - tokenbuf); +#ifdef MICROPORT /* Microport 2.4 hack */ + { double zz = str_2num(arg[1].arg_ptr.arg_str); } +#else (void)str_2num(arg[1].arg_ptr.arg_str); +#endif /* Microport 2.4 hack */ break; case '<': if (*++s == '<') { diff --git a/util.c b/util.c index d49978e..dd28d8d 100644 --- a/util.c +++ b/util.c @@ -1,4 +1,4 @@ -/* $Header: util.c,v 3.0.1.2 89/11/17 15:46:35 lwall Locked $ +/* $Header: util.c,v 3.0.1.3 89/12/21 20:27:41 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: util.c,v $ + * Revision 3.0.1.3 89/12/21 20:27:41 lwall + * patch7: errno may now be a macro with an lvalue + * * Revision 3.0.1.2 89/11/17 15:46:35 lwall * patch5: BZERO separate from BCOPY now * patch5: byteorder now is a hex value @@ -20,7 +23,6 @@ #include "EXTERN.h" #include "perl.h" -#include "errno.h" #include #ifdef I_VFORK @@ -695,8 +697,6 @@ int newlen; } } -extern int errno; - #ifndef VARARGS /*VARARGS1*/ mess(pat,a1,a2,a3,a4) diff --git a/x2p/walk.c b/x2p/walk.c index 62b64a4..ca1214d 100644 --- a/x2p/walk.c +++ b/x2p/walk.c @@ -1,4 +1,4 @@ -/* $Header: walk.c,v 3.0.1.2 89/11/17 15:53:00 lwall Locked $ +/* $Header: walk.c,v 3.0.1.3 89/12/21 20:32:35 lwall Locked $ * * Copyright (c) 1989, Larry Wall * @@ -6,6 +6,9 @@ * as specified in the README file that comes with the perl 3.0 kit. * * $Log: walk.c,v $ + * Revision 3.0.1.3 89/12/21 20:32:35 lwall + * patch7: in a2p, user-defined functions didn't work on some machines + * * Revision 3.0.1.2 89/11/17 15:53:00 lwall * patch5: on Pyramids, index(s, '}' + 128) doesn't find meta-} * @@ -1844,7 +1847,7 @@ int *numericptr; case OUSERFUN: tmp2str = str_new(0); str_scat(tmp2str,tmpstr=walk(1,level,ops[node+1].ival,&numarg,P_MIN)); - fixrargs(tmpstr->str_ptr,ops[node+2],0); + fixrargs(tmpstr->str_ptr,ops[node+2].ival,0); str_free(tmpstr); str_cat(tmp2str,"("); tmpstr = hfetch(symtab,tmp2str->str_ptr);