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