This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
more dTHX optimizations
authorDaniel Dragan <bulk88@hotmail.com>
Mon, 12 Nov 2012 08:22:12 +0000 (03:22 -0500)
committerFather Chrysostomos <sprout@cpan.org>
Mon, 12 Nov 2012 19:18:06 +0000 (11:18 -0800)
Either delay fetching of the context, or move the declaration close to the
first usage point, or remove the dependency on a context.

perlio.c
util.c

index 905e043..a388ba7 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -466,7 +466,6 @@ PerlIO_debug(const char *fmt, ...)
        }
     }
     if (PL_perlio_debug_fd > 0) {
-       dTHX;
 #ifdef USE_ITHREADS
        const char * const s = CopFILE(PL_curcop);
        /* Use fixed buffer as sv_catpvf etc. needs SVs */
@@ -2392,7 +2391,6 @@ PerlIOUnix_refcnt_inc(int fd)
 int
 PerlIOUnix_refcnt_dec(int fd)
 {
-    dTHX;
     int cnt = 0;
     if (fd >= 0) {
        dVAR;
@@ -2401,12 +2399,12 @@ PerlIOUnix_refcnt_dec(int fd)
 #endif
        if (fd >= PL_perlio_fd_refcnt_size) {
            /* diag_listed_as: refcnt_dec: fd %d%s */
-           Perl_croak(aTHX_ "refcnt_dec: fd %d >= refcnt_size %d\n",
+           Perl_croak_nocontext("refcnt_dec: fd %d >= refcnt_size %d\n",
                       fd, PL_perlio_fd_refcnt_size);
        }
        if (PL_perlio_fd_refcnt[fd] <= 0) {
            /* diag_listed_as: refcnt_dec: fd %d%s */
-           Perl_croak(aTHX_ "refcnt_dec: fd %d: %d <= 0\n",
+           Perl_croak_nocontext("refcnt_dec: fd %d: %d <= 0\n",
                       fd, PL_perlio_fd_refcnt[fd]);
        }
        cnt = --PL_perlio_fd_refcnt[fd];
@@ -2416,7 +2414,7 @@ PerlIOUnix_refcnt_dec(int fd)
 #endif
     } else {
        /* diag_listed_as: refcnt_dec: fd %d%s */
-       Perl_croak(aTHX_ "refcnt_dec: fd %d < 0\n", fd);
+       Perl_croak_nocontext("refcnt_dec: fd %d < 0\n", fd);
     }
     return cnt;
 }
@@ -3790,12 +3788,14 @@ PerlIO_releaseFILE(PerlIO *p, FILE *f)
     while ((l = *p)) {
        if (l->tab == &PerlIO_stdio) {
            PerlIOStdio *s = PerlIOSelf(&l, PerlIOStdio);
-           if (s->stdio == f) {
-               dTHX;
+           if (s->stdio == f) { /* not in a loop */
                const int fd = fileno(f);
                if (fd >= 0)
                    PerlIOUnix_refcnt_dec(fd);
-               PerlIO_pop(aTHX_ p);
+               {
+                   dTHX;
+                   PerlIO_pop(aTHX_ p);
+               }
                return;
            }
        }
@@ -5093,9 +5093,9 @@ Perl_PerlIO_context_layers(pTHX_ const char *mode)
 int
 PerlIO_setpos(PerlIO *f, SV *pos)
 {
-    dTHX;
     if (SvOK(pos)) {
        STRLEN len;
+       dTHX;
        const Off_t * const posn = (Off_t *) SvPV(pos, len);
        if (f && len == sizeof(Off_t))
            return PerlIO_seek(f, *posn, SEEK_SET);
diff --git a/util.c b/util.c
index 5132c24..c0d1091 100644 (file)
--- a/util.c
+++ b/util.c
@@ -5362,7 +5362,7 @@ int
 Perl_my_socketpair (int family, int type, int protocol, int fd[2]) {
     /* Stevens says that family must be AF_LOCAL, protocol 0.
        I'm going to enforce that, then ignore it, and use TCP (or UDP).  */
-    dTHX;
+    dTHXa(NULL);
     int listener = -1;
     int connector = -1;
     int acceptor = -1;
@@ -5388,6 +5388,7 @@ Perl_my_socketpair (int family, int type, int protocol, int fd[2]) {
        return S_socketpair_udp(fd);
 #endif
 
+    aTHXa(PERL_GET_THX);
     listener = PerlSock_socket(AF_INET, type, 0);
     if (listener == -1)
        return -1;