From 96d24b8ce2ce0411b22e29e30ee26700bb1213cf Mon Sep 17 00:00:00 2001
From: Nicholas Clark <nick@ccl4.org>
Date: Mon, 18 Oct 2010 19:30:12 +0200
Subject: [PATCH] Convert Fcntl::S_IS{LNK,SOCK,BLK,CHR,FIFO,WHT,ENFMT} to XS.

This reduces the memory usage of Fcntl by quite a bit, as the same XSUB is used
by all 9 S_IS* functions.
---
 ext/Fcntl/Fcntl.pm |  8 ------
 ext/Fcntl/Fcntl.xs | 83 ++++++++++++++++++++++++++++++++++++++++++------------
 2 files changed, 65 insertions(+), 26 deletions(-)

diff --git a/ext/Fcntl/Fcntl.pm b/ext/Fcntl/Fcntl.pm
index 76f7226..4032e09 100644
--- a/ext/Fcntl/Fcntl.pm
+++ b/ext/Fcntl/Fcntl.pm
@@ -218,14 +218,6 @@ BEGIN {
 sub S_IFMT  { @_ ? ( $_[0] & _S_IFMT() ) : _S_IFMT()  }
 sub S_IMODE { $_[0] & 07777 }
 
-sub S_ISLNK    { ( $_[0] & _S_IFMT() ) == S_IFLNK()   }
-sub S_ISSOCK   { ( $_[0] & _S_IFMT() ) == S_IFSOCK()  }
-sub S_ISBLK    { ( $_[0] & _S_IFMT() ) == S_IFBLK()   }
-sub S_ISCHR    { ( $_[0] & _S_IFMT() ) == S_IFCHR()   }
-sub S_ISFIFO   { ( $_[0] & _S_IFMT() ) == S_IFIFO()   }
-sub S_ISWHT    { ( $_[0] & _S_IFMT() ) == S_IFWHT()   }
-sub S_ISENFMT  { ( $_[0] & _S_IFMT() ) == S_ENFMT()   }
-
 sub AUTOLOAD {
     (my $constname = $AUTOLOAD) =~ s/.*:://;
     die "&Fcntl::constant not defined" if $constname eq 'constant';
diff --git a/ext/Fcntl/Fcntl.xs b/ext/Fcntl/Fcntl.xs
index 03016d1..37762fe 100644
--- a/ext/Fcntl/Fcntl.xs
+++ b/ext/Fcntl/Fcntl.xs
@@ -33,27 +33,74 @@
    --AD  October 16, 1995
 */
 
+static XS(XS_Fcntl_S_ISREG); /* prototype to pass -Wmissing-prototypes */
+static
+XS(XS_Fcntl_S_ISREG)
+{
+    dVAR;
+    dXSARGS;
+    dXSI32;
+    /* Preserve the semantics of the perl code, which was:
+       sub S_ISREG    { ( $_[0] & _S_IFMT() ) == S_IFREG()   }
+    */
+    SV *mode;
+
+    PERL_UNUSED_VAR(cv); /* -W */
+    SP -= items;
+
+    if (items > 0)
+	mode = ST(0);
+    else {
+	mode = &PL_sv_undef;
+	EXTEND(SP, 1);
+    }
+    PUSHs(((SvUV(mode) & S_IFMT) == ix) ? &PL_sv_yes : &PL_sv_no);
+    PUTBACK;
+}
+
 #include "const-c.inc"
 
 MODULE = Fcntl		PACKAGE = Fcntl
 
 INCLUDE: const-xs.inc
 
-void
-S_ISREG(...)
-    ALIAS:
-	Fcntl::S_ISREG = S_IFREG
-	Fcntl::S_ISDIR = S_IFDIR
-    PREINIT:
-	/* Preserve the semantics of the perl code, which was:
-	   sub S_ISREG    { ( $_[0] & _S_IFMT() ) == S_IFREG()   }
-	 */
-	SV *mode;
-    PPCODE:
-	if (items > 0)
-	    mode = ST(0);
-	else {
-	    mode = &PL_sv_undef;
-	    EXTEND(SP, 1);
-	}
-	PUSHs(((SvUV(mode) & S_IFMT) == ix) ? &PL_sv_yes : &PL_sv_no);
+BOOT:
+    {
+        CV *cv;
+#ifdef S_IFREG
+        cv = newXS("Fcntl::S_ISREG", XS_Fcntl_S_ISREG, file);
+        XSANY.any_i32 = S_IFREG;
+#endif
+#ifdef S_IFDIR
+        cv = newXS("Fcntl::S_ISDIR", XS_Fcntl_S_ISREG, file);
+        XSANY.any_i32 = S_IFDIR;
+#endif
+#ifdef S_IFLNK
+        cv = newXS("Fcntl::S_ISLNK", XS_Fcntl_S_ISREG, file);
+        XSANY.any_i32 = S_IFLNK;
+#endif
+#ifdef S_IFSOCK
+        cv = newXS("Fcntl::S_ISSOCK", XS_Fcntl_S_ISREG, file);
+        XSANY.any_i32 = S_IFSOCK;
+#endif
+#ifdef S_IFBLK
+        cv = newXS("Fcntl::S_ISBLK", XS_Fcntl_S_ISREG, file);
+        XSANY.any_i32 = S_IFBLK;
+#endif
+#ifdef S_IFCHR
+        cv = newXS("Fcntl::S_ISCHR", XS_Fcntl_S_ISREG, file);
+        XSANY.any_i32 = S_IFCHR;
+#endif
+#ifdef S_IFIFO
+        cv = newXS("Fcntl::S_ISFIFO", XS_Fcntl_S_ISREG, file);
+        XSANY.any_i32 = S_IFIFO;
+#endif
+#ifdef S_IFWHT
+        cv = newXS("Fcntl::S_ISWHT", XS_Fcntl_S_ISREG, file);
+        XSANY.any_i32 = S_IFWHT;
+#endif
+#ifdef S_IFENFMT
+        cv = newXS("Fcntl::S_ISENFMT", XS_Fcntl_S_ISREG, file);
+        XSANY.any_i32 = S_ENFMT;
+#endif
+    }
-- 
1.8.3.1