From 01e31ce1304f579d4d4b2d1e26aa0611fd68420e Mon Sep 17 00:00:00 2001 From: Dave Pearson Date: Thu, 26 Jul 2001 14:32:44 +0000 Subject: [PATCH] 2001-07-26 14:30 GMT Dave Pearson * source/rtl/profiler.prg * Resorted Antonio's profile reporter due to copyright concerns. --- harbour/ChangeLog | 4 + harbour/source/rtl/profiler.prg | 794 +++++--------------------------- 2 files changed, 113 insertions(+), 685 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index 8634778c35..a628e861bc 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,7 @@ +2001-07-26 14:30 GMT Dave Pearson + * source/rtl/profiler.prg + * Resorted Antonio's profile reporter due to copyright concerns. + 2001-07-26 02:50 UTC-0800 Ron Pinkas * include/hbexpra.c + Added logic to optimize 2nd parameter of __DBLIST(). diff --git a/harbour/source/rtl/profiler.prg b/harbour/source/rtl/profiler.prg index fbaeb430ed..c337f47546 100644 --- a/harbour/source/rtl/profiler.prg +++ b/harbour/source/rtl/profiler.prg @@ -1,13 +1,13 @@ /* - * $Id$ - */ + * $id:$ +*/ -/* +/* * Harbour Project source code: - * Profiler reporting classes + * profiler * - * Copyright 2001 Dave Pearson - * http://www.davep.org/ + * Copyright 2001 Antonio Linares + * www - http://www.harbour-project.org * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by @@ -50,717 +50,141 @@ * */ -/* Rationale: +/* + * Copyright 2001 Patrick Mast * - * There are three aspects to profiling: + * 2001-07-15 16:23 GMT+1 + * Added: Added the parameter. If profiler is used like + * this Profiler(.t.), the profiler.txt will only be filled + * with used classes and/or functions. * - * 1) Gathering profile information. + * 2001-07-16 13:00 GMT+1 + * - Removed parameter + * + Added parameter. + * + Added parameter + * + Added Cunsumed time in seconds + * * Replaced MemoWrit() function with more controllable f* functions + * + profiler() returns a array with profiler info * - * 2) Taking a snapshot of an application's profile information. + * Profiler() + * => Writes NO info to file, returns Array of profiler info. + * Array only contains USED functions/classes. * - * 3) Reporting on the data gathered in the snapshot. + * Profiler(,.t.) + * => Writes NO info to file, returns Array of profiler info. + * Array only contains ALL functions/classes. * - * Point 1 is handled in harbour's virtual machine. This source aims to - * provide code for performing points 2 and 3. A class is provided to - * gather, hold and manipulate the profile snapshot and a hierarchy of - * classes exist for reporting on that snapshot. The reporting classes are - * designed such that they are easy to inherit from and improve upon. + * Profiler("profiler.txt") + * => Writes profiler info to and returns Array of + * profiler info. Array only contains USED functions/classes. * - * The idea behind all of this is that the the design should provide all the - * necessary building blocks for writing profiler reporters that suite the - * user's needs (perhaps as part of an extended debugger or something). + * Profiler("profiler.txt", .t.) + * => Writes ALL profiler info to and returns Array of + * profiler info. Array contains ALL functions/classes. * + * 2001-07-16 15:19 GMT+1 + * * Renamed function from Profiler() to HB_Profiler() */ -/* Notes: - * - * As much as possible, the profiler class and the profile report classes - * attempt to turn off the profiler to ensure that we don't get some sort of - * Heisenberg effect. IOW, we don't want the profiler showing up in the - * profiler. - * - * Many of the "Protected:" scope specifiers in the source have beenc - * commented out where there's a problem with scope in harbour's class - * system. Note that those comments will be removed when the bug is fixed. - * - */ +#define CRLF HB_OsNewLine() -/* TODO: - * - * o Handle any TODO: items in the source. - * o Document the classes and the class hierarchy. - * - */ +Function HB_Profiler(cFile, lAll) +LOCAL n, m, cClass, aFunProcInfo, aInfo, aMethodInfo +LOCAL hFile, aProf:={}, cText:="" -#include "hbclass.ch" -#include "fileio.ch" -#include "common.ch" + if Upper(ValType(lAll))#"L" // Put ALL classes/functions in profiler report? + lAll:=.f. + endif -#ifdef __TEST__ + for n = __DynSCount() to 1 step - 1 // Number of dynamic symbols on the global + // symbol table. Their names are ordered + // in reverse order. + if __DynSIsFun( n ) // Is this symbol a function or a procedure ? -#include "inkey.ch" + aFunProcInfo = __DynSGetPrf( n ) // We get its profiler info -Function Main() -Local oProfile := HB_Profile():new() -Local n + if lAll .or. aFunProcInfo[ 1 ]>0 - // Turn on profiling. - __setProfiler( .T. ) + if !Empty(cFile) + cText += " " +; + PadR( __DynSGetName( n ), 20 ) + ; + Str( aFunProcInfo[ 1 ], 7 ) + ; + Str( aFunProcInfo[ 2 ], 14 ) + ; + Str( aFunProcInfo[ 2 ]/1000, 11,2 ) + CRLF + endif - // Make sure we've got something to see timewise. - DrawScreen( "Doing nothing for a couple of seconds" ) - DoNothingForTwoSeconds() + Aadd(aProf, {"F" , ; + __DynSGetName( n ) , ; + aFunProcInfo[ 1 ] , ; + aFunProcInfo[ 2 ] , ; + aFunProcInfo[ 2 ]/1000 } ) - // Make sure we've got something to see callwise. - For n := 1 To 500 - CallMe500Times() - Next + endif + endif + next - // Take a profile snapshot. - oProfile:gather() + if !Empty( cFile ) + cText += CRLF + CRLF + ; + " --- CONSUMED TIME ---" + CRLF + ; + " CLASSES CALLS CLOCK TICKS SECONDS" + CRLF + ; + "==========================================================" + CRLF + endif - // Report on calls greater than 0 - DrawScreen( "All methods/functions called one or more times" ) - memoedit( HB_ProfileReportToString():new( oProfile:callSort() ):generate( {|o| o:nCalls > 0 } ), 1,,,, .F. ) + n = 1 + while ! Empty( cClass := __ClassName( n ) ) - // Sorted by name - DrawScreen( "All methods/functions called one or more times, sorted by name" ) - memoedit( HB_ProfileReportToString():new( oProfile:nameSort() ):generate( {|o| o:nCalls > 0 } ), 1,,,, .F. ) + cText += CRLF + " CLASS " + cClass + CRLF + aInfo = ASort( __ClassSel( n ) ) // Retrieves all Class datas and methods names - // Sorted by time - DrawScreen( "All methods/functions taking measurable time, sorted by time" ) - memoedit( HB_ProfileReportToString():new( oProfile:timeSort() ):generate( {|o| o:nTicks > 0 } ), 1,,,, .F. ) + for m = 1 to Len( aInfo ) - // TBrowse all calls greater than 0 - DrawScreen( "TBrowse all methods/functions called one or more times" ) - Browser( HB_ProfileReportToTBrowse():new( oProfile:callSort() ):generate( {|o| o:nCalls > 0 }, 1 ) ) + if !Empty( aInfo[ m ] ) // why __ClassSel() returns empty strings ? - // Some closing stats - DrawScreen( "Totals" ) - @ 2, 0 Say " Total Calls: " + str( oProfile:totalCalls() ) - @ 3, 0 Say " Total Ticks: " + str( oProfile:totalTicks() ) - @ 4, 0 Say "Total Seconds: " + str( oProfile:totalSeconds() ) + aMethodInfo = __GetMsgPrf( n, aInfo[ m ] ) // We get its profiler info -Return( NIL ) + if lAll .or. aMethodInfo[ 1 ]>0 -Static Function DrawScreen( cTitle ) + if !Empty(cFile) + cText += " " +; + PadR( aInfo[ m ], 20 ) + ; + Str( aMethodInfo[ 1 ], 7 ) + ; + Str( aMethodInfo[ 2 ], 14 ) + ; + Str( aMethodInfo[ 2 ]/1000, 11,2 ) + CRLF + endif - scroll() + Aadd(aProf, {"C" , ; + aInfo[ m ] , ; + aMethodInfo[ 1 ] , ; + aMethodInfo[ 2 ] , ; + aMethodInfo[ 2 ]/1000 } ) - @ 0, 0 Say padr( cTitle, maxcol() + 1 ) Color "n/w" + endif + endif + next + n++ + end -Return( NIL ) -Function DoNothingForTwoSeconds() + if !Empty(cFile) - inkey( 2 ) + cText := " *** Harbour profiler report ***" + CRLF + CRLF + ; + " --- CONSUMED TIME ---" + CRLF + ; + " FUNCTIONS/PROCEDURES CALLS CLOCK TICKS SECONDS" + CRLF + ; + "==========================================================" + CRLF + cText -Return( NIL ) + hFile := FCreate( cFile ) + if hFile == -1 + Alert( "ERROR! creating '"+ cFile +"' , O/S Error: " + Str( FError(), 2 ) ) + endif -Function CallMe500Times() -Return( NIL ) + if FWrite(hFile, cText) == len(cText) + Fclose(hFile) + else + Alert("ERROR! writing '"+ cFile +"'") + Fclose(hFile) + endif -Static Function Browser( oBrowse ) -Local lBrowsing := .T. -Local nKey + endif - Do While lBrowsing - - oBrowse:forceStable() - - nKey := inkey( 0 ) - - Do Case - - Case nKey == K_ESC - lBrowsing := .F. - - Case nKey == K_DOWN - oBrowse:down() - - Case nKey == K_UP - oBrowse:up() - - Case nKey == K_LEFT - oBrowse:left() - - Case nKey == K_RIGHT - oBrowse:right() - - Case nKey == K_PGDN - oBrowse:pageDown() - - Case nKey == K_PGUP - oBrowse:pageUp() - - // And so on.... (not really necessary for this test) - - EndCase - - EndDo -Return( NIL ) - -#endif - -//////////////////////////////////////////////////////////////////////////// -// Class: HB_ProfileEntity - -Create Class HB_ProfileEntity - - Exported: - - Var cName ReadOnly - Var nCalls ReadOnly - Var nTicks ReadOnly - - Access nSeconds - Access nMeanTicks - Access nMeanSeconds - - Method init - Method describe - -End Class - -///// - -Method init( cName, aInfo ) Class HB_ProfileEntity - - ::cName := cName - ::nCalls := aInfo[ 1 ] - ::nTicks := aInfo[ 2 ] - -Return( self ) - -///// - -Access nSeconds Class HB_ProfileEntity -Return( HB_Clocks2Secs( ::nTicks ) ) - -///// - -Access nMeanTicks Class HB_ProfileEntity -Return( if( ::nCalls == 0, 0, ::nTicks / ::nCalls ) ) - -///// - -Access nMeanSeconds Class HB_ProfileEntity -Return( if( ::nCalls == 0, 0, ::nSeconds / ::nCalls ) ) - -///// - -Method describe Class HB_ProfileEntity -Return( "Base Entity" ) - -//////////////////////////////////////////////////////////////////////////// -// Class: HB_ProfileFunction - -Create Class HB_ProfileFunction Inherit HB_ProfileEntity - - Exported: - - Method describe - -End Class - -///// - -Method describe Class HB_ProfileFunction -Return( "Function" ) - -//////////////////////////////////////////////////////////////////////////// -// Class: HB_ProfileMethod - -Create Class HB_ProfileMethod Inherit HB_ProfileEntity - - Exported: - - Method describe - -End Class - -///// - -Method describe Class HB_ProfileMethod -Return( "Method" ) - -//////////////////////////////////////////////////////////////////////////// -// Class: HB_Profile - -Create Class HB_Profile - - Exported: - - Var aProfile - - Method init - Method gather - Method forEach - Method sort - Method nameSort - Method callSort - Method timeSort - Method totalCalls - Method totalTicks - Method totalSeconds - - Protected: - - Method reset - -End Class - -///// - -Method init Class HB_Profile -Local lProfile := __setProfiler( .F. ) - - ::reset() - - __setProfiler( lProfile ) - -Return( self ) - -///// - -Method reset Class HB_Profile - - ::aProfile := {} - -Return( self ) - -///// - -Method gather Class HB_Profile -Local lProfile := __setProfiler( .F. ) -Local nSymCount := __DynSCount() -Local cProfPrefix := "HB_PROFILE" -Local nPrefixLen := len( cProfPrefix ) -Local cName -Local aPInfo -Local cClass -Local nMembers -Local aMembers -Local nMember -Local n - - // Reset the profile. - ::reset() - - // First, collect function call data. - - // For each known symbol. - // TODO: Question: Will the symbol count have changed because - // we've created variables? - For n := 1 To nSymCount - - // Is the symbol a function? - If __DynSIsFun( n ) - - // Ignoring profiler functions... - If !( left( cName := __DynSGetName( n ), nPrefixLen ) == cProfPrefix ) - // Yes, it is, add it to the profile. - aadd( ::aProfile, HB_ProfileFunction():new( cName, __DynSGetPrf( n ) ) ) - EndIf - - EndIf - - Next - - // Now collect classes. - - n := 1 - - // For each class in the environment... - Do While !empty( cClass := __className( n ) ) - - // Ignoring profiler classes... - If !( left( cClass, nPrefixLen ) == cProfPrefix ) - - // Collect class members. - nMembers := len( aMembers := __classSel( n ) ) - - For nMember := 1 To nMembers - - // If we've got a member name... - If !empty( aMembers[ nMember ] ) - // Add it to the profile. - aadd( ::aProfile, Hb_ProfileMethod():new( cClass + ":" + aMembers[ nMember ], __GetMsgPrf( n, aMembers[ nMember ] ) ) ) - EndIf - - Next - - EndIf - - ++n - - EndDo - - __setProfiler( lProfile ) - -Return( self ) - -///// - -Method forEach( b ) Class HB_Profile -Local lProfile := __setProfiler( .F. ) - - aeval( ::aProfile, b ) - - __setProfiler( lProfile ) - -Return( self ) - -///// - -Method sort( b ) Class HB_Profile -Local lProfile := __setProfiler( .F. ) - - asort( ::aProfile,,, b ) - - __setProfiler( lProfile ) - -Return( self ) - -///// - -Method nameSort Class HB_Profile -Local lProfile := __setProfiler( .F. ) - - ::sort( {|oX, oY| oX:cName < oY:cName } ) - - __setProfiler( lProfile ) - -Return( self ) - -///// - -Method callSort Class HB_Profile -Local lProfile := __setProfiler( .F. ) - - ::sort( {|oX, oY| oX:nCalls > oY:nCalls } ) - - __setProfiler( lProfile ) - -Return( self ) - -///// - -Method timeSort Class HB_Profile -Local lProfile := __setProfiler( .F. ) - - ::sort( {|oX, oY| oX:nTicks > oY:nTicks } ) - - __setProfiler( lProfile ) - -Return( self ) - -///// - -Method totalCalls Class HB_Profile -Local lProfile := __setProfiler( .F. ) -Local nCalls := 0 - - ::forEach( {|o| nCalls += o:nCalls } ) - - __setProfiler( lProfile ) - -Return( nCalls ) - -///// - -Method totalTicks Class HB_Profile -Local lProfile := __setProfiler( .F. ) -Local nTicks := 0 - - ::forEach( {|o| nTicks += o:nTicks } ) - - __setProfiler( lProfile ) - -Return( nTicks ) - -///// - -Method totalSeconds Class HB_Profile -Local lProfile := __setProfiler( .F. ) -Local nSeconds := 0 - - ::forEach( {|o| nSeconds += o:nSeconds } ) - - __setProfiler( lProfile ) - -Return( nSeconds ) - -//////////////////////////////////////////////////////////////////////////// -// Class: HB_ProfileReport - -Create Class HB_ProfileReport - -// Protected: - - Var oProfile - - Method writeLines - Method header - Method emitHeader - Method line - Method emitLine - - Exported: - - Method init - Method generate - -End Class - -///// - -Method init( oProfile ) Class HB_ProfileReport -Local lProfile := __setProfiler( .F. ) - - ::oProfile := oProfile - - __setProfiler( lProfile ) - -Return( self ) - -///// - -Method writeLines( aLines ) Class HB_ProfileReport - - aeval( aLines, {|c| qout( c ) } ) - -Return( self ) - -///// - -Method header Class HB_ProfileReport -Return( { "Name Type Calls Ticks Seconds",; - "=================================== ========== ======== =========== ===========" } ) - -///// - -Method emitHeader Class HB_ProfileReport - - ::writeLines( ::header() ) - -Return( self ) - -///// - -Method line( oEntity ) Class HB_ProfileReport -Return( { padr( oEntity:cName, 35 ) + " " + ; - padr( oEntity:describe(), 8 ) + " " + ; - padl( oEntity:nCalls, 10 ) + " " + ; - padl( oEntity:nTicks, 11 ) + " " + ; - str( oEntity:nSeconds, 11, 2 ) } ) - -///// - -Method emitLine( oEntity ) Class HB_ProfileReport - - ::writeLines( ::line( oEntity ) ) - -Return( self ) - -///// - -Method generate( bFilter ) Class HB_ProfileReport -Local lProfile := __setProfiler( .F. ) - - Default bFilter To {|| .T. } - - ::emitHeader():oProfile:forEach( {|o| if( eval( bFilter, o ), ::emitLine( o ), NIL ) } ) - - __setProfiler( lProfile ) - -Return( self ) - -//////////////////////////////////////////////////////////////////////////// -// Class: HB_ProfileReportToFile - -Create Class HB_ProfileReportToFile Inherit HB_ProfileReport - -// Protected: - - Var hFile - - Method writeLines - - Exported: - - Method generate - -End Class - -///// - -Method writeLines( aLines ) Class HB_ProfileReportToFile - - If ::hFile != F_ERROR - aeval( aLines, {|c| fwrite( ::hFile, c + HB_OsNewLine() ) } ) - EndIf - -Return( self ) - -///// - -Method generate( bFilter, cFile ) Class HB_ProfileReportToFile -Local lProfile := __setProfiler( .F. ) - - Default cFile To "hbprof.txt" - - If ( ::hFile := fcreate( cFile ) ) != F_ERROR - ::super:generate( bFilter ) - fclose( ::hFile ) - Else - // TODO: Throw an error - EndIf - - __setProfiler( lProfile ) - -Return( self ) - -//////////////////////////////////////////////////////////////////////////// -// Class: HB_ProfileReportToArray - -Create Class HB_ProfileReportToArray Inherit HB_ProfileReport - -// Protected: - - Var aReport - - Method writeLines - - Exported: - - Method generate - -End Class - -///// - -Method writeLines( aLines ) Class HB_ProfileReportToArray - - aeval( aLines, {|c| aadd( ::aReport, c ) } ) - -Return( self ) - -///// - -Method generate( bFilter ) Class HB_ProfileReportToArray - - ::aReport := {} - ::super:generate( bFilter ) - -Return( ::aReport ) - -//////////////////////////////////////////////////////////////////////////// -// Class: HB_ProfileReportToString - -Create Class HB_ProfileReportToString Inherit HB_ProfileReportToArray - - Exported: - - Method generate - -End Class - -///// - -Method generate( bFilter ) Class HB_ProfileReportToString -Local cReport := "" - - aeval( ::super:generate( bFilter ), {|c| cReport += c + HB_OsNewLine() } ) - -Return( cReport ) - -//////////////////////////////////////////////////////////////////////////// -// Class: HB_ProfileReportToTBrowse - - -Create Class HB_ProfileReportToTBrowse Inherit HB_ProfileReportToArray - -// Protected: - - Var nEntity - - Method emitHeader - Method emitLine - Method addColumns - - Exported: - - Method generate - Method currentEntity - -End Class - -///// - -Method emitHeader Class HB_ProfileReportToTBrowse - - // No header required. - -Return( self ) - -///// - -Method emitLine( oEntity ) Class HB_ProfileReportToTBrowse - - // Don't "emit" anything, simply add the entity to the array. - aadd( ::aReport, oEntity ) - -Return( self ) - -///// - -Method generate( bFilter, nTop, nLeft, nBottom, nRight ) Class HB_ProfileReportToTBrowse -Local lProfile := __setProfiler( .F. ) -Local oBrowse - - // Start with the first entity. - ::nEntity := 1 - - // Generate the array. - ::super:generate( bFilter ) - - // Build the browse. - oBrowse := tbrowsenew( nTop, nLeft, nBottom, nRight ) - - oBrowse:goTopBlock := {|| ::nEntity := 1 } - oBrowse:goBottomBlock := {|| ::nEntity := len( ::aReport ) } - oBrowse:skipBlock := {|nSkip, nPos| nPos := ::nEntity, ; - ::nEntity := if( nSkip > 0, ; - min( len( ::aReport ), ::nEntity + nSkip ), ; - max( 1, ::nEntity + nSkip ) ), ::nEntity - nPos } - - ::addColumns( oBrowse ) - - __setProfiler( lProfile ) - -Return( oBrowse ) - -///// - -Method addColumns( oBrowse ) Class HB_ProfileReportToTBrowse - - oBrowse:addColumn( tbcolumnnew( "Name", {|| padr( ::currentEntity():cName, 35 ) } ) ) - oBrowse:addColumn( tbcolumnnew( "Type", {|| padr( ::currentEntity():describe(), 8 ) } ) ) - oBrowse:addColumn( tbcolumnnew( "Calls", {|| padl( ::currentEntity():nCalls, 10 ) } ) ) - oBrowse:addColumn( tbcolumnnew( "Ticks", {|| padl( ::currentEntity():nTicks, 11 ) } ) ) - oBrowse:addColumn( tbcolumnnew( "Seconds", {|| str( ::currentEntity():nSeconds, 11, 2 ) } ) ) - oBrowse:addColumn( tbcolumnnew( "Mean;Ticks", {|| str( ::currentEntity():nMeanTicks, 11, 2 ) } ) ) - oBrowse:addColumn( tbcolumnnew( "Mean;Seconds", {|| str( ::currentEntity():nMeanSeconds, 11, 2 ) } ) ) - -Return( self ) - -///// - -Method currentEntity Class HB_ProfileReportToTBrowse -Return( ::aReport[ ::nEntity ] ) - -/* - * profiler.prg ends here. - */ +RETURN aProf \ No newline at end of file