From agrow@thegotonerd.com

Devel​::DProf should be calling getrusage(2) and gettimeofday(2) instead of
times(3) on BSD systems. On BSDs, the statistics clock used by times(3) runs at
128 Hz and as such is useless / inaccurate for sub-ms profiling. OTOH, the
clock used by getrusage(2) is a 1 MHz clock.

Please have a look at the attached patch to DProf.xs.

This change was discussed quite a while back but no patch came forth​:
http​://www.nntp.perl.org/group/perl.perl5.porters/2000/12/msg26904.html.

--
Alan Grow

From agrow@thegotonerd.com

Flags​:
  category=core
  severity=medium

Site configuration information for perl v5.8.8​:

Summary of my perl5 (revision 5 version 8 subversion 8) configuration​:
  Platform​:
  osname=freebsd, osvers=7.0-current, archname=i386-freebsd-64int
  uname='freebsd scalar 7.0-current freebsd i386 '
  config_args='-sde -Dprefix=/usr/local -Darchlib=/usr/local/lib/perl5/5.8.8/mach -Dprivlib=/usr/local/lib/perl5/5.8.8 -Dman3dir=/usr/local/lib/perl5/5.8.8/perl/man/man3 -Dman1dir=/usr/local/man/man1 -Dsitearch=/usr/local/lib/perl5/site_perl/5.8.8/mach -Dsitelib=/usr/local/lib/perl5/site_perl/5.8.8 -Dscriptdir=/usr/local/bin -Dsiteman3dir=/usr/local/lib/perl5/5.8.8/man/man3 -Dsiteman1dir=/usr/local/man/man1 -Ui_malloc -Ui_iconv -Uinstallusrbinperl -Dcc=cc -Duseshrplib -Dccflags=-DAPPLLIB_EXP="/usr/local/lib/perl5/5.8.8/BSDPAN" -Doptimize=-O -pipe -Ud_dosuid -Ui_gdbm -Dusethreads=n -Dusemymalloc=y -Duse64bitint'
  hint=recommended, useposix=true, d_sigaction=define
  usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
  useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
  use64bitint=define use64bitall=undef uselongdouble=undef
  usemymalloc=y, bincompat5005=undef
  Compiler​:
  cc='cc', ccflags ='-DAPPLLIB_EXP="/usr/local/lib/perl5/5.8.8/BSDPAN" -DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -fno-strict-aliasing -pipe -Wdeclaration-after-statement -I/usr/local/include',
  optimize='-O -pipe ',
  cppflags='-DAPPLLIB_EXP="/usr/local/lib/perl5/5.8.8/BSDPAN" -DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -fno-strict-aliasing -pipe -Wdeclaration-after-statement -I/usr/local/include'
  ccversion='', gccversion='4.2.0', gccosandvers=''
  intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=12345678
  d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
  ivtype='long long', ivsize=8, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
  alignbytes=4, prototype=define
  Linker and Libraries​:
  ld='cc', ldflags =' -Wl,-E -L/usr/local/lib'
  libpth=/usr/lib /usr/local/lib
  libs=-lgdbm -lm -lcrypt -lutil
  perllibs=-lm -lcrypt -lutil
  libc=, so=so, useshrplib=true, libperl=libperl.so
  gnulibc_version=''
  Dynamic Linking​:
  dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' -Wl,-R/usr/local/lib/perl5/5.8.8/mach/CORE'
  cccdlflags='-DPIC -fPIC', lddlflags='-shared -L/usr/local/lib'

Locally applied patches​:
  defined-or

@​INC for perl v5.8.8​:
  /usr/local/lib/perl5/5.8.8/BSDPAN
  /usr/local/lib/perl5/site_perl/5.8.8/mach
  /usr/local/lib/perl5/site_perl/5.8.8
  /usr/local/lib/perl5/site_perl
  /usr/local/lib/perl5/5.8.8/mach
  /usr/local/lib/perl5/5.8.8

Environment for perl v5.8.8​:
  LANG (unset)
  LANGUAGE (unset)
  LD_LIBRARY_PATH (unset)
  LOGDIR (unset)
  PATH=/sbin​:/bin​:/usr/sbin​:/usr/bin​:/usr/games​:/usr/local/sbin​:/usr/local/bin
  PERL_BADLANG (unset)
  SHELL=/usr/local/bin/bash

