[win32] hand-applied patch along with small tweaks

	Message-Id: <35400e2a.13538517@smtp1.ibm.net>
	Subject: Re: Per-Interpreter variables for win32.c

p4raw-id: //depot/win32/perl@894

diff --git a/embedvar.h b/embedvar.h
index 667edab..d6c3349 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -115,6 +115,8 @@
 #define errgv                  (curinterp->Ierrgv)
 #define eval_root              (curinterp->Ieval_root)
 #define eval_start             (curinterp->Ieval_start)
+#define exitlist               (curinterp->Iexitlist)
+#define exitlistlen            (curinterp->Iexitlistlen)
 #define fdpid                  (curinterp->Ifdpid)
 #define filemode               (curinterp->Ifilemode)
 #define firstgv                        (curinterp->Ifirstgv)
@@ -125,6 +127,7 @@
 #define incgv                  (curinterp->Iincgv)
 #define initav                 (curinterp->Iinitav)
 #define inplace                        (curinterp->Iinplace)
+#define intern                 (curinterp->Iintern)
 #define lastfd                 (curinterp->Ilastfd)
 #define lastscream             (curinterp->Ilastscream)
 #define lastsize               (curinterp->Ilastsize)
@@ -146,6 +149,7 @@
 #define minus_l                        (curinterp->Iminus_l)
 #define minus_n                        (curinterp->Iminus_n)
 #define minus_p                        (curinterp->Iminus_p)
+#define modglobal              (curinterp->Imodglobal)
 #define multiline              (curinterp->Imultiline)
 #define mystrk                 (curinterp->Imystrk)
 #define ofmt                   (curinterp->Iofmt)
@@ -231,6 +235,8 @@
 #define Ierrgv                 errgv
 #define Ieval_root             eval_root
 #define Ieval_start            eval_start
+#define Iexitlist              exitlist
+#define Iexitlistlen           exitlistlen
 #define Ifdpid                 fdpid
 #define Ifilemode              filemode
 #define Ifirstgv               firstgv
@@ -241,6 +247,7 @@
 #define Iincgv                 incgv
 #define Iinitav                        initav
 #define Iinplace               inplace
+#define Iintern                        intern
 #define Ilastfd                        lastfd
 #define Ilastscream            lastscream
 #define Ilastsize              lastsize
@@ -262,6 +269,7 @@
 #define Iminus_l               minus_l
 #define Iminus_n               minus_n
 #define Iminus_p               minus_p
+#define Imodglobal             modglobal
 #define Imultiline             multiline
 #define Imystrk                        mystrk
 #define Iofmt                  ofmt
@@ -408,6 +416,8 @@
 #define errgv                  Perl_errgv
 #define eval_root              Perl_eval_root
 #define eval_start             Perl_eval_start
+#define exitlist               Perl_exitlist
+#define exitlistlen            Perl_exitlistlen
 #define fdpid                  Perl_fdpid
 #define filemode               Perl_filemode
 #define firstgv                        Perl_firstgv
@@ -418,6 +428,7 @@
 #define incgv                  Perl_incgv
 #define initav                 Perl_initav
 #define inplace                        Perl_inplace
+#define intern                 Perl_intern
 #define lastfd                 Perl_lastfd
 #define lastscream             Perl_lastscream
 #define lastsize               Perl_lastsize
@@ -439,6 +450,7 @@
 #define minus_l                        Perl_minus_l
 #define minus_n                        Perl_minus_n
 #define minus_p                        Perl_minus_p
+#define modglobal              Perl_modglobal
 #define multiline              Perl_multiline
 #define mystrk                 Perl_mystrk
 #define ofmt                   Perl_ofmt

diff --git a/interp.sym b/interp.sym
index 3e06da3..fba6ba7 100644 (file)
--- a/interp.sym
+++ b/interp.sym
@@ -44,6 +44,8 @@ envgv
 errgv
 eval_root
 eval_start
+exitlist
+exitlistlen
 fdpid
 filemode
 firstgv
@@ -56,6 +58,7 @@ in_eval
 incgv
 initav
 inplace
+intern
 last_in_gv
 lastfd
 lastscream
@@ -80,6 +83,7 @@ minus_c
 minus_l
 minus_n
 minus_p
+modglobal
 multiline
 mystrk
 nrs

