This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
integrate cfgperl contents into mainline
authorGurusamy Sarathy <gsar@cpan.org>
Thu, 14 Oct 1999 18:15:11 +0000 (18:15 +0000)
committerGurusamy Sarathy <gsar@cpan.org>
Thu, 14 Oct 1999 18:15:11 +0000 (18:15 +0000)
p4raw-id: //depot/perl@4377

19 files changed:
XSUB.h
cop.h
embed.h
embed.pl
ext/File/Glob/bsd_glob.c
perl.c
perlapi.c [changed mode: 0755->0644]
perlapi.h [changed mode: 0755->0644]
pp_ctl.c
proto.h
scope.c
scope.h
t/op/filetest.t [changed mode: 0644->0755]
t/op/runlevel.t
t/op/subst_amp.t [changed mode: 0644->0755]
util.c
utils/h2xs.PL
win32/Makefile
win32/makefile.mk

diff --git a/XSUB.h b/XSUB.h
index 5ce8fb4..ae746a6 100644 (file)
--- a/XSUB.h
+++ b/XSUB.h
 #    define read               PerlLIO_read
 #    define rename             PerlLIO_rename
 #    define setmode            PerlLIO_setmode
-#    define stat               PerlLIO_stat
+#    define stat(buf,sb)       PerlLIO_stat(buf,sb)
 #    define tmpnam             PerlLIO_tmpnam
 #    define umask              PerlLIO_umask
 #    define unlink             PerlLIO_unlink