From agrow@thegotonerd.com

--- DProf.xs.orig	2007-08-02 16:57:34.000000000 -0400
+++ DProf.xs	2007-08-02 16:54:09.000000000 -0400
@@ -69,25 +69,32 @@
 #  define Times(ptr) (dprof_times(aTHX_ ptr))
 #  define NEEDS_DPROF_TIMES
 #else
-#  ifndef HZ
-#    ifdef CLK_TCK
-#      define HZ ((I32)CLK_TCK)
-#    else
-#      define HZ 60
-#    endif
-#  endif
-#  ifdef OS2				/* times() has significant overhead */
+#  ifdef BSDish
 #    define Times(ptr) (dprof_times(aTHX_ ptr))
 #    define NEEDS_DPROF_TIMES
-#    define INCL_DOSPROFILE
-#    define INCL_DOSERRORS
-#    include <os2.h>
-#    define toLongLong(arg) (*(long long*)&(arg))
-#    define DPROF_HZ g_dprof_ticks
-#  else
-#    define Times(ptr) (times(ptr))
+#    define HZ 1000000
 #    define DPROF_HZ HZ
-#  endif 
+#  else
+#    ifndef HZ
+#      ifdef CLK_TCK
+#        define HZ ((I32)CLK_TCK)
+#      else
+#        define HZ 60
+#      endif
+#    endif
+#    ifdef OS2				/* times() has significant overhead */
+#      define Times(ptr) (dprof_times(aTHX_ ptr))
+#      define NEEDS_DPROF_TIMES
+#      define INCL_DOSPROFILE
+#      define INCL_DOSERRORS
+#      include <os2.h>
+#      define toLongLong(arg) (*(long long*)&(arg))
+#      define DPROF_HZ g_dprof_ticks
+#    else
+#      define Times(ptr) (times(ptr))
+#      define DPROF_HZ HZ
+#    endif 
+#  endif
 #endif
 
 XS(XS_Devel__DProf_END);        /* used by prof_mark() */
@@ -224,7 +231,33 @@
     times((tbuffer_t *)t);
     return (clock_t) retval;
 #  else		/* !VMS && !OS2 */
+#    ifdef BSDish
+#      include <sys/resource.h>
+    struct rusage ru;
+    struct timeval tv;
+    /* Measure offset from start time to avoid overflow  */
+    static struct timeval tv0 = { 0, 0 };
+
+    if (!tv0.tv_sec)
+        if (gettimeofday(&tv0, NULL) < 0)
+            croak("gettimeofday: %s", SvPV_nolen_const(perl_get_sv("!",TRUE)));
+    
+    if (getrusage(0, &ru) < 0)
+        croak("getrusage: %s", SvPV_nolen_const(perl_get_sv("!",TRUE)));
+
+    if (gettimeofday(&tv, NULL) < 0)
+        croak("gettimeofday: %s", SvPV_nolen_const(perl_get_sv("!",TRUE)));
+
+    t->tms_stime = DPROF_HZ * ru.ru_stime.tv_sec + ru.ru_stime.tv_usec;
+    t->tms_utime = DPROF_HZ * ru.ru_utime.tv_sec + ru.ru_utime.tv_usec;
+
+    if (tv.tv_usec < tv0.tv_usec)
+        tv.tv_sec--, tv.tv_usec += DPROF_HZ;
+
+    return DPROF_HZ * (tv.tv_sec - tv0.tv_sec) + tv.tv_usec - tv0.tv_usec;
+#    else  /* !VMS && !OS2 && !BSD! */
     return times(t);
+#    endif
 #  endif
 #endif
 }

From ams@toroid.org

At 2007-08-02 15​:36​:42 -0700, perlbug-followup@​perl.org wrote​:

Please have a look at the attached patch to DProf.xs.

The patch looks reasonable enough, but the "BSDish" define covers a wide
range of systems. That worries me, especially given Jarkko's portability
concerns in the earlier thread you refer to.

I applied it anyway (#31677), so we can get some testing, but it may not
be appropriate for 5.10.

-- ams

The RT System itself - Status changed from 'new' to 'open'

p5p@spam.wizbit.be - Status changed from 'open' to 'resolved'