Perl_newIO() can become a mathom by making newIO() a wrapper around newSV_type()

and tweaking Perl_sv_upgrade().

diff --git a/embed.fnc b/embed.fnc
index 3ada68a..71bb983 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -682,7 +682,7 @@ Apa |OP*    |newGVREF       |I32 type|NULLOK OP* o
 ApaR   |OP*    |newHVREF       |NN OP* o
 AmdbR  |HV*    |newHV
 ApaR   |HV*    |newHVhv        |NULLOK HV *hv
-Apa    |IO*    |newIO
+Apabm  |IO*    |newIO
 Apa    |OP*    |newLISTOP      |I32 type|I32 flags|NULLOK OP* first|NULLOK OP* last
 #ifdef USE_ITHREADS
 Apa    |OP*    |newPADOP       |I32 type|I32 flags|NN SV* sv

diff --git a/embed.h b/embed.h
index ae708d6..e1e6420 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -570,7 +570,6 @@
 #define newGVREF               Perl_newGVREF
 #define newHVREF               Perl_newHVREF
 #define newHVhv                        Perl_newHVhv
-#define newIO                  Perl_newIO
 #define newLISTOP              Perl_newLISTOP
 #ifdef USE_ITHREADS
 #define newPADOP               Perl_newPADOP
@@ -2907,7 +2906,6 @@
 #define newGVREF(a,b)          Perl_newGVREF(aTHX_ a,b)
 #define newHVREF(a)            Perl_newHVREF(aTHX_ a)
 #define newHVhv(a)             Perl_newHVhv(aTHX_ a)
-#define newIO()                        Perl_newIO(aTHX)
 #define newLISTOP(a,b,c,d)     Perl_newLISTOP(aTHX_ a,b,c,d)
 #ifdef USE_ITHREADS
 #define newPADOP(a,b,c)                Perl_newPADOP(aTHX_ a,b,c)

diff --git a/gv.c b/gv.c
index d46b253..782bfe6 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -1485,27 +1485,6 @@ Perl_gv_efullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain
     gv_fullname4(sv, egv ? egv : gv, prefix, keepmain);
 }
 
-IO *
-Perl_newIO(pTHX)
-{
-    dVAR;
-    GV *iogv;
-    IO * const io = MUTABLE_IO(newSV_type(SVt_PVIO));
-    /* This used to read SvREFCNT(io) = 1;
-       It's not clear why the reference count needed an explicit reset. NWC
-    */
-    assert (SvREFCNT(io) == 1);
-    SvOBJECT_on(io);
-    /* Clear the stashcache because a new IO could overrule a package name */
-    hv_clear(PL_stashcache);
-    iogv = gv_fetchpvs("FileHandle::", 0, SVt_PVHV);
-    /* unless exists($main::{FileHandle}) and defined(%main::FileHandle::) */
-    if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
-      iogv = gv_fetchpvs("IO::Handle::", GV_ADD, SVt_PVHV);
-    SvSTASH_set(io, MUTABLE_HV(SvREFCNT_inc(GvHV(iogv))));
-    return io;
-}
-
 void
 Perl_gv_check(pTHX_ const HV *stash)
 {

diff --git a/mathoms.c b/mathoms.c
index 5ae5d2d..012ccc2 100644 (file)
--- a/mathoms.c
+++ b/mathoms.c
@@ -76,6 +76,7 @@ PERL_CALLCONV int Perl_printf_nocontext(const char *format, ...);
 PERL_CALLCONV int Perl_magic_setglob(pTHX_ SV* sv, MAGIC* mg);
 PERL_CALLCONV AV * Perl_newAV(pTHX);
 PERL_CALLCONV HV * Perl_newHV(pTHX);
+PERL_CALLCONV IO * Perl_newIO(pTHX);
 
 /* ref() is now a macro using Perl_doref;
  * this version provided for binary compatibility only.
@@ -1499,6 +1500,12 @@ Perl_gv_HVadd(pTHX_ register GV *gv)
     return gv_HVadd(gv);
 }
 
+IO *
+Perl_newIO(pTHX)
+{
+    return MUTABLE_IO(newSV_type(SVt_PVIO));
+}
+
 #endif /* NO_MATHOMS */
 
 /*

diff --git a/proto.h b/proto.h
index aee22c0..90ffd21 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2123,9 +2123,9 @@ PERL_CALLCONV HV* Perl_newHVhv(pTHX_ HV *hv)
                        __attribute__malloc__
                        __attribute__warn_unused_result__;
 
-PERL_CALLCONV IO*      Perl_newIO(pTHX)
+/* PERL_CALLCONV IO*   Perl_newIO(pTHX)
                        __attribute__malloc__
-                       __attribute__warn_unused_result__;
+                       __attribute__warn_unused_result__; */
 
 PERL_CALLCONV OP*      Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP* first, OP* last)
                        __attribute__malloc__

diff --git a/sv.c b/sv.c
index a5a3554..b8daf81 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1430,8 +1430,22 @@ Perl_sv_upgrade(pTHX_ register SV *const sv, svtype new_type)
            SvNV_set(sv, 0);
 #endif
 
-       if (new_type == SVt_PVIO)
+       if (new_type == SVt_PVIO) {
+           IO * const io = MUTABLE_IO(sv);
+           GV *iogv = gv_fetchpvs("FileHandle::", 0, SVt_PVHV);
+
+           SvOBJECT_on(io);
+           /* Clear the stashcache because a new IO could overrule a package
+              name */
+           hv_clear(PL_stashcache);
+
+           /* unless exists($main::{FileHandle}) and
+              defined(%main::FileHandle::) */
+           if (!(iogv && GvHV(iogv) && HvARRAY(GvHV(iogv))))
+               iogv = gv_fetchpvs("IO::Handle::", GV_ADD, SVt_PVHV);
+           SvSTASH_set(io, MUTABLE_HV(SvREFCNT_inc(GvHV(iogv))));
            IoPAGE_LEN(sv) = 60;
+       }
        if (old_type < SVt_PV) {
            /* referant will be NULL unless the old type was SVt_IV emulating
               SVt_RV */

diff --git a/sv.h b/sv.h
index 0d275d2..90771a4 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -2016,6 +2016,9 @@ Evaluates I<sv> more than once. Sets I<len> to 0 if C<SvOOK(sv)> is false.
        }                                                               \
     } STMT_END
 #endif
+
+#define newIO()        MUTABLE_IO(newSV_type(SVt_PVIO))
+
 /*
  * Local variables:
  * c-indentation-style: bsd