diff options
| -rw-r--r-- | iperlsys.h | 4 | ||||
| -rw-r--r-- | perl.c | 2 | ||||
| -rw-r--r-- | perlio.c | 106 | ||||
| -rw-r--r-- | perlio.h | 8 | ||||
| -rw-r--r-- | perliol.h | 2 | ||||
| -rw-r--r-- | sv.c | 2 | ||||
| -rwxr-xr-x | t/op/fork.t | 4 | ||||
| -rw-r--r-- | win32/perlhost.h | 21 |
8 files changed, 115 insertions, 34 deletions
diff --git a/iperlsys.h b/iperlsys.h index a7bd2b5e2f..66d2b8ebb0 100644 --- a/iperlsys.h +++ b/iperlsys.h @@ -902,6 +902,7 @@ typedef int (*LPProcSpawnvp)(struct IPerlProc*, int, const char*, const char*const*); typedef int (*LPProcASpawn)(struct IPerlProc*, void*, void**, void**); #endif +typedef int (*LPProcLastHost)(struct IPerlProc*); struct IPerlProc { @@ -940,6 +941,7 @@ struct IPerlProc LPProcSpawnvp pSpawnvp; LPProcASpawn pASpawn; #endif + LPProcLastHost pLastHost; }; struct IPerlProcInfo @@ -1019,6 +1021,8 @@ struct IPerlProcInfo #define PerlProc_aspawn(m,c,a) \ (*PL_Proc->pASpawn)(PL_Proc, (m), (c), (a)) #endif +#define PerlProc_lasthost() \ + (*PL_Proc->pLastHost)(PL_Proc) #else /* PERL_IMPLICIT_SYS */ @@ -788,6 +788,8 @@ perl_free(pTHXx) #else # if defined(PERL_IMPLICIT_SYS) && defined(WIN32) void *host = w32_internal_host; + if (PerlProc_lasthost()) + PerlIO_cleanup(); PerlMem_free(aTHXx); win32_delete_internal_host(host); # else @@ -28,6 +28,12 @@ #define PERL_IN_PERLIO_C #include "perl.h" +#undef PerlMemShared_calloc +#define PerlMemShared_calloc(x,y) calloc(x,y) +#undef PerlMemShared_free +#define PerlMemShared_free(x) free(x) + + #ifndef PERLIO_LAYERS int PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names) @@ -211,11 +217,12 @@ PerlIO *_perlio = NULL; #define PERLIO_TABLE_SIZE 64 PerlIO * -PerlIO_allocate(void) +PerlIO_allocate(pTHX) { /* Find a free slot in the table, allocating new table as necessary */ - PerlIO **last = &_perlio; + PerlIO **last; PerlIO *f; + last = &_perlio; while ((f = *last)) { int i; @@ -228,21 +235,23 @@ PerlIO_allocate(void) } } } - Newz('I',f,PERLIO_TABLE_SIZE,PerlIO); + f = PerlMemShared_calloc(PERLIO_TABLE_SIZE,sizeof(PerlIO)); if (!f) - return NULL; + { + return NULL; + } *last = f; return f+1; } void -PerlIO_cleantable(PerlIO **tablep) +PerlIO_cleantable(pTHX_ PerlIO **tablep) { PerlIO *table = *tablep; if (table) { int i; - PerlIO_cleantable((PerlIO **) &(table[0])); + PerlIO_cleantable(aTHX_ (PerlIO **) &(table[0])); for (i=PERLIO_TABLE_SIZE-1; i > 0; i--) { PerlIO *f = table+i; @@ -251,7 +260,7 @@ PerlIO_cleantable(PerlIO **tablep) PerlIO_close(f); } } - Safefree(table); + PerlMemShared_free(table); *tablep = NULL; } } @@ -260,21 +269,23 @@ HV *PerlIO_layer_hv; AV *PerlIO_layer_av; void -PerlIO_cleanup(void) +PerlIO_cleanup() { - PerlIO_cleantable(&_perlio); + dTHX; + PerlIO_cleantable(aTHX_ &_perlio); } void PerlIO_pop(PerlIO *f) { + dTHX; PerlIOl *l = *f; if (l) { PerlIO_debug("PerlIO_pop f=%p %s\n",f,l->tab->name); (*l->tab->Popped)(f); *f = l->next; - Safefree(l); + PerlMemShared_free(l); } } @@ -500,7 +511,8 @@ PerlIO_stdstreams() { if (!_perlio) { - PerlIO_allocate(); + dTHX; + PerlIO_allocate(aTHX); PerlIO_fdopen(0,"Ir" PERLIO_STDTEXT); PerlIO_fdopen(1,"Iw" PERLIO_STDTEXT); PerlIO_fdopen(2,"Iw" PERLIO_STDTEXT); @@ -510,8 +522,9 @@ PerlIO_stdstreams() PerlIO * PerlIO_push(PerlIO *f,PerlIO_funcs *tab,const char *mode) { + dTHX; PerlIOl *l = NULL; - Newc('L',l,tab->size,char,PerlIOl); + l = PerlMemShared_calloc(tab->size,sizeof(char)); if (l) { Zero(l,tab->size,char); @@ -618,6 +631,20 @@ PerlIO__close(PerlIO *f) return (*PerlIOBase(f)->tab->Close)(f); } +#undef PerlIO_fdupopen +PerlIO * +PerlIO_fdupopen(pTHX_ PerlIO *f) +{ + char buf[8]; + int fd = PerlLIO_dup(PerlIO_fileno(f)); + PerlIO *new = PerlIO_fdopen(fd,PerlIO_modestr(f,buf)); + if (new) + { + Off_t posn = PerlIO_tell(f); + PerlIO_seek(new,posn,SEEK_SET); + } + return new; +} #undef PerlIO_close int @@ -898,14 +925,32 @@ PerlIO_modestr(PerlIO *f,char *buf) { char *s = buf; IV flags = PerlIOBase(f)->flags; - if (flags & PERLIO_F_CANREAD) - *s++ = 'r'; - if (flags & PERLIO_F_CANWRITE) - *s++ = 'w'; - if (flags & PERLIO_F_CRLF) - *s++ = 't'; - else + if (flags & PERLIO_F_APPEND) + { + *s++ = 'a'; + if (flags & PERLIO_F_CANREAD) + { + *s++ = '+'; + } + } + else if (flags & PERLIO_F_CANREAD) + { + *s++ = 'r'; + if (flags & PERLIO_F_CANWRITE) + *s++ = '+'; + } + else if (flags & PERLIO_F_CANWRITE) + { + *s++ = 'w'; + if (flags & PERLIO_F_CANREAD) + { + *s++ = '+'; + } + } +#if O_TEXT != O_BINARY + if (!(flags & PERLIO_F_CRLF)) *s++ = 'b'; +#endif *s = '\0'; return buf; } @@ -1142,6 +1187,7 @@ PerlIOUnix_fileno(PerlIO *f) PerlIO * PerlIOUnix_fdopen(PerlIO_funcs *self, int fd,const char *mode) { + dTHX; PerlIO *f = NULL; if (*mode == 'I') mode++; @@ -1150,7 +1196,7 @@ PerlIOUnix_fdopen(PerlIO_funcs *self, int fd,const char *mode) int oflags = PerlIOUnix_oflags(mode); if (oflags != -1) { - PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),self,mode),PerlIOUnix); + PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode),PerlIOUnix); s->fd = fd; s->oflags = oflags; PerlIOBase(f)->flags |= PERLIO_F_OPEN; @@ -1170,7 +1216,7 @@ PerlIOUnix_open(PerlIO_funcs *self, const char *path,const char *mode) int fd = PerlLIO_open3(path,oflags,0666); if (fd >= 0) { - PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),self,mode),PerlIOUnix); + PerlIOUnix *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode),PerlIOUnix); s->fd = fd; s->oflags = oflags; PerlIOBase(f)->flags |= PERLIO_F_OPEN; @@ -1374,7 +1420,7 @@ PerlIOStdio_fdopen(PerlIO_funcs *self, int fd,const char *mode) } if (stdio) { - PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),self,mode),PerlIOStdio); + PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),self,mode),PerlIOStdio); s->stdio = stdio; } } @@ -1385,10 +1431,11 @@ PerlIOStdio_fdopen(PerlIO_funcs *self, int fd,const char *mode) PerlIO * PerlIO_importFILE(FILE *stdio, int fl) { + dTHX; PerlIO *f = NULL; if (stdio) { - PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),&PerlIO_stdio,"r+"),PerlIOStdio); + PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),&PerlIO_stdio,"r+"),PerlIOStdio); s->stdio = stdio; } return f; @@ -1403,7 +1450,7 @@ PerlIOStdio_open(PerlIO_funcs *self, const char *path,const char *mode) if (stdio) { char tmode[8]; - PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(), self, + PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX), self, (mode = PerlIOStdio_mode(mode,tmode))), PerlIOStdio); s->stdio = stdio; @@ -2055,11 +2102,12 @@ PerlIOBuf_tell(PerlIO *f) IV PerlIOBuf_close(PerlIO *f) { + dTHX; IV code = PerlIOBase_close(f); PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); if (b->buf && b->buf != (STDCHAR *) &b->oneword) { - Safefree(b->buf); + PerlMemShared_free(b->buf); } b->buf = NULL; b->ptr = b->end = b->buf; @@ -2102,9 +2150,10 @@ PerlIOBuf_get_base(PerlIO *f) PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); if (!b->buf) { + dTHX; if (!b->bufsiz) b->bufsiz = 4096; - New('B',b->buf,b->bufsiz,STDCHAR); + b->buf = PerlMemShared_calloc(b->bufsiz,sizeof(STDCHAR)); if (!b->buf) { b->buf = (STDCHAR *)&b->oneword; @@ -2204,7 +2253,8 @@ PerlIOPending_flush(PerlIO *f) PerlIOBuf *b = PerlIOSelf(f,PerlIOBuf); if (b->buf && b->buf != (STDCHAR *) &b->oneword) { - Safefree(b->buf); + dTHX; + PerlMemShared_free(b->buf); b->buf = NULL; } PerlIO_pop(f); @@ -3051,7 +3101,7 @@ PerlIO_tmpfile(void) FILE *stdio = PerlSIO_tmpfile(); if (stdio) { - PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(),&PerlIO_stdio,"w+"),PerlIOStdio); + PerlIOStdio *s = PerlIOSelf(PerlIO_push(f = PerlIO_allocate(aTHX),&PerlIO_stdio,"w+"),PerlIOStdio); s->stdio = stdio; } return f; @@ -305,8 +305,10 @@ extern int PerlIO_getpos (PerlIO *,Fpos_t *); extern int PerlIO_setpos (PerlIO *,const Fpos_t *); #endif #ifndef PerlIO_fdupopen -#define PerlIO_fdupopen(f) (f) -/* extern PerlIO * PerlIO_fdupopen (PerlIO *); */ +extern PerlIO * PerlIO_fdupopen (pTHX_ PerlIO *); +#endif +#ifndef PerlIO_modestr +extern char *PerlIO_modestr (PerlIO *,char *buf); #endif #ifndef PerlIO_isutf8 extern int PerlIO_isutf8 (PerlIO *); @@ -318,7 +320,7 @@ extern int PerlIO_apply_layers (pTHX_ PerlIO *f, const char *mode, const char *n extern int PerlIO_binmode (pTHX_ PerlIO *f, int iotype, int omode, const char *names); #endif -extern void PerlIO_cleanup(void); +extern void PerlIO_cleanup(); extern void PerlIO_debug(const char *fmt,...); @@ -82,7 +82,7 @@ extern PerlIO_funcs PerlIO_crlf; extern PerlIO_funcs PerlIO_mmap; #endif -extern PerlIO *PerlIO_allocate(void); +extern PerlIO *PerlIO_allocate(pTHX); #if O_BINARY != O_TEXT #define PERLIO_STDTEXT "t" @@ -6789,7 +6789,7 @@ Perl_fp_dup(pTHX_ PerlIO *fp, char type) return ret; /* create anew and remember what it is */ - ret = PerlIO_fdupopen(fp); + ret = PerlIO_fdupopen(aTHX_ fp); ptr_table_store(PL_ptr_table, fp, ret); return ret; } diff --git a/t/op/fork.t b/t/op/fork.t index 88b6b4b74c..fbcd0987fe 100755 --- a/t/op/fork.t +++ b/t/op/fork.t @@ -8,7 +8,9 @@ BEGIN { require Config; import Config; unless ($Config{'d_fork'} or ($^O eq 'MSWin32' and $Config{useithreads} - and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/)) + and $Config{ccflags} =~ /-DPERL_IMPLICIT_SYS/ +# and !defined $Config{'useperlio'} + )) { print "1..0 # Skip: no fork\n"; exit 0; diff --git a/win32/perlhost.h b/win32/perlhost.h index 28f0168cee..a260d0895d 100644 --- a/win32/perlhost.h +++ b/win32/perlhost.h @@ -35,6 +35,7 @@ extern int g_do_aspawn(void *vreally, void **vmark, void **vsp); class CPerlHost { public: + /* Constructors */ CPerlHost(void); CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, @@ -197,8 +198,13 @@ protected: DWORD m_dwEnvCount; LPSTR* m_lppEnvList; + static long num_hosts; +public: + inline int LastHost(void) { return num_hosts == 1L; }; }; +long CPerlHost::num_hosts = 0L; + #define STRUCT2PTR(x, y) (CPerlHost*)(((LPBYTE)x)-offsetof(CPerlHost, y)) @@ -1844,6 +1850,14 @@ PerlProcASpawn(struct IPerlProc* piPerl, void *vreally, void **vmark, void **vsp return do_aspawn(vreally, vmark, vsp); } +int +PerlProcLastHost(struct IPerlProc* piPerl) +{ + dTHXo; + CPerlHost *h = (CPerlHost*)w32_internal_host; + return h->LastHost(); +} + struct IPerlProc perlProc = { PerlProcAbort, @@ -1879,6 +1893,7 @@ struct IPerlProc perlProc = PerlProcSpawn, PerlProcSpawnvp, PerlProcASpawn, + PerlProcLastHost }; @@ -1888,6 +1903,8 @@ struct IPerlProc perlProc = CPerlHost::CPerlHost(void) { + /* Construct a host from scratch */ + InterlockedIncrement(&num_hosts); m_pvDir = new VDir(); m_pVMem = new VMem(); m_pVMemShared = new VMem(); @@ -1936,6 +1953,7 @@ CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, struct IPerlDir** ppDir, struct IPerlSock** ppSock, struct IPerlProc** ppProc) { + InterlockedIncrement(&num_hosts); m_pvDir = new VDir(0); m_pVMem = new VMem(); m_pVMemShared = new VMem(); @@ -1970,6 +1988,8 @@ CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, CPerlHost::CPerlHost(CPerlHost& host) { + /* Construct a host from another host */ + InterlockedIncrement(&num_hosts); m_pVMem = new VMem(); m_pVMemShared = host.GetMemShared(); m_pVMemParse = host.GetMemParse(); @@ -2010,6 +2030,7 @@ CPerlHost::CPerlHost(CPerlHost& host) CPerlHost::~CPerlHost(void) { // Reset(); + InterlockedDecrement(&num_hosts); delete m_pvDir; m_pVMemParse->Release(); m_pVMemShared->Release(); |