develooper Front page | perl.perl5.porters | Postings from September 2012

[perl #114864] caching overloading tables as magic slows down hash lookups

Thread Previous | Thread Next
From:
Nicholas Clark
Date:
September 12, 2012 08:54
Subject:
[perl #114864] caching overloading tables as magic slows down hash lookups
Message ID:
rt-3.6.HEAD-11172-1347465255-5.114864-75-0@perl.org
# New Ticket Created by  Nicholas Clark 
# Please include the string:  [perl #114864]
# in the subject line of all future correspondence about this issue. 
# <URL: https://rt.perl.org:443/rt3/Ticket/Display.html?id=114864 >


The CV pointers for overloading methods are cached in a structure stored in
magic which is hung onto the HV representing the symbol table. DESTROY is
also cached here.

It's been like this for approximately forever. (I believe)

The result is that as soon as an object is destroyed, any lookups on that
hash find their way into this code:

    if (SvSMAGICAL(hv) && SvGMAGICAL(hv) && !(action & HV_DISABLE_UVAR_XKEY)) {
	MAGIC* mg;
	if ((mg = mg_find((const SV *)hv, PERL_MAGIC_uvar))) {

That isn't great.

I suspect that a solution is to move struct am_table from MAGIC into a
pointer in struct hv_aux.


Here's the long version. Looking up 'a' in %:: twice, before and after an
object in that package is DESTROYed.

Notice how first time through the code goes straight from line 404 to
407. Whereas once overload magic is attached, there's a diversion into the
code at line 405, and calls into Perl_mg_find() and S_mg_findext_flags().

$ gdb --args ./perl -le '$::{a}; bless []; $::{a};'
GNU gdb 6.3.50-20050815 (Apple version gdb-1515) (Sat Jan 15 08:33:48 UTC 2011)
Copyright 2004 Free Software Foundation, Inc.
GDB is free software, covered by the GNU General Public License, and you are
welcome to change it and/or distribute copies of it under certain conditions.
Type "show copying" to see the conditions.
There is absolutely no warranty for GDB.  Type "show warranty" for details.
This GDB was configured as "x86_64-apple-darwin"...Reading symbols for shared libraries ... done

(gdb) b perl_run
Breakpoint 1 at 0x100054b4f: file perl.c, line 2289.
(gdb) r
Starting program: /Volumes/Stuff/Perl/perl/perl -le \$::\{a\}\;\ bless\ \[\]\;\ \$::\{a\}\;
Reading symbols for shared libraries ++.. done

Breakpoint 1, perl_run (my_perl=0x100600080) at perl.c:2289
2289        int ret = 0;
(gdb) b Perl_hv_common if keysv
Breakpoint 2 at 0x1001db191: file hv.c, line 349.
(gdb) c
Continuing.

Breakpoint 2, Perl_hv_common (hv=0x100801f20, keysv=0x100810410, key=0x0, klen=0, flags=0, action=0, val=0x0, hash=3392050242) at hv.c:349
349         const int return_svp = action & HV_FETCH_JUST_SV;
(gdb) call Perl_sv_dump(hv)
SV = PVHV(0x1008078a0) at 0x100801f20
  REFCNT = 2
  FLAGS = (OOK,SHAREKEYS)
  ARRAY = 0x100606b40  (0:31, 1:27, 2:6)
  hash quality = 121.9%
  KEYS = 39
  FILL = 33
  MAX = 63
  RITER = -1
  EITER = 0x0
  NAME = "main"
  ENAME = "main"
  BACKREFS = 0x100801f80
    SV = PVAV(0x100803c50) at 0x100801f80
      REFCNT = 2
      FLAGS = ()
      ARRAY = 0x1006068d0
      FILL = 38
      MAX = 61
      ARYLEN = 0x0
      FLAGS = ()
(gdb) call Perl_sv_dump(keysv)
SV = PV(0x1008030c0) at 0x100810410
  REFCNT = 1
  FLAGS = (POK,FAKE,READONLY,pPOK)
  PV = 0x100601b60 "a"
  CUR = 1
  LEN = 0
(gdb) s
351         if (!hv)
(gdb) 
353         if (SvTYPE(hv) == (svtype)SVTYPEMASK)
(gdb) 
356         assert(SvTYPE(hv) == SVt_PVHV);
(gdb) 
358         if (SvSMAGICAL(hv) && SvGMAGICAL(hv) && !(action & HV_DISABLE_UVAR_XKEY)) {
(gdb) 
383         if (keysv) {
(gdb) 
384             if (flags & HVhek_FREEKEY)
(gdb) 
386             key = SvPV_const(keysv, klen);
(gdb) 
387             is_utf8 = (SvUTF8(keysv) != 0);
(gdb) 
388             if (SvIsCOW_shared_hash(keysv)) {
(gdb) 
389                 flags = HVhek_KEYCANONICAL | (is_utf8 ? HVhek_UTF8 : 0);
(gdb) 
390             } else {
(gdb) 
393         } else {
(gdb) 
397         if (action & HV_DELETE) {
(gdb) 
403         xhv = (XPVHV*)SvANY(hv);
(gdb) 
404         if (SvMAGICAL(hv)) {
(gdb) 
570         if (!HvARRAY(hv)) {
(gdb) c
Continuing.

Breakpoint 2, Perl_hv_common (hv=0x10080fb88, keysv=0x10080fb58, key=0x0, klen=0, flags=0, action=4, val=0x1004c3448, hash=0) at hv.c:349
349         const int return_svp = action & HV_FETCH_JUST_SV;
(gdb) call Perl_sv_dump(hv)
SV = PVHV(0x100807b40) at 0x10080fb88
  REFCNT = 1
  FLAGS = (TEMP,SHAREKEYS)
  ARRAY = 0x100606720  (0:7, 1:1)
  hash quality = 100.0%
  KEYS = 1
  FILL = 1
  MAX = 7
  RITER = -1
  EITER = 0x0
(gdb) c
Continuing.

Breakpoint 2, Perl_hv_common (hv=0x100801f20, keysv=0x100810428, key=0x0, klen=0, flags=0, action=0, val=0x0, hash=3392050242) at hv.c:349
349         const int return_svp = action & HV_FETCH_JUST_SV;
(gdb) call Perl_sv_dump(hv)
SV = PVHV(0x1008078a0) at 0x100801f20
  REFCNT = 2
  FLAGS = (RMG,OOK,SHAREKEYS)
  MAGIC = 0x100600e90
    MG_VIRTUAL = &PL_vtbl_ovrld
    MG_TYPE = PERL_MAGIC_overload_table(c)
    MG_LEN = 8
    MG_PTR = 0x100606490 "\0\2\0\0\7\0\0\0"
  ARRAY = 0x100606b40  (0:30, 1:28, 2:5, 3:1)
  hash quality = 116.9%
  KEYS = 41
  FILL = 34
  MAX = 63
  RITER = -1
  EITER = 0x0
  NAME = "main"
  ENAME = "main"
  BACKREFS = 0x100801f80
    SV = PVAV(0x100803c50) at 0x100801f80
      REFCNT = 2
      FLAGS = ()
      ARRAY = 0x1006068d0
      FILL = 40
      MAX = 61
      ARYLEN = 0x0
      FLAGS = ()
  MRO_WHICH = "dfs" (0x1004c10f0)
  CACHE_GEN = 0x1
  PKG_GEN = 0x1
  MRO_LINEAR_CURRENT = 0x10080fb40
    SV = PVAV(0x100803ea8) at 0x10080fb40
      REFCNT = 1
      FLAGS = (READONLY)
      ARRAY = 0x100601820
      FILL = 0
      MAX = 3
      ARYLEN = 0x0
      FLAGS = (REAL)
  ISA = 0x10080fb88
    SV = PVHV(0x100807b40) at 0x10080fb88
      REFCNT = 1
      FLAGS = (READONLY,SHAREKEYS)
      ARRAY = 0x100606720  (0:6, 1:2)
      hash quality = 125.0%
      KEYS = 2
      FILL = 2
      MAX = 7
      RITER = -1
      EITER = 0x0
(gdb) call Perl_sv_dump(keysv)
SV = PV(0x100803090) at 0x100810428
  REFCNT = 1
  FLAGS = (POK,FAKE,READONLY,pPOK)
  PV = 0x100601b60 "a"
  CUR = 1
  LEN = 0
(gdb) s
351         if (!hv)
(gdb) 
353         if (SvTYPE(hv) == (svtype)SVTYPEMASK)
(gdb) 
356         assert(SvTYPE(hv) == SVt_PVHV);
(gdb) 
358         if (SvSMAGICAL(hv) && SvGMAGICAL(hv) && !(action & HV_DISABLE_UVAR_XKEY)) {
(gdb) 
383         if (keysv) {
(gdb) 
384             if (flags & HVhek_FREEKEY)
(gdb) 
386             key = SvPV_const(keysv, klen);
(gdb) 
387             is_utf8 = (SvUTF8(keysv) != 0);
(gdb) 
388             if (SvIsCOW_shared_hash(keysv)) {
(gdb) 
389                 flags = HVhek_KEYCANONICAL | (is_utf8 ? HVhek_UTF8 : 0);
(gdb) 
390             } else {
(gdb) 
393         } else {
(gdb) 
397         if (action & HV_DELETE) {
(gdb) 
403         xhv = (XPVHV*)SvANY(hv);
(gdb) 
404         if (SvMAGICAL(hv)) {
(gdb) 
405             if (SvRMAGICAL(hv) && !(action & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS))) {
(gdb) 
406                 if (mg_find((const SV *)hv, PERL_MAGIC_tied)
(gdb) 
Perl_mg_find (sv=0x100801f20, type=80) at mg.c:425
425         return S_mg_findext_flags(aTHX_ sv, type, NULL, 0);
(gdb) 
S_mg_findext_flags (sv=0x100801f20, type=80, vtbl=0x0, flags=0) at mg.c:399
399         assert(flags <= 1);
(gdb) 
401         if (sv) {
(gdb) 
404             for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
(gdb) 
405                 if (mg->mg_type == type && (!flags || mg->mg_virtual == vtbl)) {
(gdb) 
408             }
(gdb) 
404             for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
(gdb) 
409         }
(gdb) 
411         return NULL;
(gdb) 
412     }
(gdb) 
0x000000010019d7ca in Perl_mg_find (sv=0x100801f20, type=80) at mg.c:425
425         return S_mg_findext_flags(aTHX_ sv, type, NULL, 0);
(gdb) 
Perl_hv_common (hv=0x100801f20, keysv=0x100810428, key=0x100601b60 "a", klen=1, flags=1024, action=0, val=0x0, hash=3392050242) at hv.c:480
480             } /* ISFETCH */
(gdb) 
568         } /* SvMAGICAL */
(gdb) 
570         if (!HvARRAY(hv)) {
(gdb) 
598         if (is_utf8 & !(flags & HVhek_KEYCANONICAL)) {
(gdb) 

Nicholas Clark


Thread Previous | 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