TCL Talks

#!/usr/bin/tclsh
#
# A wrapper around cg_annotate that sets appropriate command-line options
# and rearranges the output so that annotated files occur in a consistent
# sorted order.
#

set in [open "|cg_annotate --show=Ir --auto=yes --context=40 $argv" r]
set dest !
set out(!) {}
while {![eof $in]} {
  set line [string map {\t {        }} [gets $in]]
  if {[regexp {^-- Auto-annotated source: (.*)} $line all name]} {
    set dest $name
  } elseif {[regexp {^-- line \d+ ------} $line]} {
    set line [lreplace $line 2 2 {#}]
  } elseif {[regexp {^The following files chosen for } $line]} {
    set dest !
  }
  append out($dest) $line\n
}
foreach x [lsort [array names out]] {
  puts $out($x)
}

<h3>Amalgation vs. Separate Files</h3>
<table>
<thead>
<tr><th>Build<th>CPU Cycles<th>Performance
</thead>
<tbody>
<tr><td>Separate -Os<td>1532.966911<td>baseline
<tr><td>Separate -O6<td>1522.189222<td>-0.7%
<tr><td>Amalgamation -Os<td>1459.618198<td>-4.8%
<tr><td>Amalgamation -O6<td>1430.548506<td>-6.7%
</tbody>
</table>
</section>

<section>

<li> Make code changes
<li> Test, test, test....
<li> Goto 1
</ol>
</section>

<section>
  <section>
  <h2>Running The Workload</h2>
  <pre>

  rm -f cachegrind.out.*
  make clean tclsh
  valgrind --tool=cachegrind ./tclsh workload.tcl
  cg_anno.tcl cachegrind.out.* >cout-current.txt
  fossil test-diff --tk cout-baseline.tcl cout-current.txt &

  </pre>
  </section>

  <section>
  <h2><a href='./cg_anno.txt' target='_blank'>cg_anno.tcl</a></h2>
  <pre>
 #!/usr/bin/tclsh





 set in [open "|cg_annotate --show=Ir --auto=yes $argv" r]
 set dest !
 set out(!) {}
 while {![eof $in]} {
   set line [gets $in]
   set line [string map {\t {        }} [gets $in]]
   if {[regexp {^-- Auto-annotated source: (.*)} $line all nm]} {
     set dest $nm
   } elseif {[regexp {^-- line \d+ ------} $line]} {
     set line [lreplace $line 2 2 {#}]
   } elseif {[regexp {^The following files chosen for } $line]} {
     set dest !
   }
   append out($dest) $line\n
 }
 foreach x [lsort [array names out]] {
   puts $out($x)
 }

  </pre>
  </section>
</section>

<section>
<p>
<a href='https://www.sqlite.org/src/info/618d8dd4ff4' target='_blank'>
https://www.sqlite.org/src/info/618d8dd4ff4</a></p>
<pre>

 514,274  const int bMmapOk = (pgno<font color='red'>!=</font>1 && USEFETCH(pPager)

</pre>
</section>

<section>
<h2>Cachegrind Output</h2>
<pre>




 262,402,580  PROGRAM TOTALS

 --------------------------------------------------------------


  49,838,612  /tmp/generic/tclExecute.c:TEBCresume
  32,018,100  /tmp/generic/tclNamesp.c:TclGetNamespaceForQualNam
  26,221,282  /tmp/generic/tclVar.c:TclObjLookupVarEx
  24,875,355  /tmp/generic/tclVar.c:ObjFindNamespaceVar
  24,844,452  /tmp/generic/tclHash.c:CreateHashEntry
  21,851,978  /tmp/generic/tclVar.c:TclLookupSimpleVar
   8,220,562  /tmp/generic/tclObj.c:TclHashObjKey
   7,623,937  /tmp/generic/tclVar.c:TclPtrSetVar
  <font color='red'> 6,500,844  /tmp/generic/tclVar.c:CompareVarKeys</font>
   6,169,552  pthread_getspecific.c:pthread_getspecific
   5,403,119  /tmp/generic/tclUtil.c:Tcl_DStringFree
   4,369,586  /tmp/generic/tclVar.c:FreeParsedVarName
   3,741,590  /tmp/generic/tclThreadAlloc.c:TclpAlloc
   3,682,721  /tmp/generic/tclEncoding.c:UtfToUtfProc.isra.0
  
</pre>
</section>

<section>
  <section>
  <pre>
  
          .  static int CompareVarKeys(

          .      void *keyPtr, 
          .      Tcl_HashEntry *hPtr)
  2,016,738  {
          .      Tcl_Obj *objPtr1 = keyPtr;
    336,123      Tcl_Obj *objPtr2 = hPtr->key.objPtr;
          .      register const char *p1, *p2;
          .      register int l1, l2;

  <section>
  <h3>CPU Registers</h3>
  <p><img src='registers.jpg' class='plain'></img></p>
  </section>

  <section>
  <h3>Registers must push to stack if...</h3>
  <ul>
  <li> Many registers needed &mdash; complex function
  <li> Subroutines called, except tail recursion
  </ul>
  </section>
</section>

<section>
  <section>
  <pre>

        .  static int CompareVarKeys(

        .      void *keyPtr,
        .      Tcl_HashEntry *hPtr)
        .  {
        .      Tcl_Obj *objPtr1 = keyPtr;
  336,123      Tcl_Obj *objPtr2 = hPtr->key.objPtr;
  672,246      if (objPtr1 == objPtr2) {
        .          return 1;

   90,126      const char *p1 = TclGetString(objPtr1);
   30,042      int l1 = objPtr1->length;
   90,126      const char *p2 = TclGetString(objPtr2);
        .      int l2 = objPtr2->length;
  270,378      return ((l1 == l2) && !memcmp(p1, p2, l1));
  120,168  }

  </pre>
  </section>

  <section>
  <h2>TCL_NOINLINE</h2>
  <pre>

  #if defined(__GNUC__)
  #  define TCL_NOINLINE  __attribute__((noinline))
  #elif defined(_MSC_VER) && _MSC_VER>=1310
  #  define TCL_NOINLINE  __declspec(noinline)
  #else
  #  define TCL_NOINLINE
  #endif

  </pre>
  <p>Currently on branch
  <a href='https://core.tcl.tk/tcl/timeline?r=mig-opt2' target='_blank'>mig-opt2</a>.
  Not yet on trunk</p>
  </section>
</section>

<section>
<h2>End Result</h2>
<ul>
<li> Saved about 4M cycles out of 262M &rarr; 1.5% faster!
<li> This change is not checked in because Miguel found a better
     way to fix the frequent calls to CompareVarKeys()
</ul>
</section>

<section>
<pre>




  2,021,099,349  PROGRAM TOTALS



  -----------------------------------------------------
  390,649,348  /tmp/generic/tclExecute.c:TEBCresume
  <font color='red'>150,647,394  ???:pthread_getspecific</font>
  123,209,668  /tmp/generic/tclHash.c:CreateHashEntry
  118,133,666  /tmp/generic/tclObj.c:TclHashObjKey
   74,396,324  /tmp/generic/tclVar.c:UnsetVarStruct
   73,162,765  /tmp/generic/tclThreadAlloc.c:TclpAlloc

11,578,728     return pthread_getspecific(key);
         2  }

</pre>
</section>

<section>
<h3><a href='https://core.tcl.tk/tcl/info/fdbf64dc501ff0a0' target='_blank'>
Check-in [fdbf64dc50]</a></h3>
<pre>

         .  void *
         .  TclpGetAllocCache(void)
         .  {
11,578,728      return pthread_getspecific(key);
         .  }