diff --git a/cop.h b/cop.h
index 457aeb4..ea846ab 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -296,7 +296,6 @@ struct context {
 #define G_NOARGS       8       /* Don't construct a @_ array. */
 #define G_KEEPERR      16      /* Append errors to $@, don't overwrite it */
 #define G_NODEBUG      32      /* Disable debugging at toplevel.  */
-#define G_NOCATCH      64       /* Don't do CATCH_SET() */
 
 /* flag bits for PL_in_eval */
 #define EVAL_NULL      0       /* not in an eval */
diff --git a/embed.h b/embed.h
index 18953ae..bf2a0e8 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define do_pmop_dump(a,b,c)    Perl_do_pmop_dump(aTHX_ a,b,c)
 #define do_sv_dump(a,b,c,d,e,f,g)      Perl_do_sv_dump(aTHX_ a,b,c,d,e,f,g)
 #define magic_dump(a)          Perl_magic_dump(aTHX_ a)
-#define vdefault_protect(a,b,c)        Perl_vdefault_protect(aTHX_ a,b,c)
+#define vdefault_protect(a,b,c,d)      Perl_vdefault_protect(aTHX_ a,b,c,d)
 #define reginitcolors()                Perl_reginitcolors(aTHX)
 #define sv_2pv_nolen(a)                Perl_sv_2pv_nolen(aTHX_ a)
 #define sv_pv(a)               Perl_sv_pv(aTHX_ a)
index e44ba23..7c05ab7 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -1756,8 +1756,10 @@ p        |void   |do_pmop_dump   |I32 level|PerlIO *file|PMOP *pm
 p      |void   |do_sv_dump     |I32 level|PerlIO *file|SV *sv|I32 nest \
                                |I32 maxnest|bool dumpops|STRLEN pvlim
 p      |void   |magic_dump     |MAGIC *mg
-p      |void*  |default_protect|int *excpt|protect_body_t body|...
-p      |void*  |vdefault_protect|int *excpt|protect_body_t body|va_list *args
+p      |void*  |default_protect|volatile JMPENV *je|int *excpt \
+                               |protect_body_t body|...
+p      |void*  |vdefault_protect|volatile JMPENV *je|int *excpt \
+                               |protect_body_t body|va_list *args
 p      |void   |reginitcolors
 p      |char*  |sv_2pv_nolen   |SV* sv
 p      |char*  |sv_pv          |SV *sv
index 38ace47..3ff4c92 100644 (file)
@@ -71,6 +71,8 @@ static char sccsid[] = "@(#)glob.c    8.3 (Berkeley) 10/13/93";
 
 #include <EXTERN.h>
 #include <perl.h>
+#include <XSUB.h>
+
 #include "bsd_glob.h"
 #ifdef I_PWD
 #      include <pwd.h>
@@ -89,23 +91,23 @@ static char sccsid[] = "@(#)glob.c  8.3 (Berkeley) 10/13/93";
 #  endif
 #endif
 
-#define        DOLLAR          '$'
-#define        DOT             '.'
-#define        EOS             '\0'
-#define        LBRACKET        '['
-#define        NOT             '!'
-#define        QUESTION        '?'
-#define        QUOTE           '\\'
-#define        RANGE           '-'
-#define        RBRACKET        ']'
-#define        SEP             '/'
-#define        STAR            '*'
-#define        TILDE           '~'
-#define        UNDERSCORE      '_'
-#define        LBRACE          '{'
-#define        RBRACE          '}'
-#define        SLASH           '/'
-#define        COMMA           ','
+#define        BG_DOLLAR       '$'
+#define        BG_DOT          '.'
+#define        BG_EOS          '\0'
+#define        BG_LBRACKET     '['
+#define        BG_NOT          '!'
+#define        BG_QUESTION     '?'
+#define        BG_QUOTE        '\\'
+#define        BG_RANGE        '-'
+#define        BG_RBRACKET     ']'
+#define        BG_SEP          '/'
+#define        BG_STAR         '*'
+#define        BG_TILDE        '~'
+#define        BG_UNDERSCORE   '_'
+#define        BG_LBRACE       '{'
+#define        BG_RBRACE       '}'
+#define        BG_SLASH        '/'
+#define        BG_COMMA        ','
 
 #ifndef GLOB_DEBUG
 
@@ -161,6 +163,18 @@ static int  match(Char *, Char *, Char *);
 static void     qprintf(const char *, Char *);
 #endif /* GLOB_DEBUG */
 
+#ifdef PERL_IMPLICIT_CONTEXT
+static Direntry_t *    my_readdir(DIR*);
+
+static Direntry_t *
+my_readdir(DIR *d)
+{
+    return PerlDir_read(d);
+}
+#else
+#define        my_readdir      readdir
+#endif
+
 int
 bsd_glob(const char *pattern, int flags,
         int (*errfunc)(const char *, int), glob_t *pglob)
@@ -184,10 +198,10 @@ bsd_glob(const char *pattern, int flags,
        bufend = bufnext + MAXPATHLEN;
        if (flags & GLOB_QUOTE) {
                /* Protect the quoted characters. */
-               while (bufnext < bufend && (c = *patnext++) != EOS)
-                       if (c == QUOTE) {
-                               if ((c = *patnext++) == EOS) {
-                                       c = QUOTE;
+               while (bufnext < bufend && (c = *patnext++) != BG_EOS)
+                       if (c == BG_QUOTE) {
+                               if ((c = *patnext++) == BG_EOS) {
+                                       c = BG_QUOTE;
                                        --patnext;
                                }
                                *bufnext++ = c | M_PROTECT;
@@ -196,9 +210,9 @@ bsd_glob(const char *pattern, int flags,
                                *bufnext++ = c;
        }
        else
-           while (bufnext < bufend && (c = *patnext++) != EOS)
+           while (bufnext < bufend && (c = *patnext++) != BG_EOS)
                    *bufnext++ = c;
-       *bufnext = EOS;
+       *bufnext = BG_EOS;
 
        if (flags & GLOB_BRACE)
            return globexp1(patbuf, pglob);
@@ -217,10 +231,10 @@ static int globexp1(const Char *pattern, glob_t *pglob)
        int rv;
 
        /* Protect a single {}, for find(1), like csh */
-       if (pattern[0] == LBRACE && pattern[1] == RBRACE && pattern[2] == EOS)
+       if (pattern[0] == BG_LBRACE && pattern[1] == BG_RBRACE && pattern[2] == BG_EOS)
                return glob0(pattern, pglob);
 
-       while ((ptr = (const Char *) g_strchr((Char *) ptr, LBRACE)) != NULL)
+       while ((ptr = (const Char *) g_strchr((Char *) ptr, BG_LBRACE)) != NULL)
                if (!globexp2(ptr, pattern, pglob, &rv))
                        return rv;
 
@@ -248,59 +262,59 @@ static int globexp2(const Char *ptr, const Char *pattern,
 
        /* Find the balanced brace */
        for (i = 0, pe = ++ptr; *pe; pe++)
-               if (*pe == LBRACKET) {
+               if (*pe == BG_LBRACKET) {
                        /* Ignore everything between [] */
-                       for (pm = pe++; *pe != RBRACKET && *pe != EOS; pe++)
+                       for (pm = pe++; *pe != BG_RBRACKET && *pe != BG_EOS; pe++)
                                continue;
-                       if (*pe == EOS) {
+                       if (*pe == BG_EOS) {
                                /*
-                                * We could not find a matching RBRACKET.
-                                * Ignore and just look for RBRACE
+                                * We could not find a matching BG_RBRACKET.
+                                * Ignore and just look for BG_RBRACE
                                 */
                                pe = pm;
                        }
                }
-               else if (*pe == LBRACE)
+               else if (*pe == BG_LBRACE)
                        i++;
-               else if (*pe == RBRACE) {
+               else if (*pe == BG_RBRACE) {
                        if (i == 0)
                                break;
                        i--;
                }
 
        /* Non matching braces; just glob the pattern */
-       if (i != 0 || *pe == EOS) {
+       if (i != 0 || *pe == BG_EOS) {
                *rv = glob0(patbuf, pglob);
                return 0;
        }
 
        for (i = 0, pl = pm = ptr; pm <= pe; pm++)
                switch (*pm) {
-               case LBRACKET:
+               case BG_LBRACKET:
                        /* Ignore everything between [] */
-                       for (pl = pm++; *pm != RBRACKET && *pm != EOS; pm++)
+                       for (pl = pm++; *pm != BG_RBRACKET && *pm != BG_EOS; pm++)
                                continue;
-                       if (*pm == EOS) {
+                       if (*pm == BG_EOS) {
                                /*
-                                * We could not find a matching RBRACKET.
-                                * Ignore and just look for RBRACE
+                                * We could not find a matching BG_RBRACKET.
+                                * Ignore and just look for BG_RBRACE
                                 */
                                pm = pl;
                        }
                        break;
 
-               case LBRACE:
+               case BG_LBRACE:
                        i++;
                        break;
 
-               case RBRACE:
+               case BG_RBRACE:
                        if (i) {
                            i--;
                            break;
                        }
                        /* FALLTHROUGH */
-               case COMMA:
-                       if (i && *pm == COMMA)
+               case BG_COMMA:
+                       if (i && *pm == BG_COMMA)
                                break;
                        else {
                                /* Append the current string */
@@ -310,7 +324,7 @@ static int globexp2(const Char *ptr, const Char *pattern,
                                 * Append the rest of the pattern after the
                                 * closing brace
                                 */
-                               for (pl = pe + 1; (*lm++ = *pl++) != EOS;)
+                               for (pl = pe + 1; (*lm++ = *pl++) != BG_EOS;)
                                        continue;
 
                                /* Expand the current pattern */
@@ -344,17 +358,17 @@ globtilde(const Char *pattern, Char *patbuf, glob_t *pglob)
        const Char *p;
        Char *b;
 
-       if (*pattern != TILDE || !(pglob->gl_flags & GLOB_TILDE))
+       if (*pattern != BG_TILDE || !(pglob->gl_flags & GLOB_TILDE))
                return pattern;
 
        /* Copy up to the end of the string or / */
-       for (p = pattern + 1, h = (char *) patbuf; *p && *p != SLASH;
+       for (p = pattern + 1, h = (char *) patbuf; *p && *p != BG_SLASH;
             *h++ = *p++)
                continue;
 
-       *h = EOS;
+       *h = BG_EOS;
 
-       if (((char *) patbuf)[0] == EOS) {
+       if (((char *) patbuf)[0] == BG_EOS) {
                /*
                 * handle a plain ~ or ~/ by expanding $HOME
                 * first and then trying the password file
@@ -389,7 +403,7 @@ globtilde(const Char *pattern, Char *patbuf, glob_t *pglob)
                continue;
 
        /* Append the rest of the pattern */
-       while ((*b++ = *p++) != EOS)
+       while ((*b++ = *p++) != BG_EOS)
                continue;
 
        return patbuf;
@@ -417,40 +431,40 @@ glob0(const Char *pattern, glob_t *pglob)
        bufnext = patbuf;
 
        /* We don't need to check for buffer overflow any more. */
-       while ((c = *qpatnext++) != EOS) {
+       while ((c = *qpatnext++) != BG_EOS) {
                switch (c) {
-               case LBRACKET:
+               case BG_LBRACKET:
                        c = *qpatnext;
-                       if (c == NOT)
+                       if (c == BG_NOT)
                                ++qpatnext;
-                       if (*qpatnext == EOS ||
-                           g_strchr((Char *) qpatnext+1, RBRACKET) == NULL) {
-                               *bufnext++ = LBRACKET;
-                               if (c == NOT)
+                       if (*qpatnext == BG_EOS ||
+                           g_strchr((Char *) qpatnext+1, BG_RBRACKET) == NULL) {
+                               *bufnext++ = BG_LBRACKET;
+                               if (c == BG_NOT)
                                        --qpatnext;
                                break;
                        }
                        *bufnext++ = M_SET;
-                       if (c == NOT)
+                       if (c == BG_NOT)
                                *bufnext++ = M_NOT;
                        c = *qpatnext++;
                        do {
                                *bufnext++ = CHAR(c);
-                               if (*qpatnext == RANGE &&
-                                   (c = qpatnext[1]) != RBRACKET) {
+                               if (*qpatnext == BG_RANGE &&
+                                   (c = qpatnext[1]) != BG_RBRACKET) {
                                        *bufnext++ = M_RNG;
                                        *bufnext++ = CHAR(c);
                                        qpatnext += 2;
                                }
-                       } while ((c = *qpatnext++) != RBRACKET);
+                       } while ((c = *qpatnext++) != BG_RBRACKET);
                        pglob->gl_flags |= GLOB_MAGCHAR;
                        *bufnext++ = M_END;
                        break;
-               case QUESTION:
+               case BG_QUESTION:
                        pglob->gl_flags |= GLOB_MAGCHAR;
                        *bufnext++ = M_ONE;
                        break;
-               case STAR:
+               case BG_STAR:
                        pglob->gl_flags |= GLOB_MAGCHAR;
                        /* collapse adjacent stars to one,
                         * to avoid exponential behavior
@@ -463,7 +477,7 @@ glob0(const Char *pattern, glob_t *pglob)
                        break;
                }
        }
-       *bufnext = EOS;
+       *bufnext = BG_EOS;
 #ifdef GLOB_DEBUG
        qprintf("glob0:", patbuf);
 #endif /* GLOB_DEBUG */
@@ -509,7 +523,7 @@ glob1(Char *pattern, glob_t *pglob)
        Char pathbuf[MAXPATHLEN+1];
 
        /* A null pathname is invalid -- POSIX 1003.1 sect. 2.4. */
-       if (*pattern == EOS)
+       if (*pattern == BG_EOS)
                return(0);
        return(glob2(pathbuf, pathbuf, pattern, pglob));
 }
@@ -531,21 +545,19 @@ glob2(Char *pathbuf, Char *pathend, Char *pattern, glob_t *pglob)
         * segment with meta character found.
         */
        for (anymeta = 0;;) {
-               if (*pattern == EOS) {          /* End of pattern? */
-                       *pathend = EOS;
+               if (*pattern == BG_EOS) {               /* End of pattern? */
+                       *pathend = BG_EOS;
 
-#ifdef HAS_LSTAT
                        if (g_lstat(pathbuf, &sb, pglob))
                                return(0);
-#endif /* HAS_LSTAT */
 
                        if (((pglob->gl_flags & GLOB_MARK) &&
-                           pathend[-1] != SEP) && (S_ISDIR(sb.st_mode)
+                           pathend[-1] != BG_SEP) && (S_ISDIR(sb.st_mode)
                            || (S_ISLNK(sb.st_mode) &&
                            (g_stat(pathbuf, &sb, pglob) == 0) &&
                            S_ISDIR(sb.st_mode)))) {
-                               *pathend++ = SEP;
-                               *pathend = EOS;
+                               *pathend++ = BG_SEP;
+                               *pathend = BG_EOS;
                        }
                        ++pglob->gl_matchc;
 #ifdef GLOB_DEBUG
@@ -557,7 +569,7 @@ glob2(Char *pathbuf, Char *pathend, Char *pattern, glob_t *pglob)
                /* Find end of next segment, copy tentatively to pathend. */
                q = pathend;
                p = pattern;
-               while (*p != EOS && *p != SEP) {
+               while (*p != BG_EOS && *p != BG_SEP) {
                        if (ismeta(*p))
                                anymeta = 1;
                        *q++ = *p++;
@@ -566,7 +578,7 @@ glob2(Char *pathbuf, Char *pathend, Char *pattern, glob_t *pglob)
                if (!anymeta) {         /* No expansion, do next segment. */
                        pathend = q;
                        pattern = p;
-                       while (*pattern == SEP)
+                       while (*pattern == BG_SEP)
                                *pathend++ = *pattern++;
                } else                  /* Need expansion, recurse. */
                        return(glob3(pathbuf, pathend, pattern, p, pglob));
@@ -591,7 +603,7 @@ glob3(Char *pathbuf, Char *pathend, Char *pattern,
         */
        Direntry_t *(*readdirfunc)();
 
-       *pathend = EOS;
+       *pathend = BG_EOS;
        errno = 0;
 
        if ((dirp = g_opendir(pathbuf, pglob)) == NULL) {
@@ -611,19 +623,19 @@ glob3(Char *pathbuf, Char *pathend, Char *pattern,
        if (pglob->gl_flags & GLOB_ALTDIRFUNC)
                readdirfunc = pglob->gl_readdir;
        else
-               readdirfunc = readdir;
+               readdirfunc = my_readdir;
        while ((dp = (*readdirfunc)(dirp))) {
                register U8 *sc;
                register Char *dc;
 
-               /* Initial DOT must be matched literally. */
-               if (dp->d_name[0] == DOT && *pattern != DOT)
+               /* Initial BG_DOT must be matched literally. */
+               if (dp->d_name[0] == BG_DOT && *pattern != BG_DOT)
                        continue;
                for (sc = (U8 *) dp->d_name, dc = pathend;
-                    (*dc++ = *sc++) != EOS;)
+                    (*dc++ = *sc++) != BG_EOS;)
                        continue;
                if (!match(pathend, pattern, restpattern)) {
-                       *pathend = EOS;
+                       *pathend = BG_EOS;
                        continue;
                }
                err = glob2(pathbuf, --dc, restpattern, pglob);
@@ -634,7 +646,7 @@ glob3(Char *pathbuf, Char *pathend, Char *pattern,
        if (pglob->gl_flags & GLOB_ALTDIRFUNC)
                (*pglob->gl_closedir)(dirp);
        else
-               closedir(dirp);
+               PerlDir_close(dirp);
        return(err);
 }
 
@@ -658,7 +670,6 @@ globextend(const Char *path, glob_t *pglob)
 {
        register char **pathv;
        register int i;
-       Size_t newsize;
        char *copy;
        const Char *p;
 
@@ -667,12 +678,13 @@ globextend(const Char *path, glob_t *pglob)
         for (p = path; *p; p++)
                 (void)printf("%c", CHAR(*p));
         printf("\n");
-#endif GLOB_DEBUG
+#endif /* GLOB_DEBUG */
 
-       newsize = sizeof(*pathv) * (2 + pglob->gl_pathc + pglob->gl_offs);
-       pathv = pglob->gl_pathv ?
-                   realloc((char *)pglob->gl_pathv, newsize) :
-                   malloc(newsize);
+       if (pglob->gl_pathv)
+               pathv = Renew(pglob->gl_pathv,
+                             (2 + pglob->gl_pathc + pglob->gl_offs),char*);
+       else
+               New(0,pathv,(2 + pglob->gl_pathc + pglob->gl_offs),char*);
        if (pathv == NULL)
                return(GLOB_NOSPACE);
 
@@ -686,7 +698,8 @@ globextend(const Char *path, glob_t *pglob)
 
        for (p = path; *p++;)
                continue;
-       if ((copy = malloc(p - path)) != NULL) {
+       New(0, copy, p-path, char);
+       if (copy != NULL) {
                g_Ctoc(path, copy);
                pathv[pglob->gl_offs + pglob->gl_pathc++] = copy;
        }
@@ -714,17 +727,17 @@ match(register Char *name, register Char *pat, register Char *patend)
                        do
                            if (match(name, pat, patend))
                                    return(1);
-                       while (*name++ != EOS);
+                       while (*name++ != BG_EOS);
                        return(0);
                case M_ONE:
-                       if (*name++ == EOS)
+                       if (*name++ == BG_EOS)
                                return(0);
                        break;
                case M_SET:
                        ok = 0;
-                       if ((k = *name++) == EOS)
+                       if ((k = *name++) == BG_EOS)
                                return(0);
-                       if ((negate_range = ((*pat & M_MASK) == M_NOT)) != EOS)
+                       if ((negate_range = ((*pat & M_MASK) == M_NOT)) != BG_EOS)
                                ++pat;
                        while (((c = *pat++) & M_MASK) != M_END)
                                if ((*pat & M_MASK) == M_RNG) {
@@ -742,7 +755,7 @@ match(register Char *name, register Char *pat, register Char *patend)
                        break;
                }
        }
-       return(*name == EOS);
+       return(*name == BG_EOS);
 }
 
 /* Free allocated data belonging to a glob_t structure. */
@@ -756,8 +769,8 @@ bsd_globfree(glob_t *pglob)
                pp = pglob->gl_pathv + pglob->gl_offs;
                for (i = pglob->gl_pathc; i--; ++pp)
                        if (*pp)
-                               free(*pp);
-               free(pglob->gl_pathv);
+                               Safefree(*pp);
+               Safefree(pglob->gl_pathv);
        }
 }
 
@@ -773,11 +786,10 @@ g_opendir(register Char *str, glob_t *pglob)
 
        if (pglob->gl_flags & GLOB_ALTDIRFUNC)
                return((*pglob->gl_opendir)(buf));
-
-       return(opendir(buf));
+       else
+           return(PerlDir_open(buf));
 }
 
-#ifdef HAS_LSTAT
 static int
 g_lstat(register Char *fn, Stat_t *sb, glob_t *pglob)
 {
@@ -786,9 +798,12 @@ g_lstat(register Char *fn, Stat_t *sb, glob_t *pglob)
        g_Ctoc(fn, buf);
        if (pglob->gl_flags & GLOB_ALTDIRFUNC)
                return((*pglob->gl_lstat)(buf, sb));
-       return(lstat(buf, sb));
-}
+#ifdef HAS_LSTAT
+       return(PerlLIO_lstat(buf, sb));
+#else
+       return(PerlLIO_stat(buf, sb));
 #endif /* HAS_LSTAT */
+}
 
 static int
 g_stat(register Char *fn, Stat_t *sb, glob_t *pglob)
@@ -798,7 +813,7 @@ g_stat(register Char *fn, Stat_t *sb, glob_t *pglob)
        g_Ctoc(fn, buf);
        if (pglob->gl_flags & GLOB_ALTDIRFUNC)
                return((*pglob->gl_stat)(buf, sb));
-       return(stat(buf, sb));
+       return(PerlLIO_stat(buf, sb));
 }
 
 static Char *
@@ -820,7 +835,7 @@ g_strcat(Char *dst, const Char *src)
        while (*dst++)
                continue;
        --dst;
-       while((*dst++ = *src++) != EOS)
+       while((*dst++ = *src++) != BG_EOS)
            continue;
 
        return (sdst);
@@ -832,7 +847,7 @@ g_Ctoc(register const Char *str, char *buf)
 {
        register char *dc;
 
-       for (dc = buf; (*dc++ = *str++) != EOS;)
+       for (dc = buf; (*dc++ = *str++) != BG_EOS;)
                continue;
 }
 
diff --git a/perl.c b/perl.c
index 74884b2..a117b7b 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -590,6 +590,7 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
     dTHR;
     I32 oldscope;
     int ret;
+    dJMPENV;
 #ifdef USE_THREADS
     dTHX;
 #endif
@@ -638,7 +639,8 @@ setuid perl scripts securely.\n");
     oldscope = PL_scopestack_ix;
     PL_dowarn = G_WARN_OFF;
 
-    CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_parse_body), env, xsinit);
+    CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_parse_body),
+               env, xsinit);
     switch (ret) {
     case 0:
        return 0;
@@ -1005,6 +1007,7 @@ perl_run(pTHXx)
     dTHR;
     I32 oldscope;
     int ret;
+    dJMPENV;
 #ifdef USE_THREADS
     dTHX;
 #endif
@@ -1012,7 +1015,7 @@ perl_run(pTHXx)
     oldscope = PL_scopestack_ix;
 
  redo_body:
-    CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_run_body), oldscope);
+    CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_run_body), oldscope);
     switch (ret) {
     case 1:
        cxstack_ix = -1;                /* start context stack again */
@@ -1206,6 +1209,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
     bool oldcatch = CATCH_GET;
     int ret;
     OP* oldop = PL_op;
+    dJMPENV;
 
     if (flags & G_DISCARD) {
        ENTER;
@@ -1237,16 +1241,10 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
        PL_op->op_private |= OPpENTERSUB_DB;
 
     if (!(flags & G_EVAL)) {
-        /* G_NOCATCH is a hack for perl_vdie using this path to call
-          a __DIE__ handler */
-        if (!(flags & G_NOCATCH)) {
-           CATCH_SET(TRUE);
-       }
+       CATCH_SET(TRUE);
        call_xbody((OP*)&myop, FALSE);
        retval = PL_stack_sp - (PL_stack_base + oldmark);
-        if (!(flags & G_NOCATCH)) {
-           CATCH_SET(FALSE);
-       }
+       CATCH_SET(FALSE);
     }
     else {
        cLOGOP->op_other = PL_op;
@@ -1273,7 +1271,8 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
        PL_markstack_ptr++;
 
   redo_body:
-       CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_call_body), (OP*)&myop, FALSE);
+       CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_body),
+                   (OP*)&myop, FALSE);
        switch (ret) {
        case 0:
            retval = PL_stack_sp - (PL_stack_base + oldmark);
@@ -1371,6 +1370,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
     I32 oldscope;
     int ret;
     OP* oldop = PL_op;
+    dJMPENV;
 
     if (flags & G_DISCARD) {
        ENTER;
@@ -1395,7 +1395,8 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
        myop.op_flags |= OPf_SPECIAL;
 
  redo_body:
-    CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_call_body), (OP*)&myop, TRUE);
+    CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_body),
+               (OP*)&myop, TRUE);
     switch (ret) {
     case 0:
        retval = PL_stack_sp - (PL_stack_base + oldmark);
@@ -2990,11 +2991,12 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
     CV *cv;
     STRLEN len;
     int ret;
+    dJMPENV;
 
     while (AvFILL(paramList) >= 0) {
        cv = (CV*)av_shift(paramList);
        SAVEFREESV(cv);
-       CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_call_list_body), cv);
+       CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_list_body), cv);
        switch (ret) {
        case 0:
            (void)SvPV(atsv, len);
old mode 100755 (executable)
new mode 100644 (file)
index ac38dff..99a549b
--- a/perlapi.c
+++ b/perlapi.c
@@ -4754,12 +4754,12 @@ Perl_magic_dump(pTHXo_ MAGIC *mg)
 
 #undef  Perl_default_protect
 void*
-Perl_default_protect(pTHXo_ int *excpt, protect_body_t body, ...)
+Perl_default_protect(pTHXo_ volatile JMPENV *je, int *excpt, protect_body_t body, ...)
 {
     void* retval;
     va_list args;
     va_start(args, body);
-    retval = ((CPerlObj*)pPerl)->Perl_vdefault_protect(excpt, body, &args);
+    retval = ((CPerlObj*)pPerl)->Perl_vdefault_protect(je, excpt, body, &args);
     va_end(args);
     return retval;
 
@@ -4767,9 +4767,9 @@ Perl_default_protect(pTHXo_ int *excpt, protect_body_t body, ...)
 
 #undef  Perl_vdefault_protect
 void*
-Perl_vdefault_protect(pTHXo_ int *excpt, protect_body_t body, va_list *args)
+Perl_vdefault_protect(pTHXo_ volatile JMPENV *je, int *excpt, protect_body_t body, va_list *args)
 {
-    return ((CPerlObj*)pPerl)->Perl_vdefault_protect(excpt, body, args);
+    return ((CPerlObj*)pPerl)->Perl_vdefault_protect(je, excpt, body, args);
 }
 
 #undef  Perl_reginitcolors
old mode 100755 (executable)
new mode 100644 (file)
index 3bf4f1d..5e45a9c 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2436,18 +2436,20 @@ S_docatch(pTHX_ OP *o)
     dTHR;
     int ret;
     OP *oldop = PL_op;
+    volatile PERL_SI *cursi = PL_curstackinfo;
+    dJMPENV;
 
 #ifdef DEBUGGING
     assert(CATCH_GET == TRUE);
 #endif
     PL_op = o;
  redo_body:
-    CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_docatch_body));
+    CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_docatch_body));
     switch (ret) {
     case 0:
        break;
     case 3:
-       if (PL_restartop) {
+       if (PL_restartop && cursi == PL_curstackinfo) {
            PL_op = PL_restartop;
            PL_restartop = 0;
            goto redo_body;
diff --git a/proto.h b/proto.h
index 6551c31..787ec13 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -724,8 +724,8 @@ VIRTUAL void        Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o);
 VIRTUAL void   Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, PMOP *pm);
 VIRTUAL void   Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim);
 VIRTUAL void   Perl_magic_dump(pTHX_ MAGIC *mg);
-VIRTUAL void*  Perl_default_protect(pTHX_ int *excpt, protect_body_t body, ...);
-VIRTUAL void*  Perl_vdefault_protect(pTHX_ int *excpt, protect_body_t body, va_list *args);
+VIRTUAL void*  Perl_default_protect(pTHX_ volatile JMPENV *je, int *excpt, protect_body_t body, ...);
+VIRTUAL void*  Perl_vdefault_protect(pTHX_ volatile JMPENV *je, int *excpt, protect_body_t body, va_list *args);
 VIRTUAL void   Perl_reginitcolors(pTHX);
 VIRTUAL char*  Perl_sv_2pv_nolen(pTHX_ SV* sv);
 VIRTUAL char*  Perl_sv_pv(pTHX_ SV *sv);
diff --git a/scope.c b/scope.c
index 9ee0429..1597acc 100644 (file)
--- a/scope.c
+++ b/scope.c
 #include "perl.h"
 
 void *
-Perl_default_protect(pTHX_ int *excpt, protect_body_t body, ...)
+Perl_default_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt,
+                    protect_body_t body, ...)
 {
     void *ret;
     va_list args;
     va_start(args, body);
-    ret = vdefault_protect(excpt, body, &args);
+    ret = vdefault_protect(pcur_env, excpt, body, &args);
     va_end(args);
     return ret;
 }
 
 void *
-Perl_vdefault_protect(pTHX_ int *excpt, protect_body_t body, va_list *args)
+Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt,
+                     protect_body_t body, va_list *args)
 {
     dTHR;
-    dJMPENV;
     int ex;
     void *ret;
 
     DEBUG_l(Perl_deb(aTHX_ "Setting up local jumplevel %p, was %p\n",
-               &cur_env, PL_top_env));
+               pcur_env, PL_top_env));
     JMPENV_PUSH(ex);
     if (ex)
        ret = NULL;
diff --git a/scope.h b/scope.h
index f481306..9a196e6 100644 (file)
--- a/scope.h
+++ b/scope.h
@@ -148,6 +148,7 @@ struct jmpenv {
     int                        je_ret;         /* last exception thrown */
     bool               je_mustcatch;   /* need to call longjmp()? */
     void               (*je_throw)(int v); /* last for bincompat */
+    bool               je_noset;       /* no need for setjmp() */
 };
 
 typedef struct jmpenv JMPENV;
@@ -157,7 +158,8 @@ typedef struct jmpenv JMPENV;
  *  body of protected processing.
  */
 typedef void *(CPERLscope(*protect_body_t)) (pTHX_ va_list);
-typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ int *, protect_body_t, ...);
+typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env,
+                                            int *, protect_body_t, ...);
 
 /*
  * How to build the first jmpenv.
@@ -175,6 +177,7 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ int *, protect_body_t, ...);
        PL_start_env.je_throw = NULL;           \
        PL_start_env.je_ret = -1;               \
        PL_start_env.je_mustcatch = TRUE;       \
+       PL_start_env.je_noset = 0;              \
        PL_top_env = &PL_start_env;             \
     } STMT_END
 
@@ -216,43 +219,49 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ int *, protect_body_t, ...);
  *    JMPENV_POP;  // don't forget this!
  */
 
-#define dJMPENV                JMPENV cur_env
+#define dJMPENV        JMPENV cur_env; \
+               volatile JMPENV *pcur_env = ((cur_env.je_noset = 0),&cur_env)
 
-#define JMPENV_PUSH_INIT_ENV(cur_env,THROWFUNC) \
+#define JMPENV_PUSH_INIT_ENV(ce,THROWFUNC) \
     STMT_START {                                       \
-       cur_env.je_throw = (THROWFUNC);                 \
-       cur_env.je_ret = -1;                            \
-       cur_env.je_mustcatch = FALSE;                   \
-       cur_env.je_prev = PL_top_env;                   \
-       PL_top_env = &cur_env;                          \
+       (ce).je_throw = (THROWFUNC);                    \
+       (ce).je_ret = -1;                               \
+       (ce).je_mustcatch = FALSE;                      \
+       (ce).je_prev = PL_top_env;                      \
+       PL_top_env = &(ce);                             \
        OP_REG_TO_MEM;                                  \
     } STMT_END
 
-#define JMPENV_PUSH_INIT(THROWFUNC) JMPENV_PUSH_INIT_ENV(cur_env,THROWFUNC) 
+#define JMPENV_PUSH_INIT(THROWFUNC) JMPENV_PUSH_INIT_ENV(*(JMPENV*)pcur_env,THROWFUNC) 
 
-#define JMPENV_POST_CATCH_ENV(cur_env) \
+#define JMPENV_POST_CATCH_ENV(ce) \
     STMT_START {                                       \
        OP_MEM_TO_REG;                                  \
-       PL_top_env = &cur_env;                          \
+       PL_top_env = &(ce);                             \
     } STMT_END
 
-#define JMPENV_POST_CATCH JMPENV_POST_CATCH_ENV(cur_env)
+#define JMPENV_POST_CATCH JMPENV_POST_CATCH_ENV(*(JMPENV*)pcur_env)
 
 
-#define JMPENV_PUSH_ENV(cur_env,v) \
-    STMT_START {                                       \
-       JMPENV_PUSH_INIT_ENV(cur_env,NULL);                             \
-       EXCEPT_SET_ENV(cur_env,PerlProc_setjmp(cur_env.je_buf, 1));     \
-       JMPENV_POST_CATCH_ENV(cur_env);                         \
-       (v) = EXCEPT_GET_ENV(cur_env);                          \
+#define JMPENV_PUSH_ENV(ce,v) \
+    STMT_START {                                               \
+       if (!(ce).je_noset) {                                   \
+           JMPENV_PUSH_INIT_ENV(ce,NULL);                      \
+           EXCEPT_SET_ENV(ce,PerlProc_setjmp((ce).je_buf, 1));\
+           (ce).je_noset = 1;                                  \
+       }                                                       \
+       else                                                    \
+           EXCEPT_SET_ENV(ce,0);                               \
+       JMPENV_POST_CATCH_ENV(ce);                              \
+       (v) = EXCEPT_GET_ENV(ce);                               \
     } STMT_END
 
-#define JMPENV_PUSH(v) JMPENV_PUSH_ENV(cur_env,v) 
+#define JMPENV_PUSH(v) JMPENV_PUSH_ENV(*(JMPENV*)pcur_env,v) 
 
-#define JMPENV_POP_ENV(cur_env) \
-    STMT_START { PL_top_env = cur_env.je_prev; } STMT_END
+#define JMPENV_POP_ENV(ce) \
+    STMT_START { PL_top_env = (ce).je_prev; } STMT_END
 
-#define JMPENV_POP  JMPENV_POP_ENV(cur_env) 
+#define JMPENV_POP  JMPENV_POP_ENV(*(JMPENV*)pcur_env) 
 
 #define JMPENV_JUMP(v) \
     STMT_START {                                               \
@@ -269,11 +278,10 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ int *, protect_body_t, ...);
        PerlProc_exit(1);                                       \
     } STMT_END
 
-#define EXCEPT_GET_ENV(cur_env)        (cur_env.je_ret)
-#define EXCEPT_GET EXCEPT_GET_ENV(cur_env)
-#define EXCEPT_SET_ENV(cur_env,v)      (cur_env.je_ret = (v))
-#define EXCEPT_SET(v) EXCEPT_SET_ENV(cur_env,v)
+#define EXCEPT_GET_ENV(ce)     ((ce).je_ret)
+#define EXCEPT_GET             EXCEPT_GET_ENV(*(JMPENV*)pcur_env)
+#define EXCEPT_SET_ENV(ce,v)   ((ce).je_ret = (v))
+#define EXCEPT_SET(v)          EXCEPT_SET_ENV(*(JMPENV*)pcur_env,v)
 
-#define CATCH_GET      (PL_top_env->je_mustcatch)
-#define CATCH_SET(v)   (PL_top_env->je_mustcatch = (v))
-   
+#define CATCH_GET              (PL_top_env->je_mustcatch)
+#define CATCH_SET(v)           (PL_top_env->je_mustcatch = (v))
old mode 100644 (file)
new mode 100755 (executable)
index a155177..1dc2a23 100755 (executable)
@@ -335,3 +335,17 @@ tie my @bar, 'TEST';
 print join('|', @bar[0..3]), "\n"; 
 EXPECT
 foo|fee|fie|foe
+########
+package TH;
+sub TIEHASH { bless {}, TH }
+sub STORE { eval { print "@_[1,2]\n" }; die "bar\n" }
+tie %h, TH;
+eval { $h{A} = 1; print "never\n"; };
+print $@;
+eval { $h{B} = 2; };
+print $@;
+EXPECT
+A 1
+bar
+B 2
+bar
old mode 100644 (file)
new mode 100755 (executable)
diff --git a/util.c b/util.c
index d613c8e..f4af3e9 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1495,11 +1495,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args)
            PUSHMARK(SP);
            XPUSHs(msg);
            PUTBACK;
-           /* HACK - REVISIT - avoid CATCH_SET(TRUE) in call_sv()
-              or we come back here due to a JMPENV_JMP() and do 
-              a POPSTACK - but die_where() will have already done 
-              one as it unwound - NI-S 1999/08/14 */
-           call_sv((SV*)cv, G_DISCARD|G_NOCATCH);
+           call_sv((SV*)cv, G_DISCARD);
            POPSTACK;
            LEAVE;
        }
index 730a730..7d72e8a 100644 (file)
@@ -630,13 +630,14 @@ warn "Writing $ext$modpname/$modfname.pm\n";
 print PM <<"END";
 package $module;
 
+require 5.005_62;
 use strict;
 END
 
 if( $opt_X || $opt_c || $opt_A ){
        # we won't have our own AUTOLOAD(), so won't have $AUTOLOAD
        print PM <<'END';
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
+our @EXPORT_OK;
 END
 }
 else{
@@ -644,7 +645,7 @@ else{
        # will want Carp.
        print PM <<'END';
 use Carp;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);
+our @EXPORT_OK;
 END
 }
 
@@ -669,7 +670,7 @@ unless ($opt_A) { # no autoloader whatsoever.
 }
 
 # Determine @ISA.
-my $myISA = '@ISA = qw(Exporter';      # We seem to always want this.
+my $myISA = 'our @ISA = qw(Exporter';  # We seem to always want this.
 $myISA .= ' DynaLoader'        unless $opt_X;  # no XS
 $myISA .= ');';
 print PM "\n$myISA\n\n";
@@ -684,16 +685,16 @@ print PM<<"END";
 # This allows declaration      use $module ':all';
 # If you do not need this, moving things directly into \@EXPORT or \@EXPORT_OK
 # will save memory.
-%EXPORT_TAGS = ( 'all' => [ qw(
+our %EXPORT_TAGS = ( 'all' => [ qw(
        @exported_names
 ) ] );
 
-\@EXPORT_OK = ( \@{ \$EXPORT_TAGS{'all'} } );
-
-\@EXPORT = (
+our \@EXPORT_OK = ( \@{ \$EXPORT_TAGS{'all'} } );
 
+our \@EXPORT = qw(
+       @const_names
 );
-\$VERSION = '$TEMPLATE_VERSION';
+our \$VERSION = '$TEMPLATE_VERSION';
 
 END
 
@@ -704,6 +705,7 @@ sub AUTOLOAD {
     # to the AUTOLOAD in AutoLoader.
 
     my \$constname;
+    our $AUTOLOAD;
     (\$constname = \$AUTOLOAD) =~ s/.*:://;
     croak "&$module::constant not defined" if \$constname eq 'constant';
     my \$val = constant(\$constname, \@_ ? \$_[0] : 0);
index 57e9d44..def59fc 100644 (file)
@@ -546,7 +546,7 @@ SETARGV_OBJ = setargv$(o)
 !ENDIF
 
 DYNAMIC_EXT    = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re \
-               Data/Dumper Devel/Peek ByteLoader Devel/DProf
+               Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob
 STATIC_EXT     = DynaLoader
 NONXS_EXT      = Errno
 
@@ -566,6 +566,7 @@ ERRNO               = $(EXTDIR)\Errno\Errno
 PEEK           = $(EXTDIR)\Devel\Peek\Peek
 BYTELOADER     = $(EXTDIR)\ByteLoader\ByteLoader
 DPROF          = $(EXTDIR)\Devel\DProf\DProf
+GLOB           = $(EXTDIR)\File\Glob\Glob
 
 SOCKET_DLL     = $(AUTODIR)\Socket\Socket.dll
 FCNTL_DLL      = $(AUTODIR)\Fcntl\Fcntl.dll
@@ -581,6 +582,7 @@ PEEK_DLL    = $(AUTODIR)\Devel\Peek\Peek.dll
 RE_DLL         = $(AUTODIR)\re\re.dll
 BYTELOADER_DLL = $(AUTODIR)\ByteLoader\ByteLoader.dll
 DPROF_DLL      = $(AUTODIR)\Devel\DProf\DProf.dll
+GLOB_DLL       = $(AUTODIR)\File\Glob\Glob.dll
 
 ERRNO_PM       = $(LIBDIR)\Errno.pm
 
@@ -598,7 +600,8 @@ EXTENSION_C =               \
                $(PEEK).c       \
                $(B).c          \
                $(BYTELOADER).c \
-               $(DPROF).c
+               $(DPROF).c      \
+               $(GLOB).c
 
 EXTENSION_DLL  =               \
                $(SOCKET_DLL)   \
@@ -614,7 +617,8 @@ EXTENSION_DLL       =               \
                $(RE_DLL)       \
                $(THREAD_DLL)   \
                $(BYTELOADER_DLL)       \
-               $(DPROF_DLL)
+               $(DPROF_DLL)    \
+               $(GLOB_DLL)
 
 EXTENSION_PM   =               \
                $(ERRNO_PM)
@@ -823,6 +827,12 @@ $(DPROF_DLL): $(PERLEXE) $(DPROF).xs
        $(MAKE)
        cd ..\..\..\win32
 
+$(GLOB_DLL): $(PERLEXE) $(GLOB).xs
+       cd $(EXTDIR)\File\$(*B)
+       ..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl
+       $(MAKE)
+       cd ..\..\..\win32
+
 $(PEEK_DLL): $(PERLEXE) $(PEEK).xs
        cd $(EXTDIR)\Devel\$(*B)
        ..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl
@@ -929,6 +939,7 @@ distclean: clean
        -del /f $(LIBDIR)\B.pm $(LIBDIR)\O.pm $(LIBDIR)\re.pm
        -del /f $(LIBDIR)\Data\Dumper.pm $(LIBDIR)\ByteLoader.pm
        -del /f $(LIBDIR)\Devel\Peek.pm $(LIBDIR)\Devel\DProf.pm
+       -del /f $(LIBDIR)\File\Glob.pm
        -rmdir /s /q $(LIBDIR)\IO || rmdir /s $(LIBDIR)\IO
        -rmdir /s /q $(LIBDIR)\Thread || rmdir /s $(LIBDIR)\Thread
        -rmdir /s /q $(LIBDIR)\B || rmdir /s $(LIBDIR)\B
index ceb5be0..a9d6983 100644 (file)
@@ -663,7 +663,7 @@ SETARGV_OBJ = setargv$(o)
 .ENDIF
 
 DYNAMIC_EXT    = Socket IO Fcntl Opcode SDBM_File POSIX attrs Thread B re \
-               Data/Dumper Devel/Peek ByteLoader Devel/DProf
+               Data/Dumper Devel/Peek ByteLoader Devel/DProf File/Glob
 STATIC_EXT     = DynaLoader
 NONXS_EXT      = Errno
 
@@ -683,6 +683,7 @@ ERRNO               = $(EXTDIR)\Errno\Errno
 PEEK           = $(EXTDIR)\Devel\Peek\Peek
 BYTELOADER     = $(EXTDIR)\ByteLoader\ByteLoader
 DPROF          = $(EXTDIR)\Devel\DProf\DProf
+GLOB           = $(EXTDIR)\File\Glob\Glob
 
 SOCKET_DLL     = $(AUTODIR)\Socket\Socket.dll
 FCNTL_DLL      = $(AUTODIR)\Fcntl\Fcntl.dll
@@ -698,6 +699,7 @@ PEEK_DLL    = $(AUTODIR)\Devel\Peek\Peek.dll
 RE_DLL         = $(AUTODIR)\re\re.dll
 BYTELOADER_DLL = $(AUTODIR)\ByteLoader\ByteLoader.dll
 DPROF_DLL      = $(AUTODIR)\Devel\DProf\DProf.dll
+GLOB_DLL       = $(AUTODIR)\File\Glob\Glob.dll
 
 ERRNO_PM       = $(LIBDIR)\Errno.pm
 
@@ -715,7 +717,8 @@ EXTENSION_C =               \
                $(PEEK).c       \
                $(B).c          \
                $(BYTELOADER).c \
-               $(DPROF).c
+               $(DPROF).c      \
+               $(GLOB).c
 
 EXTENSION_DLL  =               \
                $(SOCKET_DLL)   \
@@ -731,7 +734,8 @@ EXTENSION_DLL       =               \
                $(RE_DLL)       \
                $(THREAD_DLL)   \
                $(BYTELOADER_DLL)       \
-               $(DPROF_DLL)
+               $(DPROF_DLL)    \
+               $(GLOB_DLL)
 
 EXTENSION_PM   =               \
                $(ERRNO_PM)
@@ -1005,6 +1009,11 @@ $(DPROF_DLL): $(PERLEXE) $(DPROF).xs
        ..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl
        cd $(EXTDIR)\Devel\$(*B) && $(MAKE)
 
+$(GLOB_DLL): $(PERLEXE) $(GLOB).xs
+       cd $(EXTDIR)\File\$(*B) && \
+       ..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl
+       cd $(EXTDIR)\File\$(*B) && $(MAKE)
+
 $(PEEK_DLL): $(PERLEXE) $(PEEK).xs
        cd $(EXTDIR)\Devel\$(*B) && \
        ..\..\..\miniperl -I..\..\..\lib Makefile.PL INSTALLDIRS=perl
@@ -1095,6 +1104,7 @@ distclean: clean
        -del /f $(LIBDIR)\B.pm $(LIBDIR)\O.pm $(LIBDIR)\re.pm
        -del /f $(LIBDIR)\Data\Dumper.pm $(LIBDIR)\ByteLoader.pm
        -del /f $(LIBDIR)\Devel\Peek.pm $(LIBDIR)\Devel\DProf.pm
+       -del /f $(LIBDIR)\File\Glob.pm
        -rmdir /s /q $(LIBDIR)\IO || rmdir /s $(LIBDIR)\IO
        -rmdir /s /q $(LIBDIR)\Thread || rmdir /s $(LIBDIR)\Thread
        -rmdir /s /q $(LIBDIR)\B || rmdir /s $(LIBDIR)\B