From: Tim Bunce Date: Tue, 2 Oct 2012 15:32:54 +0000 (+0100) Subject: Merge remote-tracking branch 'origin/rafl' into tim-20120930-sizeme X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=322b968f745c6ac1ede710b4c5dd2637cc5b01b5;p=p5sagit%2FDevel-Size.git Merge remote-tracking branch 'origin/rafl' into tim-20120930-sizeme Conflicts: .gitignore Makefile.PL SizeMe.xs Also added #ifdef PERL_IMPLICIT_CONTEXT around PL_my_cxt_size. --- 322b968f745c6ac1ede710b4c5dd2637cc5b01b5 diff --cc .gitignore index 478c4b0,eabf248..d519c74 --- a/.gitignore +++ b/.gitignore @@@ -8,5 -8,6 +8,6 @@@ MYMETA.jso MYMETA.yml Makefile Makefile.old -Memory.[co] -Memory.bs +SizeMe.[co] +SizeMe.bs + refcounted_he.h diff --cc Makefile.PL index e27fe4c,6469edd..53de44f --- a/Makefile.PL +++ b/Makefile.PL @@@ -8,10 -9,15 +9,15 @@@ use Config or die "Your pointer size of $Config{ptrsize} is very confusing"; my $ptr_bits = length $1; + write_header( + 'refcounted_he.h' => + extract_refcounted_he(catfile($Config{archlib}, 'CORE', 'hv.h')) + ); + WriteMakefile( OPTIMIZE => "-g", - NAME => 'Devel::Memory', - VERSION_FROM => 'lib/Devel/Memory.pm', + NAME => 'Devel::SizeMe', + VERSION_FROM => 'lib/Devel/SizeMe.pm', DEFINE => "-DALIGN_BITS=$ptr_bits", PREREQ_PM => { 'Test::More' => 0, @@@ -20,8 -26,12 +26,12 @@@ 'Mojolicious::Lite' => 0, 'Devel::Dwarn' => 0, XSLoader => 0, + ORLite => 0, }, - EXE_FILES => [ 'bin/dmemtree.pl' ], + EXE_FILES => [ 'bin/sizeme_store.pl' ], + clean => { + FILES => 'refcounted_he.h', + }, (eval $ExtUtils::MakeMaker::VERSION >= 6.47 ? (MIN_PERL_VERSION => '5.005') : ()), (eval $ExtUtils::MakeMaker::VERSION >= 6.31 ? (LICENSE => 'perl') : ()), ); diff --cc SizeMe.xs index a887fe0,ce6017c..2b440b5 --- a/SizeMe.xs +++ b/SizeMe.xs @@@ -108,10 -110,9 +110,10 @@@ struct state start with 0 bits, hence the start of this array will be hot, and the end unused. So put the flags next to the hot end. */ void *tracking[256]; + NV start_time_nv; int min_recurse_threshold; /* callback hooks and data */ - int (*add_attr_cb)(struct state *st, npath_node_t *npath_node, UV attr_type, const char *name, UV value); + void (*add_attr_cb)(pTHX_ struct state *st, npath_node_t *npath_node, UV attr_type, const char *name, UV value); void (*free_state_cb)(pTHX_ struct state *st); void *state_cb_data; /* free'd by free_state() after free_state_cb() call */ /* this stuff wil be moved to state_cb_data later */ @@@ -174,12 -180,21 +181,26 @@@ #define NPattr_PADNAME 0x03 #define NPattr_PADTMP 0x04 #define NPattr_NOTE 0x05 -#define NPattr_PRE_ATTR 0x06 +#define NPattr_PRE_ATTR 0x06 /* deprecated */ - #define _ADD_ATTR_NP(st, attr_type, attr_name, attr_value, np) (st->add_attr_cb && st->add_attr_cb(st, np, attr_type, attr_name, attr_value)) + #define _ADD_ATTR_NP(st, attr_type, attr_name, attr_value, np) \ + STMT_START { \ + if (st->add_attr_cb) { \ + st->add_attr_cb(aTHX_ st, np, attr_type, attr_name, attr_value); \ + } \ + } STMT_END + #define ADD_ATTR(st, attr_type, attr_name, attr_value) _ADD_ATTR_NP(st, attr_type, attr_name, attr_value, NP-1) - #define ADD_LINK_ATTR(st, attr_type, attr_name, attr_value) (assert(NP->seqn), _ADD_ATTR_NP(st, attr_type, attr_name, attr_value, NP)) - #define ADD_PRE_ATTR(st, attr_type, attr_name, attr_value) (assert(!attr_type), _ADD_ATTR_NP(st, NPattr_PRE_ATTR, attr_name, attr_value, NP-1)) ++#define ADD_LINK_ATTR(st, attr_type, attr_name, attr_value) \ ++ STMT_START { \ ++ assert(NP->seqn); \ ++ _ADD_ATTR_NP(st, attr_type, attr_name, attr_value, NP); \ ++ } STMT_END; + #define ADD_PRE_ATTR(st, attr_type, attr_name, attr_value) \ + STMT_START { \ + assert(!attr_type); \ + _ADD_ATTR_NP(st, NPattr_PRE_ATTR, attr_name, attr_value, NP-1); \ + } STMT_END; #define _NPathLink(np, nid, ntype) (((np)->id=nid), ((np)->type=ntype), ((np)->seqn=0)) #define NPathLink(nid) (_NPathLink(NP, nid, NPtype_LINK), NP) @@@ -218,29 -238,9 +244,27 @@@ static const char *svtypenames[SVt_LAST #endif }; +static NV +gettimeofday_nv(void) +{ +#ifdef HAS_GETTIMEOFDAY + struct timeval when; + gettimeofday(&when, (struct timezone *) 0); + return when.tv_sec + (when.tv_usec / 1000000.0); +#else + if (u2time) { + UV time_of_day[2]; + (*u2time)(aTHX_ &time_of_day); + return time_of_day[0] + (time_of_day[1] / 1000000.0); + } + return (NV)time(); +#endif +} + + int - np_print_node_name(FILE *fp, npath_node_t *npath_node) + np_print_node_name(pTHX_ FILE *fp, npath_node_t *npath_node) { - char buf[1024]; /* XXX */ - switch (npath_node->type) { case NPtype_SV: { /* id is pointer to the SV sv_size was called on */ const SV *sv = (SV*)npath_node->id; @@@ -878,32 -940,7 +964,7 @@@ op_size_class(pTHX_ const OP * const ba } } - static void - hek_size(pTHX_ struct state *st, HEK *hek, U32 shared, pPATH) - { - dNPathUseParent(NPathArg); - - /* Hash keys can be shared. Have we seen this before? */ - if (!check_new(st, hek)) - return; - ADD_SIZE(st, "hek_len", HEK_BASESIZE + hek->hek_len - #if PERL_VERSION < 8 - + 1 /* No hash key flags prior to 5.8.0 */ - #else - + 2 - #endif - ); - if (shared) { - #if PERL_VERSION < 10 - ADD_SIZE(st, "he", sizeof(struct he)); - #else - ADD_SIZE(st, "shared_he", STRUCT_OFFSET(struct shared_he, shared_he_hek)); - #endif - } - } - - -#if PERL_VERSION < 8 || PERL_SUBVERSION < 9 +#if PERL_VERSION < 8 || PERL_SUBVERSION < 9 /* XXX plain || seems like a bug */ # define SVt_LAST 16 #endif @@@ -1303,18 -1334,22 +1363,24 @@@ else warn("skipped suspect HeVAL %p", H } if (type >= SVt_PVMG) { + if (SvMAGICAL(thing)) magic_size(aTHX_ thing, st, NPathLink("MG")); + if (SvPAD_OUR(thing) && SvOURSTASH(thing)) + sv_size(aTHX_ st, NPathLink("SvOURSTASH"), (SV *)SvOURSTASH(thing), SOME_RECURSION); + if (SvSTASH(thing)) + sv_size(aTHX_ st, NPathLink("SvSTASH"), (SV *)SvSTASH(thing), SOME_RECURSION); } - return; + return 1; } static void free_memnode_state(pTHX_ struct state *st) { - PERL_UNUSED_ARG(aTHX); ++ /* PERL_UNUSED_ARG(aTHX); fails for non-threaded perl */ if (st->node_stream_fh && st->node_stream_name && *st->node_stream_name) { + fprintf(st->node_stream_fh, "E %d %f %s\n", + getpid(), gettimeofday_nv()-st->start_time_nv, "unnamed"); if (*st->node_stream_name == '|') { if (pclose(st->node_stream_fh)) warn("%s exited with an error status\n", st->node_stream_name); @@@ -1443,10 -1537,60 +1571,62 @@@ perl_size(pTHX_ struct state *const st sv_size(aTHX_ st, NPathLink("PL_main_cv"), (SV*)PL_main_cv, TOTAL_SIZE_RECURSION); sv_size(aTHX_ st, NPathLink("PL_main_root"), (SV*)PL_main_root, TOTAL_SIZE_RECURSION); sv_size(aTHX_ st, NPathLink("PL_main_start"), (SV*)PL_main_start, TOTAL_SIZE_RECURSION); - /* TODO PL_pidstatus */ + sv_size(aTHX_ st, NPathLink("PL_envgv"), (SV*)PL_envgv, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_hintgv"), (SV*)PL_hintgv, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_e_script"), (SV*)PL_e_script, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_encoding"), (SV*)PL_encoding, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_ofsgv"), (SV*)PL_ofsgv, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_argvout_stack"), (SV*)PL_argvout_stack, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_beginav"), (SV*)PL_beginav, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_beginav_save"), (SV*)PL_beginav_save, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_checkav_save"), (SV*)PL_checkav_save, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_unitcheckav"), (SV*)PL_unitcheckav, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_unitcheckav_save"), (SV*)PL_unitcheckav_save, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_endav"), (SV*)PL_endav, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_checkav"), (SV*)PL_checkav, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_initav"), (SV*)PL_initav, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_isarev"), (SV*)PL_isarev, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_fdpid"), (SV*)PL_fdpid, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_preambleav"), (SV*)PL_preambleav, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_ors_sv"), (SV*)PL_ors_sv, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_modglobal"), (SV*)PL_modglobal, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_custom_op_names"), (SV*)PL_custom_op_names, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_custom_op_descs"), (SV*)PL_custom_op_descs, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_custom_ops"), (SV*)PL_custom_ops, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_compcv"), (SV*)PL_compcv, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_DBcv"), (SV*)PL_DBcv, TOTAL_SIZE_RECURSION); + #ifdef PERL_USES_PL_PIDSTATUS + sv_size(aTHX_ st, NPathLink("PL_pidstatus"), (SV*)PL_pidstatus, TOTAL_SIZE_RECURSION); + #endif + sv_size(aTHX_ st, NPathLink("PL_subname"), (SV*)PL_subname, TOTAL_SIZE_RECURSION); + #ifdef USE_LOCALE_NUMERIC + sv_size(aTHX_ st, NPathLink("PL_numeric_radix_sv"), (SV*)PL_numeric_radix_sv, TOTAL_SIZE_RECURSION); + check_new_and_strlen(st, PL_numeric_name, NPathLink("PL_numeric_name")); + #endif + #ifdef USE_LOCALE_COLLATE + check_new_and_strlen(st, PL_collation_name, NPathLink("PL_collation_name")); + #endif + check_new_and_strlen(st, PL_origfilename, NPathLink("PL_origfilename")); + check_new_and_strlen(st, PL_inplace, NPathLink("PL_inplace")); + check_new_and_strlen(st, PL_osname, NPathLink("PL_osname")); + if (PL_op_mask && check_new(st, PL_op_mask)) + ADD_SIZE(st, "PL_op_mask", PL_maxo); + if (PL_exitlistlen && check_new(st, PL_exitlist)) + ADD_SIZE(st, "PL_exitlist", (PL_exitlistlen * sizeof(PerlExitListEntry *)) + + (PL_exitlistlen * sizeof(PerlExitListEntry))); ++#ifdef PERL_IMPLICIT_CONTEXT + if (PL_my_cxt_size && check_new(st, PL_my_cxt_list)) { + ADD_SIZE(st, "PL_my_cxt_list", (PL_my_cxt_size * sizeof(void *))); + #ifdef PERL_GLOBAL_STRUCT_PRIVATE + ADD_SIZE(st, "PL_my_cxt_keys", (PL_my_cxt_size * sizeof(char *))); + #endif + } ++#endif /* TODO PL_stashpad */ - /* TODO PL_compiling? COP */ + op_size_class(aTHX_ (OP*)&PL_compiling, OPc_COP, 1, st, NPathLink("PL_compiling")); + op_size_class(aTHX_ (OP*)PL_curcopdb, OPc_COP, 0, st, NPathLink("PL_curcopdb")); + parser_size(aTHX_ st, NPathLink("PL_parser"), PL_parser); /* TODO stacks: cur, main, tmps, mark, scope, save */ /* TODO PL_exitlist */ /* TODO PL_reentrant_buffers etc */