diff --git a/intrpvar.h b/intrpvar.h
index 59f7e09..7c5ba76 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -152,6 +152,15 @@ PERLVAR(Iors,              char *)         /* $\ */
 PERLVAR(Iorslen,       STRLEN)         
 PERLVAR(Iofmt,         char *)         /* $# */
 
+/* interpreter atexit processing */
+PERLVARI(Iexitlist,    PerlExitListEntry *, NULL)      /* list of exit functions */
+PERLVARI(Iexitlistlen, I32, 0)                         /* length of same */
+PERLVAR(Imodglobal,    HV *)                           /* per-interp module data */
+
+#ifdef HAVE_INTERP_INTERN
+PERLVAR(Iintern,       struct interp_intern)           /* platform internals */
+#endif
+
 #ifdef USE_THREADS
 PERLVAR(Ithrsv,                SV *)           /* holds struct perl_thread for main thread */
 PERLVARI(Ithreadnum,   U32,    0)      /* incremented each thread creation */

diff --git a/perl.c b/perl.c
index a4e8233..52ad7ca 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -208,9 +208,10 @@ perl_construct(register PerlInterpreter *sv_interp)
     localpatches = local_patches;      /* For possible -v */
 #endif
 
-    PerlIO_init();      /* Hook to IO system */
+    PerlIO_init();                     /* Hook to IO system */
 
