summaryrefslogtreecommitdiff
path: root/ext/Fcntl
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2010-10-18 19:30:12 +0200
committerNicholas Clark <nick@ccl4.org>2010-10-18 19:32:26 +0200
commit96d24b8ce2ce0411b22e29e30ee26700bb1213cf (patch)
tree6767b189834133a98c2c29aa35615e4a72a9bd3a /ext/Fcntl
parentefe77345f79553ebc2eff1978e461a89d4448f00 (diff)
downloadperl-96d24b8ce2ce0411b22e29e30ee26700bb1213cf.tar.gz
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.
Diffstat (limited to 'ext/Fcntl')
-rw-r--r--ext/Fcntl/Fcntl.pm8
-rw-r--r--ext/Fcntl/Fcntl.xs83
2 files changed, 65 insertions, 26 deletions
diff --git a/ext/Fcntl/Fcntl.pm b/ext/Fcntl/Fcntl.pm
index 76f72265ad..4032e0985d 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 03016d142f..37762fed7a 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
+ }