From: Nicholas Clark <nick@ccl4.org>
Date: Wed, 4 May 2011 18:41:54 +0000 (+0200)
Subject: The core's magic vtables are global constants, so aren't part of the size.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d9b022a1b74d43b80f7ae8caa6f0afc0eaad708f;p=p5sagit%2FDevel-Size.git

The core's magic vtables are global constants, so aren't part of the size.

Parse perl.h to find the names of the vtables' names, and generate code to add
them all in new_state() as "seen".
---

diff --git a/CHANGES b/CHANGES
index ad326bc..047d682 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,5 +1,8 @@
 Revision history for Perl extension Devel::Size.
 
+0.75_50 2011-05-04 nicholas
+ * The cores vtables are global and const, so don't count towards the size.
+
 0.75 2011-05-04 nicholas
  [no changes]
 
diff --git a/Makefile.PL b/Makefile.PL
index d1b6a31..7e550ee 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -1,15 +1,52 @@
+#!/usr/bin/perl -w
 use 5.008;
 use ExtUtils::MakeMaker;
+use strict;
 
 use Config;
 (unpack "B*", pack "N", $Config{ptrsize}) =~ /^0+1(0+)$/
   or die "Your pointer size of $Config{ptrsize} is very confusing";
 my $ptr_bits = length $1;
 
+my $svh = "$Config{archlibexp}/CORE/perl.h";
+my $vtable_file = 'vtables.inc';
+
+my %vtables;
+open FH, "<$svh"
+    or die "Can't open $svh ($!) - is your perl install missing its headers?";
+while (<FH>) {
+    next unless /^\s+(PL_vtbl_[a-z]+),\s*$/ or /^EXT MGVTBL (PL_vtbl_[a-z]+) =/;
+    ++$vtables{$1};
+}
+warn "Didn't find any vtable names in $svh" unless %vtables;
+close FH;
+
+
+my %special = (
+	       PL_vtbl_collxfrm => 'USE_LOCALE_COLLATE',
+	       PL_vtbl_mutex => 'USE_5005THREADS',
+);
+
+open FH, ">$vtable_file" or die "Can't open $vtable_file: $!";
+foreach (sort keys %vtables) {
+    if ($special{$_}) {
+	print FH <<"EOT";
+#ifdef $special{$_}
+    &$_,
+#endif
+EOT
+    } else {
+	print FH "    &$_,\n";
+    }
+}
+
+close FH or die "Error closing $vtable_file: $!";
+
 WriteMakefile(
   NAME => 'Devel::Size',
   VERSION_FROM => 'lib/Devel/Size.pm',
   DEFINE => "-DALIGN_BITS=$ptr_bits",
   ($ExtUtils::MakeMaker::VERSION >= 6.47 ? (MIN_PERL_VERSION => '5.008') : ()),
   ($ExtUtils::MakeMaker::VERSION >= 6.31 ? (LICENSE => 'perl') : ()),
+  realclean => {FILES=> $vtable_file},
 );
diff --git a/Size.xs b/Size.xs
index a3f6eed..ff5b4e4 100644
--- a/Size.xs
+++ b/Size.xs
@@ -731,11 +731,18 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing,
   return TRUE;
 }
 
+void *vtables[] = {
+#include "vtables.inc"
+    NULL
+};
+
 static struct state *
 new_state(pTHX)
 {
     SV *warn_flag;
     struct state *st;
+    void **vt_p = vtables;
+
     Newxz(st, 1, struct state);
     st->go_yell = TRUE;
     if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
@@ -747,6 +754,8 @@ new_state(pTHX)
     check_new(st, &PL_sv_undef);
     check_new(st, &PL_sv_no);
     check_new(st, &PL_sv_yes);
+    while(*vt_p)
+	check_new(st, *vt_p++);
     return st;
 }