-    fdpid = newAV();   /* for remembering popen pids by fd */
+    fdpid = newAV();                   /* for remembering popen pids by fd */
+    modglobal = newHV();               /* pointers to per-interpreter module globals */
 
     DEBUG( {
        New(51,debname,128,char);
@@ -351,6 +352,12 @@ perl_destruct(register PerlInterpreter *sv_interp)
     SvREFCNT_dec(parsehook);
     parsehook = Nullsv;
 
+    /* call exit list functions */
+    while (exitlistlen-- > 0)
+       exitlist[exitlistlen].fn(exitlist[exitlistlen].ptr);
+
+    Safefree(exitlist);
+
     if (destruct_level == 0){
 
        DEBUG_P(debprofdump());
@@ -552,6 +559,15 @@ perl_free(PerlInterpreter *sv_interp)
     Safefree(sv_interp);
 }
 
+void
+perl_atexit(void (*fn) (void *), void *ptr)
+{
+    Renew(exitlist, exitlistlen+1, PerlExitListEntry);
+    exitlist[exitlistlen].fn = fn;
+    exitlist[exitlistlen].ptr = ptr;
+    ++exitlistlen;
+}
+
 int
 perl_parse(PerlInterpreter *sv_interp, void (*xsinit) (void), int argc, char **argv, char **env)
 {

diff --git a/perl.h b/perl.h
index 27e7241..9be3245 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1645,6 +1645,12 @@ typedef enum {
 #define PERLVARI(var,type,init) type var;
 #define PERLVARIC(var,type,init) type var;
 
+/* Interpreter exitlist entry */
+typedef struct exitlistentry {
+    void (*fn) _((void*));
+    void *ptr;
+} PerlExitListEntry;
+
 #ifdef PERL_GLOBAL_STRUCT
 struct perl_vars {
 #include "perlvars.h"

diff --git a/proto.h b/proto.h
index 7641071..eb75dc4 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -371,6 +371,7 @@ void        pad_reset _((void));
 void   pad_swipe _((PADOFFSET po));
 void   peep _((OP* o));
 PerlInterpreter*       perl_alloc _((void));
+void    perl_atexit _((void(*fn)(void *), void*));
 I32    perl_call_argv _((char* subname, I32 flags, char** argv));
 I32    perl_call_method _((char* methname, I32 flags));
 I32    perl_call_pv _((char* subname, I32 flags));

diff --git a/win32/makedef.pl b/win32/makedef.pl
index 4cd93b6..acb60a8 100644 (file)
--- a/win32/makedef.pl
+++ b/win32/makedef.pl
@@ -373,6 +373,7 @@ __DATA__
 perl_init_i18nl10n
 perl_init_ext
 perl_alloc
+perl_atexit
 perl_construct
 perl_destruct
 perl_free

diff --git a/win32/win32.c b/win32/win32.c
index 4879fcb..9cee6b5 100644 (file)
--- a/win32/win32.c
+++ b/win32/win32.c
@@ -73,34 +73,29 @@ static BOOL         has_redirection(char *ptr);
 static long            filetime_to_clock(PFILETIME ft);
 static BOOL            filetime_from_time(PFILETIME ft, time_t t);
 
-char * w32_perlshell_tokens = Nullch;
-char **        w32_perlshell_vec;
-long   w32_perlshell_items = -1;
-DWORD  w32_platform = (DWORD)-1;
-char   w32_perllib_root[MAX_PATH+1];
 HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE;
-#ifndef __BORLANDC__
-long   w32_num_children = 0;
-HANDLE w32_child_pids[MAXIMUM_WAIT_OBJECTS];
-#endif
+static DWORD   w32_platform = (DWORD)-1;
 
 #ifdef USE_THREADS
 #  ifdef USE_DECLSPEC_THREAD
 __declspec(thread) char        strerror_buffer[512];
 __declspec(thread) char        getlogin_buffer[128];
+__declspec(thread) char        w32_perllib_root[MAX_PATH+1];
 #    ifdef HAVE_DES_FCRYPT
 __declspec(thread) char        crypt_buffer[30];
 #    endif
 #  else
 #    define strerror_buffer    (thr->i.Wstrerror_buffer)
 #    define getlogin_buffer    (thr->i.Wgetlogin_buffer)
+#    define w32_perllib_root   (thr->i.Ww32_perllib_root)
 #    define crypt_buffer       (thr->i.Wcrypt_buffer)
 #  endif
 #else
-char   strerror_buffer[512];
-char   getlogin_buffer[128];
+static char    strerror_buffer[512];
+static char    getlogin_buffer[128];
+static char    w32_perllib_root[MAX_PATH+1];
 #  ifdef HAVE_DES_FCRYPT
-char   crypt_buffer[30];
+static char    crypt_buffer[30];
 #  endif
 #endif
 
@@ -117,8 +112,10 @@ IsWinNT(void) {
 char *
 win32_perllib_path(char *sfx,...)
 {
+    dTHR;
     va_list ap;
     char *end;
+
     va_start(ap,sfx);
     GetModuleFileName((w32_perldll_handle == INVALID_HANDLE_VALUE) 
                      ? GetModuleHandle(NULL)
@@ -868,7 +865,7 @@ win32_utime(const char *filename, struct utimbuf *times)
 DllExport int
 win32_wait(int *status)
 {
-#ifdef __BORLANDC__
+#ifdef USE_RTL_WAIT
     return wait(status);
 #else
     /* XXX this wait emulation only knows about processes
@@ -1393,7 +1390,7 @@ win32_pipe(int *pfd, unsigned int size, int mode)
 DllExport FILE*
 win32_popen(const char *command, const char *mode)
 {
-#ifdef USE_CRT_POPEN
+#ifdef USE_RTL_POPEN
     return _popen(command, mode);
 #else
     int p[2];
@@ -1452,7 +1449,8 @@ win32_popen(const char *command, const char *mode)
 
     /* close saved handle */
     win32_close(oldfd);
-    sv_setiv(*av_fetch(fdpid, p[parent], TRUE), childpid);
+
+    sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid);
 
     /* we have an fd, return a file stream */
     return (win32_fdopen(p[parent], (char *)mode));
@@ -1467,7 +1465,7 @@ cleanup:
     }
     return (NULL);
 
-#endif /* USE_CRT_POPEN */
+#endif /* USE_RTL_POPEN */
 }
 
 /*
@@ -1477,18 +1475,18 @@ cleanup:
 DllExport int
 win32_pclose(FILE *pf)
 {
-#ifdef USE_CRT_POPEN
+#ifdef USE_RTL_POPEN
     return _pclose(pf);
 #else
 
-#ifndef __BORLANDC__
+#ifndef USE_RTL_WAIT
     int child;
 #endif
 
     int childpid, status;
     SV *sv;
 
-    sv = *av_fetch(fdpid, win32_fileno(pf), TRUE);
+    sv = *av_fetch(w32_fdpid, win32_fileno(pf), TRUE);
     if (SvIOK(sv))
        childpid = SvIVX(sv);
     else
@@ -1502,7 +1500,7 @@ win32_pclose(FILE *pf)
     win32_fclose(pf);
     SvIVX(sv) = 0;
 
-#ifndef __BORLANDC__
+#ifndef USE_RTL_WAIT
     for (child = 0 ; child < w32_num_children ; ++child) {
        if (w32_child_pids[child] == (HANDLE)childpid) {
            Copy(&w32_child_pids[child+1], &w32_child_pids[child],
@@ -1523,7 +1521,7 @@ win32_pclose(FILE *pf)
     return (status);
 #endif
 
-#endif /* USE_CRT_OPEN */
+#endif /* USE_RTL_POPEN */
 }
 
 DllExport int
@@ -1618,13 +1616,13 @@ win32_spawnvp(int mode, const char *cmdname, const char *const *argv)
 {
     int status;
 
-#ifndef __BORLANDC__
+#ifndef USE_RTL_WAIT
     if (mode == P_NOWAIT && w32_num_children >= MAXIMUM_WAIT_OBJECTS)
        return -1;
 #endif
 
     status = spawnvp(mode, cmdname, (char * const *) argv);
-#ifndef __BORLANDC__
+#ifndef USE_RTL_WAIT
     /* XXX For the P_NOWAIT case, Borland RTL returns pinfo.dwProcessId
      * while VC RTL returns pinfo.hProcess. For purposes of the custom
      * implementation of win32_wait(), we assume the latter.
@@ -2121,6 +2119,13 @@ Perl_init_os_extras()
     char *file = __FILE__;
     dXSUB_SYS;
 
+    w32_perlshell_tokens = Nullch;
+    w32_perlshell_items = -1;
+    w32_fdpid = newAV();               /* XXX needs to be in Perl_win32_init()? */
+#ifndef USE_RTL_WAIT
+    w32_num_children = 0;
+#endif
+
     /* these names are Activeware compatible */
     newXS("Win32::GetCwd", w32_GetCwd, file);
     newXS("Win32::SetCwd", w32_SetCwd, file);
@@ -2163,7 +2168,7 @@ Perl_win32_init(int *argcp, char ***argvp)
 #if !defined(_ALPHA_) && !defined(__GNUC__)
     _control87(MCW_EM, MCW_EM);
 #endif
-    MALLOC_INIT; 
+    MALLOC_INIT;
 }
 
 #ifdef USE_BINMODE_SCRIPTS

diff --git a/win32/win32.h b/win32/win32.h
index 781c720..9990caf 100644 (file)
--- a/win32/win32.h
+++ b/win32/win32.h
@@ -119,6 +119,8 @@ struct tms {
 #pragma warn -csu      /* "comparing signed and unsigned values" */
 #pragma warn -pro      /* "call to function with no prototype" */
 
+#define USE_RTL_WAIT   /* Borland has a working wait() */
+
 #endif
 
 #ifdef _MSC_VER                        /* Microsoft Visual C++ */
@@ -216,6 +218,28 @@ EXT void win32_strip_return(struct sv *sv);
 #define win32_strip_return(sv) NOOP
 #endif
 
+#define HAVE_INTERP_INTERN
+struct interp_intern {
+    char *     w32_perlshell_tokens;
+    char **    w32_perlshell_vec;
+    long       w32_perlshell_items;
+    struct av *        w32_fdpid;
+#ifndef USE_RTL_WAIT
+    long       w32_num_children;
+    HANDLE     w32_child_pids[MAXIMUM_WAIT_OBJECTS];
+#endif
+};
+
+#define w32_perlshell_tokens   (intern.w32_perlshell_tokens)
+#define w32_perlshell_vec      (intern.w32_perlshell_vec)
+#define w32_perlshell_items    (intern.w32_perlshell_items)
+#define w32_fdpid              (intern.w32_fdpid)
+
+#ifndef USE_RTL_WAIT
+#  define w32_num_children     (intern.w32_num_children)
+#  define w32_child_pids       (intern.w32_child_pids)
+#endif
+
 /* 
  * Now Win32 specific per-thread data stuff 
  */
@@ -229,6 +253,7 @@ struct thread_intern {
     char               Wstrerror_buffer[512];
     struct servent     Wservent;
     char               Wgetlogin_buffer[128];
+    char               Ww32_perllib_root[MAX_PATH+1];
 #    ifdef USE_SOCKETS_AS_HANDLES
     int                        Winit_socktype;
 #    endif