diff options
author | Nicholas Clark <nick@ccl4.org> | 2010-10-18 19:30:12 +0200 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2010-10-18 19:32:26 +0200 |
commit | 96d24b8ce2ce0411b22e29e30ee26700bb1213cf (patch) | |
tree | 6767b189834133a98c2c29aa35615e4a72a9bd3a /ext/Fcntl | |
parent | efe77345f79553ebc2eff1978e461a89d4448f00 (diff) | |
download | perl-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.pm | 8 | ||||
-rw-r--r-- | 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 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 + } |