This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
e5b7788d30cf5bda967b3b21aed668a25d87c296
[perl5.git] / ext / Devel / DProf / DProf.xs
1 /* XXX DProf could use some cleanups for PERL_IMPLICIT_CONTEXT */
2
3 #define PERL_POLLUTE
4
5 #include "EXTERN.h"
6 #include "perl.h"
7 #include "XSUB.h"
8
9 /* For older Perls */
10 #ifndef dTHR
11 #  define dTHR int dummy_thr
12 #endif  /* dTHR */ 
13
14 /*#define DBG_SUB 1      */
15 /*#define DBG_TIMER 1    */
16
17 #ifdef DBG_SUB
18 #  define DBG_SUB_NOTIFY(A,B) warn( A, B )
19 #else
20 #  define DBG_SUB_NOTIFY(A,B)  /* nothing */
21 #endif
22
23 #ifdef DBG_TIMER
24 #  define DBG_TIMER_NOTIFY(A) warn( A )
25 #else
26 #  define DBG_TIMER_NOTIFY(A)  /* nothing */
27 #endif
28
29 static U32 dprof_ticks;
30
31 /* HZ == clock ticks per second */
32 #ifdef VMS
33 #  define HZ ((I32)CLK_TCK)
34 #  define DPROF_HZ HZ
35 #  include <starlet.h>  /* prototype for sys$gettim() */
36    clock_t dprof_times(struct tms *bufptr) {
37         clock_t retval;
38         dTHX;
39         /* Get wall time and convert to 10 ms intervals to
40          * produce the return value dprof expects */
41 #  if defined(__DECC) && defined (__ALPHA)
42 #    include <ints.h>
43         uint64 vmstime;
44         _ckvmssts(sys$gettim(&vmstime));
45         vmstime /= 100000;
46         retval = vmstime & 0x7fffffff;
47 #  else
48         /* (Older hw or ccs don't have an atomic 64-bit type, so we
49          * juggle 32-bit ints (and a float) to produce a time_t result
50          * with minimal loss of information.) */
51         long int vmstime[2],remainder,divisor = 100000;
52         _ckvmssts(sys$gettim((unsigned long int *)vmstime));
53         vmstime[1] &= 0x7fff;  /* prevent overflow in EDIV */
54         _ckvmssts(lib$ediv(&divisor,vmstime,(long int *)&retval,&remainder));
55 #  endif
56         /* Fill in the struct tms using the CRTL routine . . .*/
57         times((tbuffer_t *)bufptr);
58         return (clock_t) retval;
59    }
60 #  define Times(ptr) (dprof_times(ptr))
61 #else
62 #  ifndef HZ
63 #    ifdef CLK_TCK
64 #      define HZ ((I32)CLK_TCK)
65 #    else
66 #      define HZ 60
67 #    endif
68 #  endif
69 #  ifdef OS2                            /* times() has significant overhead */
70 #    define Times(ptr) (dprof_times(ptr))
71 #    define INCL_DOSPROFILE
72 #    define INCL_DOSERRORS
73 #    include <os2.h>
74 #    define toLongLong(arg) (*(long long*)&(arg))
75 #    define DPROF_HZ dprof_ticks
76
77 static ULONG frequ;
78 static long long start_cnt;
79 clock_t
80 dprof_times(struct tms *t)
81 {
82     ULONG rc;
83     QWORD cnt;
84     
85     if (!frequ) {
86         if (CheckOSError(DosTmrQueryFreq(&frequ)))
87             croak("DosTmrQueryFreq: %s", SvPV(perl_get_sv("!",TRUE),na));
88         else
89             frequ = frequ/DPROF_HZ;     /* count per tick */
90         if (CheckOSError(DosTmrQueryTime(&cnt)))
91             croak("DosTmrQueryTime: %s",
92                   SvPV(perl_get_sv("!",TRUE),na));
93         start_cnt = toLongLong(cnt);
94     }
95
96     if (CheckOSError(DosTmrQueryTime(&cnt)))
97             croak("DosTmrQueryTime: %s", SvPV(perl_get_sv("!",TRUE),na));
98     t->tms_stime = 0;
99     return (t->tms_utime = (toLongLong(cnt) - start_cnt)/frequ);
100 }
101 #  else
102 #    define Times(ptr) (times(ptr))
103 #    define DPROF_HZ HZ
104 #  endif 
105 #endif
106
107 XS(XS_Devel__DProf_END);        /* used by prof_mark() */
108
109 static SV * Sub;        /* pointer to $DB::sub */
110 static PerlIO *fp;      /* pointer to tmon.out file */
111
112 /* Added -JH */
113 static long TIMES_LOCATION=42;/* Where in the file to store the time totals */
114 static int SAVE_STACK = 1<<14;          /* How much data to buffer until */
115                                         /* end of run */
116
117 static int prof_pid;    /* pid of profiled process */
118
119 /* Everything is built on times(2).  See its manpage for a description
120  * of the timings.
121  */
122
123 static
124 struct tms      prof_start,
125                 prof_end;
126
127 static
128 clock_t         rprof_start, /* elapsed real time, in ticks */
129                 rprof_end,
130                 wprof_u, wprof_s, wprof_r;
131
132 union prof_any {
133         clock_t tms_utime;  /* cpu time spent in user space */
134         clock_t tms_stime;  /* cpu time spent in system */
135         clock_t realtime;   /* elapsed real time, in ticks */
136         char *name;
137         U32 id;
138         opcode ptype;
139 };
140
141 typedef union prof_any PROFANY;
142
143 static PROFANY  *profstack;
144 static int      profstack_max = 128;
145 static int      profstack_ix = 0;
146
147 static void
148 prof_dump(opcode ptype, char *name)
149 {
150     if(ptype == OP_LEAVESUB){
151         PerlIO_printf(fp,"- & %s\n", name );
152     } else if(ptype == OP_ENTERSUB) {
153         PerlIO_printf(fp,"+ & %s\n", name );
154     } else if(ptype == OP_DIE) {
155         PerlIO_printf(fp,"/ & %s\n", name );
156     } else {
157         PerlIO_printf(fp,"Profiler unknown prof code %d\n", ptype);
158     }
159     safefree(name);
160 }   
161
162 static void
163 prof_dumpa(opcode ptype, U32 id)
164 {
165     if(ptype == OP_LEAVESUB){
166         PerlIO_printf(fp,"- %lx\n", id );
167     } else if(ptype == OP_ENTERSUB) {
168         PerlIO_printf(fp,"+ %lx\n", id );
169     } else if(ptype == OP_GOTO) {
170         PerlIO_printf(fp,"* %lx\n", id );
171     } else if(ptype == OP_DIE) {
172         PerlIO_printf(fp,"/ %lx\n", id );
173     } else {
174         PerlIO_printf(fp,"Profiler unknown prof code %d\n", ptype);
175     }
176 }   
177
178 static void
179 prof_dumps(U32 id, char *pname, char *gname)
180 {
181     PerlIO_printf(fp,"& %lx %s %s\n", id, pname, gname);
182 }   
183
184 static clock_t otms_utime, otms_stime, orealtime;
185
186 static void
187 prof_dumpt(long tms_utime, long tms_stime, long realtime)
188 {
189     PerlIO_printf(fp,"@ %ld %ld %ld\n", tms_utime, tms_stime, realtime);
190 }   
191
192 static void
193 prof_dump_until(long ix)
194 {
195     long base = 0;
196     struct tms t1, t2;
197     clock_t realtime1, realtime2;
198
199     realtime1 = Times(&t1);
200
201     while( base < ix ){
202         opcode ptype = profstack[base++].ptype;
203         if (ptype == OP_TIME) {
204             long tms_utime = profstack[base++].tms_utime;
205             long tms_stime = profstack[base++].tms_stime;
206             long realtime = profstack[base++].realtime;
207
208             prof_dumpt(tms_utime, tms_stime, realtime);
209         } else if (ptype == OP_GV) {
210             U32 id = profstack[base++].id;
211             char *pname = profstack[base++].name;
212             char *gname = profstack[base++].name;
213
214             prof_dumps(id, pname, gname);
215         } else {
216 #ifdef PERLDBf_NONAME
217             U32 id = profstack[base++].id;
218             prof_dumpa(ptype, id);
219 #else
220             char *name = profstack[base++].name;
221             prof_dump(ptype, name);
222 #endif 
223         }
224     }
225     PerlIO_flush(fp);
226     realtime2 = Times(&t2);
227     if (realtime2 != realtime1 || t1.tms_utime != t2.tms_utime
228         || t1.tms_stime != t2.tms_stime) {
229         wprof_r += realtime2 - realtime1;
230         wprof_u += t2.tms_utime - t1.tms_utime;
231         wprof_s += t2.tms_stime - t1.tms_stime;
232
233         PerlIO_printf(fp,"+ & Devel::DProf::write\n" );
234         PerlIO_printf(fp,"@ %ld %ld %ld\n", 
235                 t2.tms_utime - t1.tms_utime, t2.tms_stime - t1.tms_stime, 
236                 realtime2 - realtime1);
237         PerlIO_printf(fp,"- & Devel::DProf::write\n" );
238         otms_utime = t2.tms_utime;
239         otms_stime = t2.tms_stime;
240         orealtime = realtime2;
241         PerlIO_flush(fp);
242     }
243 }
244
245 static HV* cv_hash;
246 static U32 total = 0;
247
248 static void
249 prof_mark( opcode ptype )
250 {
251         struct tms t;
252         clock_t realtime, rdelta, udelta, sdelta;
253         char *name, *pv;
254         char *hvname;
255         STRLEN len;
256         SV *sv;
257         U32 id;
258
259         if( SAVE_STACK ){
260                 if( profstack_ix + 5 > profstack_max ){
261                         profstack_max = profstack_max * 3 / 2;
262                         Renew( profstack, profstack_max, PROFANY );
263                 }
264         }
265
266         realtime = Times(&t);
267         rdelta = realtime - orealtime;
268         udelta = t.tms_utime - otms_utime;
269         sdelta = t.tms_stime - otms_stime;
270         if (rdelta || udelta || sdelta) {
271             if (SAVE_STACK) {
272                 profstack[profstack_ix++].ptype = OP_TIME;
273                 profstack[profstack_ix++].tms_utime = udelta;
274                 profstack[profstack_ix++].tms_stime = sdelta;
275                 profstack[profstack_ix++].realtime = rdelta;
276             } else { /* Write it to disk now so's not to eat up core */
277                 if (prof_pid == (int)getpid()) {
278                     prof_dumpt(udelta, sdelta, rdelta);
279                     PerlIO_flush(fp);
280                 }
281             }
282             orealtime = realtime;
283             otms_stime = t.tms_stime;
284             otms_utime = t.tms_utime;
285         }
286
287 #ifdef PERLDBf_NONAME
288         {
289             dTHX;
290             SV **svp;
291             char *gname, *pname;
292             static U32 lastid;
293             CV *cv;
294
295             cv = (CV*)SvIVX(Sub);
296             svp = hv_fetch(cv_hash, (char*)&cv, sizeof(CV*), TRUE);
297             if (!SvOK(*svp)) {
298                 GV *gv = CvGV(cv);
299                     
300                 sv_setiv(*svp, id = ++lastid);
301                 pname = ((GvSTASH(gv) && HvNAME(GvSTASH(gv))) 
302                          ? HvNAME(GvSTASH(gv)) 
303                          : "(null)");
304                 gname = GvNAME(gv);
305                 if (CvXSUB(cv) == XS_Devel__DProf_END)
306                     return;
307                 if (SAVE_STACK) { /* Store it for later recording  -JH */
308                     profstack[profstack_ix++].ptype = OP_GV;
309                     profstack[profstack_ix++].id = id;
310                     profstack[profstack_ix++].name = pname;
311                     profstack[profstack_ix++].name = gname;
312                 } else { /* Write it to disk now so's not to eat up core */
313
314                     /* Only record the parent's info */
315                     if (prof_pid == (int)getpid()) {
316                         prof_dumps(id, pname, gname);
317                         PerlIO_flush(fp);
318                     } else
319                         perldb = 0;             /* Do not debug the kid. */
320                 }
321             } else {
322                 id = SvIV(*svp);
323             }
324         }
325 #else
326         pv = SvPV( Sub, len );
327
328         if( SvROK(Sub) ){
329                 /* Attempt to make CODE refs slightly identifiable by
330                  * including their package name.
331                  */
332                 sv = (SV*)SvRV(Sub);
333                 if( sv && SvTYPE(sv) == SVt_PVCV ){
334                         if( CvSTASH(sv) ){
335                                 hvname = HvNAME(CvSTASH(sv));
336                         }
337                         else if( CvXSUB(sv) == &XS_Devel__DProf_END ){
338                                 /*warn( "prof_mark() found dprof::end");*/
339                                 return; /* don't profile Devel::DProf::END */
340                         }
341                         else{
342                     croak( "DProf prof_mark() lost on CODE ref %s\n", pv );
343                         }
344                         len += strlen( hvname ) + 2;  /* +2 for ::'s */
345
346                 }
347                 else{
348         croak( "DProf prof_mark() lost on supposed CODE ref %s.\n", pv );
349                 }
350                 name = (char *)safemalloc( len * sizeof(char) + 1 );
351                 strcpy( name, hvname );
352                 strcat( name, "::" );
353                 strcat( name, pv );
354         }
355         else{
356                 if( *(pv+len-1) == 'D' ){
357                         /* It could be an &AUTOLOAD. */
358
359                         /* I measured a bunch of *.pl and *.pm (from Perl
360                          * distribution and other misc things) and found
361                          * 780 fully-qualified names.  They averaged
362                          * about 19 chars each.  Only 1 of those names
363                          * ended with 'D' and wasn't an &AUTOLOAD--it
364                          * was &overload::OVERLOAD.
365                          *    --dmr 2/19/96
366                          */
367
368                         if( strcmp( pv+len-9, ":AUTOLOAD" ) == 0 ){
369                                 /* The sub name is in $AUTOLOAD */
370                                 sv = perl_get_sv( pv, 0 );
371                                 if( sv == NULL ){
372                 croak("DProf prof_mark() lost on AUTOLOAD (%s).\n", pv );
373                                 }
374                                 pv = SvPV( sv, na );
375                                 DBG_SUB_NOTIFY( "  AUTOLOAD(%s)\n", pv );
376                         }
377                 }
378                 name = savepv( pv );
379         }
380 #endif /* PERLDBf_NONAME */
381
382         total++;
383         if (SAVE_STACK) { /* Store it for later recording  -JH */
384             profstack[profstack_ix++].ptype = ptype;
385 #ifdef PERLDBf_NONAME
386             profstack[profstack_ix++].id = id;
387 #else
388             profstack[profstack_ix++].name = name;
389 #endif 
390             /* Only record the parent's info */
391             if (SAVE_STACK < profstack_ix) {
392                 if (prof_pid == (int)getpid())
393                     prof_dump_until(profstack_ix);
394                 else
395                     perldb = 0;         /* Do not debug the kid. */
396                 profstack_ix = 0;
397             }
398         } else { /* Write it to disk now so's not to eat up core */
399
400             /* Only record the parent's info */
401             if (prof_pid == (int)getpid()) {
402 #ifdef PERLDBf_NONAME
403                 prof_dumpa(ptype, id);
404 #else
405                 prof_dump(ptype, name);
406 #endif 
407                 PerlIO_flush(fp);
408             } else
409                 perldb = 0;             /* Do not debug the kid. */
410         }
411 }
412
413 static U32 default_perldb;
414
415 #ifdef PL_NEEDED
416 #  define defstash PL_defstash
417 #endif
418
419 /* Counts overhead of prof_mark and extra XS call. */
420 static void
421 test_time(clock_t *r, clock_t *u, clock_t *s)
422 {
423     dTHR;
424     dTHX;
425     CV *cv = perl_get_cv("Devel::DProf::NONESUCH_noxs", FALSE);
426     int i, j, k = 0;
427     HV *oldstash = curstash;
428     struct tms t1, t2;
429     clock_t realtime1, realtime2;
430     U32 ototal = total;
431     U32 ostack = SAVE_STACK;
432     U32 operldb = perldb;
433
434     SAVE_STACK = 1000000;
435     realtime1 = Times(&t1);
436     
437     while (k < 2) {
438         i = 0;
439             /* Disable debugging of perl_call_sv on second pass: */
440         curstash = (k == 0 ? defstash : debstash);
441         perldb = default_perldb;
442         while (++i <= 100) {
443             j = 0;
444             profstack_ix = 0;           /* Do not let the stack grow */
445             while (++j <= 100) {
446 /*              prof_mark( OP_ENTERSUB ); */
447
448                 PUSHMARK( stack_sp );
449                 perl_call_sv( (SV*)cv, G_SCALAR );
450                 stack_sp--;
451 /*              prof_mark( OP_LEAVESUB ); */
452             }
453         }
454         curstash = oldstash;
455         if (k == 0) {                   /* Put time with debugging */
456             realtime2 = Times(&t2);
457             *r = realtime2 - realtime1;
458             *u = t2.tms_utime - t1.tms_utime;
459             *s = t2.tms_stime - t1.tms_stime;
460         } else {                        /* Subtract time without debug */
461             realtime1 = Times(&t1);
462             *r -= realtime1 - realtime2;
463             *u -= t1.tms_utime - t2.tms_utime;
464             *s -= t1.tms_stime - t2.tms_stime;      
465         }
466         k++;
467     }
468     total = ototal;
469     SAVE_STACK = ostack;
470     perldb = operldb;
471 }
472
473 static void
474 prof_recordheader()
475 {
476         clock_t r, u, s;
477
478         /* fp is opened in the BOOT section */
479         PerlIO_printf(fp, "#fOrTyTwO\n" );
480         PerlIO_printf(fp, "$hz=%d;\n", DPROF_HZ );
481         PerlIO_printf(fp, "$XS_VERSION='DProf %s';\n", XS_VERSION );
482         PerlIO_printf(fp, "# All values are given in HZ\n" );
483         test_time(&r, &u, &s);
484         PerlIO_printf(fp, "$over_utime=%ld; $over_stime=%ld; $over_rtime=%ld;\n",
485                 u, s, r);
486         PerlIO_printf(fp, "$over_tests=10000;\n");
487
488         TIMES_LOCATION = PerlIO_tell(fp);
489
490         /* Pad with whitespace. */
491         /* This should be enough even for very large numbers. */
492         PerlIO_printf(fp, "%*s\n", 240 , "");
493
494         PerlIO_printf(fp, "\n");
495         PerlIO_printf(fp, "PART2\n" );
496
497         PerlIO_flush(fp);
498 }
499
500 static void
501 prof_record()
502 {
503         /* fp is opened in the BOOT section */
504
505         /* Now that we know the runtimes, fill them in at the recorded
506            location -JH */
507
508         clock_t r, u, s;
509     
510         if(SAVE_STACK){
511             prof_dump_until(profstack_ix);
512         }
513         PerlIO_seek(fp, TIMES_LOCATION, SEEK_SET);
514         /* Write into reserved 240 bytes: */
515         PerlIO_printf(fp, "$rrun_utime=%ld; $rrun_stime=%ld; $rrun_rtime=%ld;",
516                 prof_end.tms_utime - prof_start.tms_utime - wprof_u,
517                 prof_end.tms_stime - prof_start.tms_stime - wprof_s,
518                 rprof_end - rprof_start - wprof_r );
519         PerlIO_printf(fp, "\n$total_marks=%ld;", total);
520         
521         PerlIO_close( fp );
522 }
523
524 #define NONESUCH()
525
526 static U32 depth = 0;
527
528 static void
529 check_depth(pTHX_ void *foo)
530 {
531     U32 need_depth = (U32)foo;
532     if (need_depth != depth) {
533         if (need_depth > depth) {
534             warn("garbled call depth when profiling");
535         } else {
536             I32 marks = depth - need_depth;
537
538 /*          warn("Check_depth: got %d, expected %d\n", depth, need_depth); */
539             while (marks--) {
540                 prof_mark( OP_DIE );
541             }
542             depth = need_depth;
543         }
544     }
545 }
546
547 #define for_real
548 #ifdef for_real
549
550 XS(XS_DB_sub)
551 {
552         dXSARGS;
553         dORIGMARK;
554         HV *oldstash = curstash;
555
556         SP -= items;
557
558         DBG_SUB_NOTIFY( "XS DBsub(%s)\n", SvPV(Sub, na) );
559
560 #ifndef PERLDBf_NONAME                  /* Was needed on older Perls */
561         sv_setiv( DBsingle, 0 ); /* disable DB single-stepping */
562 #endif 
563
564         SAVEDESTRUCTOR(check_depth, (void*)depth);
565         depth++;
566
567         prof_mark( OP_ENTERSUB );
568         PUSHMARK( ORIGMARK );
569
570 #ifdef G_NODEBUG
571         perl_call_sv( (SV*)SvIV(Sub), GIMME | G_NODEBUG);
572 #else
573         curstash = debstash;    /* To disable debugging of perl_call_sv */
574 #ifdef PERLDBf_NONAME
575         perl_call_sv( (SV*)SvIV(Sub), GIMME );
576 #else
577         perl_call_sv( Sub, GIMME );
578 #endif 
579         curstash = oldstash;
580 #endif 
581
582         prof_mark( OP_LEAVESUB );
583         depth--;
584
585         SPAGAIN;
586         PUTBACK;
587         return;
588 }
589
590 XS(XS_DB_goto)
591 {
592         prof_mark( OP_GOTO );
593         return;
594 }
595
596 #endif /* for_real */
597
598 #ifdef testing
599
600         MODULE = Devel::DProf           PACKAGE = DB
601
602         void
603         sub(...)
604                 PPCODE:
605
606                 dORIGMARK;
607                 HV *oldstash = curstash;
608                 /* SP -= items;  added by xsubpp */
609                 DBG_SUB_NOTIFY( "XS DBsub(%s)\n", SvPV(Sub, na) );
610
611                 sv_setiv( DBsingle, 0 ); /* disable DB single-stepping */
612
613                 prof_mark( OP_ENTERSUB );
614                 PUSHMARK( ORIGMARK );
615
616                 curstash = debstash;    /* To disable debugging of perl_call_sv
617 */
618                 perl_call_sv( Sub, GIMME );
619                 curstash = oldstash;
620
621                 prof_mark( OP_LEAVESUB );
622                 SPAGAIN;
623                 /* PUTBACK;  added by xsubpp */
624
625 #endif /* testing */
626
627 MODULE = Devel::DProf           PACKAGE = Devel::DProf
628
629 void
630 END()
631         PPCODE:
632         if( DBsub ){
633                 /* maybe the process forked--we want only
634                  * the parent's profile.
635                  */
636                 if( prof_pid == (int)getpid() ){
637                         rprof_end = Times(&prof_end);
638                         DBG_TIMER_NOTIFY("Profiler timer is off.\n");
639                         prof_record();
640                 }
641         }
642
643 void
644 NONESUCH()
645
646 BOOT:
647         /* Before we go anywhere make sure we were invoked
648          * properly, else we'll dump core.
649          */
650         if( ! DBsub )
651                 croak("DProf: run perl with -d to use DProf.\n");
652
653         /* When we hook up the XS DB::sub we'll be redefining
654          * the DB::sub from the PM file.  Turn off warnings
655          * while we do this.
656          */
657         {
658                 I32 warn_tmp = dowarn;
659                 dowarn = 0;
660                 newXS("DB::sub", XS_DB_sub, file);
661                 newXS("DB::goto", XS_DB_goto, file);
662                 dowarn = warn_tmp;
663         }
664
665         Sub = GvSV(DBsub);       /* name of current sub */
666         sv_setiv( DBsingle, 0 ); /* disable DB single-stepping */
667
668         {
669             char *buffer = getenv("PERL_DPROF_BUFFER");
670
671             if (buffer) {
672                 SAVE_STACK = atoi(buffer);
673             }
674
675             buffer = getenv("PERL_DPROF_TICKS");
676
677             if (buffer) {
678                 dprof_ticks = atoi(buffer); /* Used under OS/2 only */
679             } else {
680                 dprof_ticks = HZ;
681             }
682         }
683
684         if( (fp = PerlIO_open( "tmon.out", "w" )) == NULL )
685                 croak("DProf: unable to write tmon.out, errno = %d\n", errno );
686 #ifdef PERLDBf_NONAME
687         default_perldb = PERLDBf_NONAME | PERLDBf_SUB; /* no name needed. */
688 #ifdef PERLDBf_GOTO
689         default_perldb = default_perldb | PERLDBf_GOTO;
690 #endif 
691         cv_hash = newHV();
692 #else
693 #  ifdef PERLDBf_SUB
694         default_perldb = PERLDBf_SUB;           /* debug subroutines only. */
695 #  endif
696 #endif
697         prof_pid = (int)getpid();
698
699         New( 0, profstack, profstack_max, PROFANY );
700
701         prof_recordheader();
702
703         DBG_TIMER_NOTIFY("Profiler timer is on.\n");
704         orealtime = rprof_start = Times(&prof_start);
705         otms_utime = prof_start.tms_utime;
706         otms_stime = prof_start.tms_stime;
707         perldb = default_perldb;