X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=util.c;h=c9960814408840e5e166161539095ee6c590b5dd;hb=8803afc236dca2c2990fc3236c7c43e710a099fb;hp=b86f6f50e22c2638a8961c5807b1b07dafb3cb45;hpb=52e1cb5ebf5e5a8cd5d3d9673b540b0c0dfe20df;p=p5sagit%2Fp5-mst-13.2.git diff --git a/util.c b/util.c index b86f6f5..c996081 100644 --- a/util.c +++ b/util.c @@ -14,6 +14,7 @@ #include "EXTERN.h" #include "perl.h" +#include "perlmem.h" #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) #include @@ -53,12 +54,14 @@ #define FLUSH #ifdef LEAKTEST -static void xstat _((void)); -#endif -#ifdef USE_THREADS -static U32 threadnum = 0; -#endif /* USE_THREADS */ +static void xstat _((int)); +long xcount[MAXXCOUNT]; +long lastxcount[MAXXCOUNT]; +long xycount[MAXXCOUNT][MAXYCOUNT]; +long lastxycount[MAXXCOUNT][MAXYCOUNT]; + +#endif #ifndef MYMALLOC @@ -84,7 +87,7 @@ safemalloc(MEM_SIZE size) if ((long)size < 0) croak("panic: malloc"); #endif - ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */ + ptr = PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */ #if !(defined(I286) || defined(atarist)) DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%x: (%05d) malloc %ld bytes\n",ptr,an++,(long)size)); #else @@ -109,7 +112,7 @@ saferealloc(Malloc_t where,MEM_SIZE size) { Malloc_t ptr; #if !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE) - Malloc_t realloc(); + Malloc_t PerlMem_realloc(); #endif /* !defined(STANDARD_C) && !defined(HAS_REALLOC_PROTOTYPE) */ #ifdef HAS_64K_LIMIT @@ -125,7 +128,7 @@ saferealloc(Malloc_t where,MEM_SIZE size) if ((long)size < 0) croak("panic: realloc"); #endif - ptr = realloc(where,size?size:1); /* realloc(0) is NASTY on our system */ + ptr = PerlMem_realloc(where,size?size:1); /* realloc(0) is NASTY on our system */ #if !(defined(I286) || defined(atarist)) DEBUG_m( { @@ -163,7 +166,7 @@ safefree(Malloc_t where) #endif if (where) { /*SUPPRESS 701*/ - free(where); + PerlMem_free(where); } } @@ -186,7 +189,7 @@ safecalloc(MEM_SIZE count, MEM_SIZE size) croak("panic: calloc"); #endif size *= count; - ptr = malloc(size?size:1); /* malloc(0) is NASTY on our system */ + ptr = PerlMem_malloc(size?size:1); /* malloc(0) is NASTY on our system */ #if !(defined(I286) || defined(atarist)) DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%x: (%05d) calloc %ld x %ld bytes\n",ptr,an++,(long)count,(long)size)); #else @@ -210,63 +213,141 @@ safecalloc(MEM_SIZE count, MEM_SIZE size) #ifdef LEAKTEST -#define ALIGN sizeof(long) +struct mem_test_strut { + union { + long type; + char c[2]; + } u; + long size; +}; + +# define ALIGN sizeof(struct mem_test_strut) + +# define sizeof_chunk(ch) (((struct mem_test_strut*) (ch))->size) +# define typeof_chunk(ch) \ + (((struct mem_test_strut*) (ch))->u.c[0] + ((struct mem_test_strut*) (ch))->u.c[1]*100) +# define set_typeof_chunk(ch,t) \ + (((struct mem_test_strut*) (ch))->u.c[0] = t % 100, ((struct mem_test_strut*) (ch))->u.c[1] = t / 100) +#define SIZE_TO_Y(size) ( (size) > MAXY_SIZE \ + ? MAXYCOUNT - 1 \ + : ( (size) > 40 \ + ? ((size) - 1)/8 + 5 \ + : ((size) - 1)/4)) Malloc_t safexmalloc(I32 x, MEM_SIZE size) { - register Malloc_t where; + register char* where = (char*)safemalloc(size + ALIGN); - where = safemalloc(size + ALIGN); - xcount[x]++; - where[0] = x % 100; - where[1] = x / 100; - return where + ALIGN; + xcount[x] += size; + xycount[x][SIZE_TO_Y(size)]++; + set_typeof_chunk(where, x); + sizeof_chunk(where) = size; + return (Malloc_t)(where + ALIGN); } Malloc_t -safexrealloc(Malloc_t where, MEM_SIZE size) +safexrealloc(Malloc_t wh, MEM_SIZE size) { - register Malloc_t new = saferealloc(where - ALIGN, size + ALIGN); - return new + ALIGN; + char *where = (char*)wh; + + if (!wh) + return safexmalloc(0,size); + + { + MEM_SIZE old = sizeof_chunk(where - ALIGN); + int t = typeof_chunk(where - ALIGN); + register char* new = (char*)saferealloc(where - ALIGN, size + ALIGN); + + xycount[t][SIZE_TO_Y(old)]--; + xycount[t][SIZE_TO_Y(size)]++; + xcount[t] += size - old; + sizeof_chunk(new) = size; + return (Malloc_t)(new + ALIGN); + } } void -safexfree(Malloc_t where) +safexfree(Malloc_t wh) { I32 x; - + char *where = (char*)wh; + MEM_SIZE size; + if (!where) return; where -= ALIGN; + size = sizeof_chunk(where); x = where[0] + 100 * where[1]; - xcount[x]--; + xcount[x] -= size; + xycount[x][SIZE_TO_Y(size)]--; safefree(where); } Malloc_t safexcalloc(I32 x,MEM_SIZE count, MEM_SIZE size) { - register Malloc_t where; - - where = safexmalloc(x, size * count + ALIGN); - xcount[x]++; - memset((void*)where + ALIGN, 0, size * count); - where[0] = x % 100; - where[1] = x / 100; - return where + ALIGN; + register char * where = (char*)safexmalloc(x, size * count + ALIGN); + xcount[x] += size; + xycount[x][SIZE_TO_Y(size)]++; + memset((void*)(where + ALIGN), 0, size * count); + set_typeof_chunk(where, x); + sizeof_chunk(where) = size; + return (Malloc_t)(where + ALIGN); } static void -xstat(void) +xstat(int flag) { - register I32 i; + register I32 i, j, total = 0; + I32 subtot[MAXYCOUNT]; + for (j = 0; j < MAXYCOUNT; j++) { + subtot[j] = 0; + } + + PerlIO_printf(PerlIO_stderr(), " Id subtot 4 8 12 16 20 24 28 32 36 40 48 56 64 72 80 80+\n", total); for (i = 0; i < MAXXCOUNT; i++) { - if (xcount[i] > lastxcount[i]) { - PerlIO_printf(PerlIO_stderr(),"%2d %2d\t%ld\n", i / 100, i % 100, xcount[i]); + total += xcount[i]; + for (j = 0; j < MAXYCOUNT; j++) { + subtot[j] += xycount[i][j]; + } + if (flag == 0 + ? xcount[i] /* Have something */ + : (flag == 2 + ? xcount[i] != lastxcount[i] /* Changed */ + : xcount[i] > lastxcount[i])) { /* Growed */ + PerlIO_printf(PerlIO_stderr(),"%2d %02d %7ld ", i / 100, i % 100, + flag == 2 ? xcount[i] - lastxcount[i] : xcount[i]); lastxcount[i] = xcount[i]; + for (j = 0; j < MAXYCOUNT; j++) { + if ( flag == 0 + ? xycount[i][j] /* Have something */ + : (flag == 2 + ? xycount[i][j] != lastxycount[i][j] /* Changed */ + : xycount[i][j] > lastxycount[i][j])) { /* Growed */ + PerlIO_printf(PerlIO_stderr(),"%3ld ", + flag == 2 + ? xycount[i][j] - lastxycount[i][j] + : xycount[i][j]); + lastxycount[i][j] = xycount[i][j]; + } else { + PerlIO_printf(PerlIO_stderr(), " . ", xycount[i][j]); + } + } + PerlIO_printf(PerlIO_stderr(), "\n"); + } + } + if (flag != 2) { + PerlIO_printf(PerlIO_stderr(), "Total %7ld ", total); + for (j = 0; j < MAXYCOUNT; j++) { + if (subtot[j]) { + PerlIO_printf(PerlIO_stderr(), "%3ld ", subtot[j]); + } else { + PerlIO_printf(PerlIO_stderr(), " . "); + } } + PerlIO_printf(PerlIO_stderr(), "\n"); } } @@ -536,8 +617,8 @@ perl_init_i18nl10n(int printwarn) #ifdef USE_LOCALE_NUMERIC char *curnum = NULL; #endif /* USE_LOCALE_NUMERIC */ - char *lc_all = getenv("LC_ALL"); - char *lang = getenv("LANG"); + char *lc_all = PerlEnv_getenv("LC_ALL"); + char *lang = PerlEnv_getenv("LANG"); bool setlocale_failure = FALSE; #ifdef LOCALE_ENVIRON_REQUIRED @@ -561,19 +642,19 @@ perl_init_i18nl10n(int printwarn) { #ifdef USE_LOCALE_CTYPE if (! (curctype = setlocale(LC_CTYPE, - (!done && (lang || getenv("LC_CTYPE"))) + (!done && (lang || PerlEnv_getenv("LC_CTYPE"))) ? "" : Nullch))) setlocale_failure = TRUE; #endif /* USE_LOCALE_CTYPE */ #ifdef USE_LOCALE_COLLATE if (! (curcoll = setlocale(LC_COLLATE, - (!done && (lang || getenv("LC_COLLATE"))) + (!done && (lang || PerlEnv_getenv("LC_COLLATE"))) ? "" : Nullch))) setlocale_failure = TRUE; #endif /* USE_LOCALE_COLLATE */ #ifdef USE_LOCALE_NUMERIC if (! (curnum = setlocale(LC_NUMERIC, - (!done && (lang || getenv("LC_NUMERIC"))) + (!done && (lang || PerlEnv_getenv("LC_NUMERIC"))) ? "" : Nullch))) setlocale_failure = TRUE; #endif /* USE_LOCALE_NUMERIC */ @@ -620,7 +701,7 @@ perl_init_i18nl10n(int printwarn) char *p; bool locwarn = (printwarn > 1 || printwarn && - (!(p = getenv("PERL_BADLANG")) || atoi(p))); + (!(p = PerlEnv_getenv("PERL_BADLANG")) || atoi(p))); if (locwarn) { #ifdef LC_ALL @@ -810,7 +891,7 @@ mem_collxfrm(const char *s, STRLEN len, STRLEN *xlen) #endif /* USE_LOCALE_COLLATE */ void -fbm_compile(SV *sv) +fbm_compile(SV *sv, U32 flags /* not used yet */) { register unsigned char *s; register unsigned char *table; @@ -822,18 +903,20 @@ fbm_compile(SV *sv) sv_upgrade(sv, SVt_PVBM); if (len > 255 || len == 0) /* TAIL might be on on a zero-length string. */ return; /* can't have offsets that big */ - Sv_Grow(sv,len+258); - table = (unsigned char*)(SvPVX(sv) + len + 1); - s = table - 2; - for (i = 0; i < 256; i++) { - table[i] = len; - } - i = 0; - while (s >= (unsigned char*)(SvPVX(sv))) - { - if (table[*s] == len) - table[*s] = i; - s--,i++; + if (len > 2) { + Sv_Grow(sv,len + 258); + table = (unsigned char*)(SvPVX(sv) + len + 1); + s = table - 2; + for (i = 0; i < 256; i++) { + table[i] = len; + } + i = 0; + while (s >= (unsigned char*)(SvPVX(sv))) + { + if (table[*s] == len) + table[*s] = i; + s--,i++; + } } sv_magic(sv, Nullsv, 'B', Nullch, 0); /* deep magic */ SvVALID_on(sv); @@ -865,11 +948,19 @@ fbm_instr(unsigned char *big, register unsigned char *bigend, SV *littlestr) STRLEN len; char *l = SvPV(littlestr,len); if (!len) { - if (SvTAIL(littlestr)) { + if (SvTAIL(littlestr)) { /* Can be only 0-len constant + substr => we can ignore SvVALID */ + if (multiline) { + char *t = "\n"; + if ((s = (unsigned char*)ninstr((char*)big, (char*)bigend, + t, t + len))) { + return (char*)s; + } + } if (bigend > big && bigend[-1] == '\n') - return bigend - 1; + return (char *)(bigend - 1); else - return bigend; + return (char *) bigend; } return (char*)big; } @@ -882,13 +973,32 @@ fbm_instr(unsigned char *big, register unsigned char *bigend, SV *littlestr) return Nullch; little = (unsigned char*)SvPVX(littlestr); s = bigend - littlelen; - if (*s == *little && memEQ((char*)s,(char*)little,littlelen)) + if (s > big + && bigend[-1] == '\n' + && s[-1] == *little && memEQ((char*)s - 1,(char*)little,littlelen)) + return (char*)s - 1; /* how sweet it is */ + else if (*s == *little && memEQ((char*)s,(char*)little,littlelen)) return (char*)s; /* how sweet it is */ - else if (bigend[-1] == '\n' && little[littlelen-1] != '\n' - && s > big) { - s--; - if (*s == *little && memEQ((char*)s,(char*)little,littlelen)) + return Nullch; + } + if (littlelen <= 2) { + unsigned char c1 = (unsigned char)SvPVX(littlestr)[0]; + unsigned char c2 = (unsigned char)SvPVX(littlestr)[1]; + /* This may do extra comparisons if littlelen == 2, but this + should be hidden in the noise since we do less indirection. */ + + s = big; + bigend -= littlelen; + while (s <= bigend) { + if (s[0] == c1 + && (littlelen == 1 || s[1] == c2) + && (!SvTAIL(littlestr) + || s == bigend + || s[littlelen] == '\n')) /* Automatically multiline */ + { return (char*)s; + } + s++; } return Nullch; } @@ -1163,13 +1273,6 @@ die(pat, va_alist) "%p: die: curstack = %p, mainstack = %p\n", thr, curstack, mainstack)); #endif /* USE_THREADS */ - /* We have to switch back to mainstack or die_where may try to pop - * the eval block from the wrong stack if die is being called from a - * signal handler. - dkindred@cs.cmu.edu */ - if (curstack != mainstack) { - dSP; - SWITCHSTACK(curstack, mainstack); - } #ifdef I_STDARG va_start(args, pat); @@ -1201,7 +1304,7 @@ die(pat, va_alist) SvREADONLY_on(msg); SAVEFREESV(msg); - PUSHMARK(sp); + PUSHMARK(SP); XPUSHs(msg); PUTBACK; perl_call_sv((SV*)cv, G_DISCARD); @@ -1266,7 +1369,7 @@ croak(pat, va_alist) SvREADONLY_on(msg); SAVEFREESV(msg); - PUSHMARK(sp); + PUSHMARK(SP); XPUSHs(msg); PUTBACK; perl_call_sv((SV*)cv, G_DISCARD); @@ -1325,7 +1428,7 @@ warn(pat,va_alist) SvREADONLY_on(msg); SAVEFREESV(msg); - PUSHMARK(sp); + PUSHMARK(SP); XPUSHs(msg); PUTBACK; perl_call_sv((SV*)cv, G_DISCARD); @@ -1336,7 +1439,12 @@ warn(pat,va_alist) } PerlIO_puts(PerlIO_stderr(),message); #ifdef LEAKTEST - DEBUG_L(xstat()); + DEBUG_L(*message == '!' + ? (xstat(message[1]=='!' + ? (message[2]=='!' ? 2 : 1) + : 0) + , 0) + : 0); #endif (void)PerlIO_flush(PerlIO_stderr()); } @@ -1426,7 +1534,7 @@ my_setenv(char *nam,char *val) vallen = strlen(val); New(904, envstr, namlen + vallen + 3, char); (void)sprintf(envstr,"%s=%s",nam,val); - (void)putenv(envstr); + (void)PerlEnv_putenv(envstr); if (oldstr) Safefree(oldstr); #ifdef _MSC_VER @@ -1483,7 +1591,7 @@ char *f; { I32 i; - for (i = 0; unlink(f) >= 0; i++) ; + for (i = 0; PerlLIO_unlink(f) >= 0; i++) ; return i ? 0 : -1; } #endif @@ -1592,12 +1700,7 @@ char *args; #ifdef MYSWAP #if BYTEORDER != 0x4321 short -#ifndef CAN_PROTOTYPE -my_swap(s) -short s; -#else my_swap(short s) -#endif { #if (BYTEORDER & 1) == 0 short result; @@ -1610,12 +1713,7 @@ my_swap(short s) } long -#ifndef CAN_PROTOTYPE -my_htonl(l) -register long l; -#else my_htonl(long l) -#endif { union { long result; @@ -1644,12 +1742,7 @@ my_htonl(long l) } long -#ifndef CAN_PROTOTYPE -my_ntohl(l) -register long l; -#else my_ntohl(long l) -#endif { union { long l; @@ -1755,17 +1848,17 @@ my_popen(char *cmd, char *mode) return my_syspopen(cmd,mode); } #endif - if (pipe(p) < 0) - return Nullfp; This = (*mode == 'w'); that = !This; if (doexec && tainting) { taint_env(); taint_proper("Insecure %s%s", "EXEC"); } + if (PerlProc_pipe(p) < 0) + return Nullfp; while ((pid = (doexec?vfork():fork())) < 0) { if (errno != EAGAIN) { - close(p[This]); + PerlLIO_close(p[This]); if (!doexec) croak("Can't fork"); return Nullfp; @@ -1777,10 +1870,10 @@ my_popen(char *cmd, char *mode) #define THIS that #define THAT This - close(p[THAT]); + PerlLIO_close(p[THAT]); if (p[THIS] != (*mode == 'r')) { - dup2(p[THIS], *mode == 'r'); - close(p[THIS]); + PerlLIO_dup2(p[THIS], *mode == 'r'); + PerlLIO_close(p[THIS]); } if (doexec) { #if !defined(HAS_FCNTL) || !defined(F_SETFD) @@ -1790,10 +1883,10 @@ my_popen(char *cmd, char *mode) #define NOFILE 20 #endif for (fd = maxsysfd + 1; fd < NOFILE; fd++) - close(fd); + PerlLIO_close(fd); #endif do_exec(cmd); /* may or may not use the shell */ - _exit(1); + PerlProc__exit(1); } /*SUPPRESS 560*/ if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV)) @@ -1805,10 +1898,10 @@ my_popen(char *cmd, char *mode) #undef THAT } do_execfree(); /* free any memory malloced by child on vfork */ - close(p[that]); + PerlLIO_close(p[that]); if (p[that] < p[This]) { - dup2(p[This], p[that]); - close(p[This]); + PerlLIO_dup2(p[This], p[that]); + PerlLIO_close(p[This]); p[This] = p[that]; } sv = *av_fetch(fdpid,p[This],TRUE); @@ -1842,7 +1935,7 @@ char *s; PerlIO_printf(PerlIO_stderr(),"%s", s); for (fd = 0; fd < 32; fd++) { - if (Fstat(fd,&tmpstatbuf) >= 0) + if (PerlLIO_fstat(fd,&tmpstatbuf) >= 0) PerlIO_printf(PerlIO_stderr()," %d",fd); } PerlIO_printf(PerlIO_stderr(),"\n"); @@ -1858,7 +1951,7 @@ int newfd; #if defined(HAS_FCNTL) && defined(F_DUPFD) if (oldfd == newfd) return oldfd; - close(newfd); + PerlLIO_close(newfd); return fcntl(oldfd, F_DUPFD, newfd); #else #define DUP2_MAX_FDS 256 @@ -1868,18 +1961,18 @@ int newfd; if (oldfd == newfd) return oldfd; - close(newfd); + PerlLIO_close(newfd); /* good enough for low fd's... */ - while ((fd = dup(oldfd)) != newfd && fd >= 0) { + while ((fd = PerlLIO_dup(oldfd)) != newfd && fd >= 0) { if (fdx >= DUP2_MAX_FDS) { - close(fd); + PerlLIO_close(fd); fd = -1; break; } fdtmp[fdx++] = fd; } while (fdx > 0) - close(fdtmp[--fdx]); + PerlLIO_close(fdtmp[--fdx]); return fd; #endif } @@ -1941,7 +2034,7 @@ rsignal_restore(int signo, Sigsave_t *save) Sighandler_t rsignal(int signo, Sighandler_t handler) { - return signal(signo, handler); + return PerlProc_signal(signo, handler); } static int sig_trapped; @@ -1959,24 +2052,24 @@ rsignal_state(int signo) Sighandler_t oldsig; sig_trapped = 0; - oldsig = signal(signo, sig_trap); - signal(signo, oldsig); + oldsig = PerlProc_signal(signo, sig_trap); + PerlProc_signal(signo, oldsig); if (sig_trapped) - kill(getpid(), signo); + PerlProc_kill(getpid(), signo); return oldsig; } int rsignal_save(int signo, Sighandler_t handler, Sigsave_t *save) { - *save = signal(signo, handler); + *save = PerlProc_signal(signo, handler); return (*save == SIG_ERR) ? -1 : 0; } int rsignal_restore(int signo, Sigsave_t *save) { - return (signal(signo, *save) == SIG_ERR) ? -1 : 0; + return (PerlProc_signal(signo, *save) == SIG_ERR) ? -1 : 0; } #endif /* !HAS_SIGACTION */ @@ -1984,7 +2077,7 @@ rsignal_restore(int signo, Sigsave_t *save) /* VMS' my_pclose() is in VMS.c; same with OS/2 */ #if (!defined(DOSISH) || defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) I32 -my_pclose(FILE *ptr) +my_pclose(PerlIO *ptr) { Sigsave_t hstat, istat, qstat; int status; @@ -1995,6 +2088,9 @@ my_pclose(FILE *ptr) #ifdef VMS int saved_vaxc_errno; #endif +#ifdef WIN32 + int saved_win32_errno; +#endif svp = av_fetch(fdpid,PerlIO_fileno(ptr),TRUE); pid = (int)SvIVX(*svp); @@ -2010,9 +2106,12 @@ my_pclose(FILE *ptr) #ifdef VMS saved_vaxc_errno = vaxc$errno; #endif +#ifdef WIN32 + saved_win32_errno = GetLastError(); +#endif } #ifdef UTS - if(kill(pid, 0) < 0) { return(pid); } /* HOM 12/23/91 */ + if(PerlProc_kill(pid, 0) < 0) { return(pid); } /* HOM 12/23/91 */ #endif rsignal_save(SIGHUP, SIG_IGN, &hstat); rsignal_save(SIGINT, SIG_IGN, &istat); @@ -2031,7 +2130,7 @@ my_pclose(FILE *ptr) } #endif /* !DOSISH */ -#if !defined(DOSISH) || defined(OS2) +#if !defined(DOSISH) || defined(OS2) || defined(WIN32) I32 wait4pid(int pid, int *statusp, int flags) { @@ -2089,7 +2188,7 @@ wait4pid(int pid, int *statusp, int flags) } #endif } -#endif /* !DOSISH */ +#endif /* !DOSISH || OS2 || WIN32 */ void /*SUPPRESS 590*/ @@ -2246,13 +2345,13 @@ char *b; sv_setpv(tmpsv, "."); else sv_setpvn(tmpsv, a, fa - a); - if (Stat(SvPVX(tmpsv), &tmpstatbuf1) < 0) + if (PerlLIO_stat(SvPVX(tmpsv), &tmpstatbuf1) < 0) return FALSE; if (fb == b) sv_setpv(tmpsv, "."); else sv_setpvn(tmpsv, b, fb - b); - if (Stat(SvPVX(tmpsv), &tmpstatbuf2) < 0) + if (PerlLIO_stat(SvPVX(tmpsv), &tmpstatbuf2) < 0) return FALSE; return tmpstatbuf1.st_dev == tmpstatbuf2.st_dev && tmpstatbuf1.st_ino == tmpstatbuf2.st_ino; @@ -2408,11 +2507,11 @@ condpair_magic(SV *sv) COND_INIT(&cp->owner_cond); COND_INIT(&cp->cond); cp->owner = 0; - MUTEX_LOCK(&sv_mutex); + LOCK_SV_MUTEX; mg = mg_find(sv, 'm'); if (mg) { /* someone else beat us to initialising it */ - MUTEX_UNLOCK(&sv_mutex); + UNLOCK_SV_MUTEX; MUTEX_DESTROY(&cp->mutex); COND_DESTROY(&cp->owner_cond); COND_DESTROY(&cp->cond); @@ -2423,7 +2522,7 @@ condpair_magic(SV *sv) mg = SvMAGIC(sv); mg->mg_ptr = (char *)cp; mg->mg_len = sizeof(cp); - MUTEX_UNLOCK(&sv_mutex); + UNLOCK_SV_MUTEX; DEBUG_L(WITH_THR(PerlIO_printf(PerlIO_stderr(), "%p: condpair_magic %p\n", thr, sv));) } @@ -2508,7 +2607,7 @@ new_struct_thread(struct perl_thread *t) /* Initialise all per-thread SVs that the template thread used */ svp = AvARRAY(t->threadsv); - for (i = 0; i <= AvFILL(t->threadsv); i++, svp++) { + for (i = 0; i <= AvFILLp(t->threadsv); i++, svp++) { if (*svp && *svp != &sv_undef) { SV *sv = newSVsv(*svp); av_store(thr->threadsv, i, sv); @@ -2517,6 +2616,7 @@ new_struct_thread(struct perl_thread *t) "new_struct_thread: copied threadsv %d %p->%p\n",i, t, thr)); } } + thr->threadsvp = AvARRAY(thr->threadsv); MUTEX_LOCK(&threads_mutex); nthreads++; @@ -2547,3 +2647,22 @@ Perl_huge(void) } #endif +#ifdef PERL_GLOBAL_STRUCT +struct perl_vars * +Perl_GetVars(void) +{ + return &Perl_Vars; +} +#endif + +char ** +get_op_names(void) +{ + return op_name; +} + +char ** +get_op_descs(void) +{ + return op_desc; +}