perl 3.0 patch #8 patch 7 continued
authorLarry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Thu, 21 Dec 1989 07:38:27 +0000 (07:38 +0000)
committerLarry Wall <lwall@jpl-devvax.jpl.nasa.gov>
Thu, 21 Dec 1989 07:38:27 +0000 (07:38 +0000)
See patch 7.

19 files changed:
cons.c
doarg.c
doio.c
dolist.c
eval.c
hash.c
patchlevel.h
perl.h
perl.man.3
perl.man.4
perl.y
perly.c
regexec.c
stab.c
stab.h
str.c
toke.c
util.c
x2p/walk.c

diff --git a/cons.c b/cons.c
index 6d4084a..6db876c 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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()
 #include <netdb.h>
 #endif
 
-#include <errno.h>
 #ifdef I_PWD
 #include <pwd.h>
 #endif
 #ifdef I_GRP
 #include <grp.h>
 #endif
-
-extern int errno;
+#ifdef I_UTIME
+#include <utime.h>
+#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;
index 7808151..4823231 100644 (file)
--- 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 (file)
--- 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
 #include "perl.h"
 
 #include <signal.h>
-#include <errno.h>
 
 #ifdef I_VFORK
 #   include <vfork.h>
 #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 (file)
--- 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 <errno.h>
-
-extern int errno;
 
 STR *
 hfetch(tb,key,klen,lval)
index e19cd94..a6997a9 100644 (file)
@@ -1 +1 @@
-#define PATCHLEVEL 7
+#define PATCHLEVEL 8
diff --git a/perl.h b/perl.h
index a9e3f14..038d41a 100644 (file)
--- 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 <time.h> including <sys/time.h>
  * 
  */
 
+#ifdef __STDC__
+#define VOLATILE volatile
+#define VREG
+#else
+#define VOLATILE
+#define VREG register
+#endif
+
 #define VOIDUSED 1
 #include "config.h"
 
 #   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 <sys/stat.h>
 
-#if defined(TMINSYS) || defined(I_SYSTIME)
-#include <sys/time.h>
-#ifdef I_TIMETOO
-#include <time.h>
-#endif
-#else
-#include <time.h>
-#ifdef I_SYSTIMETOO
-#include <time.h>
+#ifdef I_TIME
+#   include <time.h>
 #endif
+
+#ifdef I_SYSTIME
+#   ifdef SYSTIMEKERNEL
+#      define KERNEL
+#   endif
+#   include <sys/time.h>
+#   ifdef SYSTIMEKERNEL
+#      undef KERNEL
+#   endif
 #endif
 
 #include <sys/times.h>
 
+#if defined(STRERROR) && (!defined(MKDIR) || !defined(RMDIR))
+#undef STRERROR
+#endif
+
+#include <errno.h>
+#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 <sys/ioctl.h>
@@ -135,18 +191,23 @@ EXT int dbmlen;
 #define ntohi ntohl
 #endif
 
-#ifdef I_DIRENT
-#include <dirent.h>
-#define DIRENT dirent
-#else
-#ifdef I_SYSDIR
-#ifdef hp9000s500
-#include <ndir.h>      /* may be wrong in the future */
+#if defined(I_DIRENT) && !defined(xenix)
+#   include <dirent.h>
+#   define DIRENT dirent
 #else
-#include <sys/dir.h>
-#endif
-#define DIRENT direct
-#endif
+#   ifdef I_SYSDIR
+#      ifdef hp9000s500
+#          include <ndir.h>    /* may be wrong in the future */
+#      else
+#          include <sys/dir.h>
+#      endif
+#      define DIRENT direct
+#   else
+#      ifdef I_SYSNDIR
+#          include <sys/ndir.h>
+#          define DIRENT direct
+#      endif
+#   endif
 #endif
 
 typedef struct arg ARG;
index c5359f9..bd64915 100644 (file)
@@ -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
index 5f768aa..a3ab60c 100644 (file)
@@ -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 (file)
--- 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 (file)
--- 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) {
index 37fe129..0ccc830 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 <signal.h>
 
 #ifdef I_VFORK
@@ -695,8 +697,6 @@ int newlen;
     }
 }
 
-extern int errno;
-
 #ifndef VARARGS
 /*VARARGS1*/
 mess(pat,a1,a2,a3,a4)
index 62b64a4..ca1214d 100644 (file)
@@ -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);