/* HZ == clock ticks per second */
#ifdef VMS
-# define HZ CLK_TCK
+# define HZ ((I32)CLK_TCK)
# define DPROF_HZ HZ
# include <starlet.h> /* prototype for sys$gettim() */
clock_t dprof_times(struct tms *bufptr) {
clock_t retval;
+ dTHX;
/* Get wall time and convert to 10 ms intervals to
* produce the return value dprof expects */
# if defined(__DECC) && defined (__ALPHA)
#else
# ifndef HZ
# ifdef CLK_TCK
-# define HZ CLK_TCK
+# define HZ ((I32)CLK_TCK)
# else
# define HZ 60
# endif
XS(XS_Devel__DProf_END); /* used by prof_mark() */
-static SV * Sub; /* pointer to $DB::sub */
static PerlIO *fp; /* pointer to tmon.out file */
/* Added -JH */
prof_dumpa(opcode ptype, U32 id)
{
if(ptype == OP_LEAVESUB){
- PerlIO_printf(fp,"- %lx\n", id );
+ PerlIO_printf(fp,"- %"UVxf"\n", (UV)id );
} else if(ptype == OP_ENTERSUB) {
- PerlIO_printf(fp,"+ %lx\n", id );
+ PerlIO_printf(fp,"+ %"UVxf"\n", (UV)id );
} else if(ptype == OP_GOTO) {
- PerlIO_printf(fp,"* %lx\n", id );
+ PerlIO_printf(fp,"* %"UVxf"\n", (UV)id );
} else if(ptype == OP_DIE) {
- PerlIO_printf(fp,"/ %lx\n", id );
+ PerlIO_printf(fp,"/ %"UVxf"\n", (UV)id );
} else {
PerlIO_printf(fp,"Profiler unknown prof code %d\n", ptype);
}
static void
prof_dumps(U32 id, char *pname, char *gname)
{
- PerlIO_printf(fp,"& %lx %s %s\n", id, pname, gname);
+ PerlIO_printf(fp,"& %"UVxf" %s %s\n", (UV)id, pname, gname);
}
static clock_t otms_utime, otms_stime, orealtime;
wprof_s += t2.tms_stime - t1.tms_stime;
PerlIO_printf(fp,"+ & Devel::DProf::write\n" );
- PerlIO_printf(fp,"@ %ld %ld %ld\n",
- t2.tms_utime - t1.tms_utime, t2.tms_stime - t1.tms_stime,
- realtime2 - realtime1);
+ PerlIO_printf(fp,"@ %"IVdf" %"IVdf" %"IVdf"\n",
+ /* The (IV) casts are one possibility:
+ * the Painfully Correct Way would be to
+ * have Clock_t_f. */
+ (IV)(t2.tms_utime - t1.tms_utime),
+ (IV)(t2.tms_stime - t1.tms_stime),
+ (IV)(realtime2 - realtime1));
PerlIO_printf(fp,"- & Devel::DProf::write\n" );
otms_utime = t2.tms_utime;
otms_stime = t2.tms_stime;
STRLEN len;
SV *sv;
U32 id;
+ SV *Sub = GvSV(DBsub); /* name of current sub */
if( SAVE_STACK ){
if( profstack_ix + 5 > profstack_max ){
static U32 lastid;
CV *cv;
- cv = (CV*)SvIVX(Sub);
+ cv = INT2PTR(CV*,SvIVX(Sub));
svp = hv_fetch(cv_hash, (char*)&cv, sizeof(CV*), TRUE);
if (!SvOK(*svp)) {
GV *gv = CvGV(cv);
}
static void
-prof_recordheader()
+prof_recordheader(void)
{
clock_t r, u, s;
/* fp is opened in the BOOT section */
PerlIO_printf(fp, "#fOrTyTwO\n" );
- PerlIO_printf(fp, "$hz=%d;\n", DPROF_HZ );
+ PerlIO_printf(fp, "$hz=%"IVdf";\n", (IV)DPROF_HZ );
PerlIO_printf(fp, "$XS_VERSION='DProf %s';\n", XS_VERSION );
PerlIO_printf(fp, "# All values are given in HZ\n" );
test_time(&r, &u, &s);
- PerlIO_printf(fp, "$over_utime=%ld; $over_stime=%ld; $over_rtime=%ld;\n",
- u, s, r);
+ PerlIO_printf(fp,
+ "$over_utime=%"IVdf"; $over_stime=%"IVdf"; $over_rtime=%"IVdf";\n",
+ /* The (IV) casts are one possibility:
+ * the Painfully Correct Way would be to
+ * have Clock_t_f. */
+ (IV)u, (IV)s, (IV)r);
PerlIO_printf(fp, "$over_tests=10000;\n");
TIMES_LOCATION = PerlIO_tell(fp);
}
static void
-prof_record()
+prof_record(void)
{
/* fp is opened in the BOOT section */
}
PerlIO_seek(fp, TIMES_LOCATION, SEEK_SET);
/* Write into reserved 240 bytes: */
- PerlIO_printf(fp, "$rrun_utime=%ld; $rrun_stime=%ld; $rrun_rtime=%ld;",
- prof_end.tms_utime - prof_start.tms_utime - wprof_u,
- prof_end.tms_stime - prof_start.tms_stime - wprof_s,
- rprof_end - rprof_start - wprof_r );
- PerlIO_printf(fp, "\n$total_marks=%ld;", total);
+ PerlIO_printf(fp,
+ "$rrun_utime=%"IVdf"; $rrun_stime=%"IVdf"; $rrun_rtime=%"IVdf";",
+ /* The (IV) casts are one possibility:
+ * the Painfully Correct Way would be to
+ * have Clock_t_f. */
+ (IV)(prof_end.tms_utime-prof_start.tms_utime-wprof_u),
+ (IV)(prof_end.tms_stime-prof_start.tms_stime-wprof_s),
+ (IV)(rprof_end-rprof_start-wprof_r) );
+ PerlIO_printf(fp, "\n$total_marks=%"IVdf, (IV)total);
PerlIO_close( fp );
}
dXSARGS;
dORIGMARK;
HV *oldstash = curstash;
+ SV *Sub = GvSV(DBsub); /* name of current sub */
SP -= items;
sv_setiv( DBsingle, 0 ); /* disable DB single-stepping */
#endif
- SAVEDESTRUCTOR(check_depth, (void*)depth);
+ SAVEDESTRUCTOR_X(check_depth, (void*)depth);
depth++;
prof_mark( OP_ENTERSUB );
PUSHMARK( ORIGMARK );
#ifdef G_NODEBUG
- perl_call_sv( (SV*)SvIV(Sub), GIMME | G_NODEBUG);
+ perl_call_sv( INT2PTR(SV*,SvIV(Sub)), GIMME | G_NODEBUG);
#else
curstash = debstash; /* To disable debugging of perl_call_sv */
#ifdef PERLDBf_NONAME
dORIGMARK;
HV *oldstash = curstash;
+ SV *Sub = GvSV(DBsub); /* name of current sub */
/* SP -= items; added by xsubpp */
DBG_SUB_NOTIFY( "XS DBsub(%s)\n", SvPV(Sub, na) );
dowarn = warn_tmp;
}
- Sub = GvSV(DBsub); /* name of current sub */
sv_setiv( DBsingle, 0 ); /* disable DB single-stepping */
{