develooper Front page | perl.perl5.porters | Postings from December 2001

[PATCH @13746] Leaner exporter

Thread Next
From:
Ilya Zakharevich
Date:
December 31, 2001 15:16
Subject:
[PATCH @13746] Leaner exporter
Message ID:
20011231181608.A29253@math.ohio-state.edu
I spent a lot of time trying to find how why my XS extension was using
so much heap (extra 400K here; this is approximately as much as the
size of Perl.DLL).  In the process of investigation I made some
improvements to Exporter; the change below shaves around 20-25% from
its memory usage (but this is not much in absolute numbers ;-).

[ However the solution to the initial problem turned out to be
  completely different.  DO NOT MEASURE MEMORY USAGE WITH -Mblib and XS!

  Well, blib.pm is not that bad; what skews things is that XSLoader
  does not work with the directory layout assumed by -Mblib; thus it
  falls back to DynaLoader with its behemotal memory usage.

  The situation is much improved by the fact that `make install' now
  works with uninstalled perl too!  I just did

   /fullpath/perl -I /fullpath/perl/lib Makefile.PL LIB=`pwd`/ilib
   make install
   /fullpath/perl -I /fullpath/perl/lib -Iilib test-arguments

  and the memory usage became as expected.  ]

BTW, the above LIB= command was the second attempt.  First I tried
with LIB=ilib.  This resulted in installations *reported* to places
similar to

   ilib/os2/auto/API_13746/ilib/API_13746

(note duplicated paths), *but* though everything was reported
successful, no copying actually happend.  I suspect that this would
happen with installed Perl too.  BUG?

Enjoy,
Ilya

P.S.  See the comments for the function as_heavy() below.  This is not
      the first time I would like to get the answer 'b' for the
      question 'who called me' in the situation

        sub a { report_its_caller() }
	*b = \&a;	  b()

      Any way to do it from C?

--- ./ext/B/t/stash.t-pre	Sat Dec 15 21:43:40 2001
+++ ./ext/B/t/stash.t	Sun Dec 30 23:46:40 2001
@@ -38,7 +38,7 @@ $a =~ s/-uNetWare,// if $^O eq 'NetWare'
 $a =~ s/-u(Cwd|File|File::Copy|OS2),//g if $^O eq 'os2';
 $a =~ s/-uCwd,// if $^O eq 'cygwin';
   $b = '-uCarp,-uCarp::Heavy,-uDB,-uExporter,-uExporter::Heavy,-uaccess,-uattributes,'
-     . '-umain,-ustrict,-uutf8,-uwarnings';
+     . '-umain,-uutf8,-uwarnings';
 if ($Is_VMS) {
     $a =~ s/-uFile,-uFile::Copy,//;
     $a =~ s/-uVMS,-uVMS::Filespec,//;
--- ./lib/Exporter.pm-pre	Mon Dec 17 10:27:02 2001
+++ ./lib/Exporter.pm	Sun Dec 30 23:29:38 2001
@@ -2,33 +2,27 @@ package Exporter;
 
 require 5.006;
 
-use strict;
-no strict 'refs';
+# Be lean.
+#use strict;
+#no strict 'refs';
 
 our $Debug = 0;
 our $ExportLevel = 0;
 our $Verbose ||= 0;
-our $VERSION = '5.565';
+our $VERSION = '5.566';
 $Carp::Internal{Exporter} = 1;
 
-sub export_to_level {
+sub as_heavy {
   require Exporter::Heavy;
-  goto &Exporter::Heavy::heavy_export_to_level;
+  # Unfortunately, this does not work if the caller is aliased as *name = \&foo
+  # Thus the need to create a lot of identical subroutines
+  my $c = (caller(1))[3];
+  $c =~ s/.*:://;
+  \&{"Exporter::Heavy::heavy_$c"};
 }
 
 sub export {
-  require Exporter::Heavy;
-  goto &Exporter::Heavy::heavy_export;
-}
-
-sub export_tags {
-  require Exporter::Heavy;
-  Exporter::Heavy::_push_tags((caller)[0], "EXPORT",    \@_);
-}
-
-sub export_ok_tags {
-  require Exporter::Heavy;
-  Exporter::Heavy::_push_tags((caller)[0], "EXPORT_OK", \@_);
+  goto &{as_heavy()};
 }
 
 sub import {
@@ -64,7 +58,6 @@ sub import {
   *{"$callpkg\::$_"} = \&{"$pkg\::$_"} foreach @_;
 }
 
-
 # Default methods
 
 sub export_fail {
@@ -72,12 +65,25 @@ sub export_fail {
     @_;
 }
 
+# Unfortunately, caller(1)[3] "does not work" if the caller is aliased as
+# *name = \&foo.  Thus the need to create a lot of identical subroutines
+# Otherwise we could have aliased them to export().
 
-sub require_version {
-    require Exporter::Heavy;
-    goto &Exporter::Heavy::require_version;
+sub export_to_level {
+  goto &{as_heavy()};
+}
+
+sub export_tags {
+  goto &{as_heavy()};
 }
 
+sub export_ok_tags {
+  goto &{as_heavy()};
+}
+
+sub require_version {
+  goto &{as_heavy()};
+}
 
 1;
 __END__
--- ./lib/Exporter/Heavy.pm-pre	Sun Dec 30 23:25:48 2001
+++ ./lib/Exporter/Heavy.pm	Sun Dec 30 23:26:06 2001
@@ -215,11 +215,18 @@ sub _push_tags {
     }
 }
 
-
-sub require_version {
+sub heavy_require_version {
     my($self, $wanted) = @_;
     my $pkg = ref $self || $self;
     return ${pkg}->VERSION($wanted);
+}
+
+sub heavy_export_tags {
+  _push_tags((caller)[0], "EXPORT",    \@_);
+}
+
+sub heavy_export_ok_tags {
+  _push_tags((caller)[0], "EXPORT_OK", \@_);
 }
 
 1;

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About