From: Jan Dubois Date: Tue, 21 Apr 1998 23:31:06 +0000 (+0200) Subject: [win32] hand-applied patch along with small tweaks X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4b556e6ce00fc77d7d2644507d0f76c5004f26de;p=p5sagit%2Fp5-mst-13.2.git [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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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