58faf91453
* *
% remove brandings and homepage [1] from copyright header. Pass 1 - using script.
[1] nobody has access to it anymore AFAIK - and it's also just
a redirect since long
! update url in copyright header
; this should make the diff between 3.4 and 3.2 easier to manage
711 lines
16 KiB
Plaintext
711 lines
16 KiB
Plaintext
/*
|
|
* Profiler reporting classes
|
|
*
|
|
* Copyright 2001,2002 Dave Pearson <davep@davep.org>
|
|
* http://www.davep.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
|
|
* the Free Software Foundation; either version 2, or (at your option)
|
|
* any later version.
|
|
*
|
|
* This program is distributed in the hope that it will be useful,
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
* GNU General Public License for more details.
|
|
*
|
|
* You should have received a copy of the GNU General Public License
|
|
* along with this software; see the file COPYING.txt. If not, write to
|
|
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
|
|
* Boston, MA 02111-1307 USA (or visit the web site https://www.gnu.org/).
|
|
*
|
|
* As a special exception, the Harbour Project gives permission for
|
|
* additional uses of the text contained in its release of Harbour.
|
|
*
|
|
* The exception is that, if you link the Harbour libraries with other
|
|
* files to produce an executable, this does not by itself cause the
|
|
* resulting executable to be covered by the GNU General Public License.
|
|
* Your use of that executable is in no way restricted on account of
|
|
* linking the Harbour library code into it.
|
|
*
|
|
* This exception does not however invalidate any other reasons why
|
|
* the executable file might be covered by the GNU General Public License.
|
|
*
|
|
* This exception applies only to the code released by the Harbour
|
|
* Project under the name Harbour. If you copy code from other
|
|
* Harbour Project or Free Software Foundation releases into a copy of
|
|
* Harbour, as the General Public License permits, the exception does
|
|
* not apply to the code that you add in this way. To avoid misleading
|
|
* anyone as to the status of such modified files, you must delete
|
|
* this exception notice from them.
|
|
*
|
|
* If you write modifications of your own for Harbour, it is your choice
|
|
* whether to permit this exception to apply to your modifications.
|
|
* If you do not wish that, delete this exception notice.
|
|
*
|
|
*/
|
|
|
|
/* Rationale:
|
|
*
|
|
* There are three aspects to profiling:
|
|
*
|
|
* 1) Gathering profile information.
|
|
* 2) Taking a snapshot of an application's profile information.
|
|
* 3) Reporting on the data gathered in the snapshot.
|
|
*
|
|
* 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.
|
|
*
|
|
* 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).
|
|
*
|
|
*/
|
|
|
|
/* 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. In other words, we don't want the profiler showing up
|
|
* in the profiler.
|
|
*
|
|
* Many of the "PROTECTED:" scope specifiers in the source have been
|
|
* 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.
|
|
*
|
|
*/
|
|
|
|
/* TODO:
|
|
*
|
|
* - Handle any TODO: items in the source.
|
|
* - Document the classes and the class hierarchy.
|
|
*
|
|
*/
|
|
|
|
/* Thanks:
|
|
*
|
|
* Thanks to Antonio and Patrick for agreeing to replace the old profile
|
|
* reporting code with this approach.
|
|
*/
|
|
|
|
#include "hbclass.ch"
|
|
#include "fileio.ch"
|
|
|
|
// ---------------------------------------------------------
|
|
// Class: HBProfileEntity
|
|
|
|
CREATE CLASS HBProfileEntity
|
|
|
|
EXPORTED:
|
|
|
|
VAR cName READONLY
|
|
VAR nCalls READONLY
|
|
VAR nTicks READONLY
|
|
|
|
ACCESS nSeconds
|
|
ACCESS nMeanTicks
|
|
ACCESS nMeanSeconds
|
|
|
|
METHOD init( cName, aInfo )
|
|
METHOD describe()
|
|
|
|
ENDCLASS
|
|
|
|
//
|
|
|
|
METHOD init( cName, aInfo ) CLASS HBProfileEntity
|
|
|
|
::cName := cName
|
|
::nCalls := aInfo[ 1 ]
|
|
::nTicks := aInfo[ 2 ]
|
|
|
|
RETURN Self
|
|
|
|
ACCESS nSeconds CLASS HBProfileEntity
|
|
|
|
RETURN hb_Clocks2Secs( ::nTicks )
|
|
|
|
ACCESS nMeanTicks CLASS HBProfileEntity
|
|
|
|
RETURN iif( ::nCalls == 0, 0, ::nTicks / ::nCalls )
|
|
|
|
ACCESS nMeanSeconds CLASS HBProfileEntity
|
|
|
|
RETURN iif( ::nCalls == 0, 0, ::nSeconds / ::nCalls )
|
|
|
|
METHOD describe() CLASS HBProfileEntity
|
|
|
|
RETURN "Base Entity"
|
|
|
|
// ---------------------------------------------------------
|
|
// Class: HBProfileFunction
|
|
|
|
CREATE CLASS HBProfileFunction INHERIT HBProfileEntity
|
|
|
|
EXPORTED:
|
|
|
|
METHOD describe()
|
|
|
|
ENDCLASS
|
|
|
|
//
|
|
|
|
METHOD describe() CLASS HBProfileFunction
|
|
|
|
RETURN "Function"
|
|
|
|
// ---------------------------------------------------------
|
|
// Class: HBProfileMethod
|
|
|
|
CREATE CLASS HBProfileMethod INHERIT HBProfileEntity
|
|
|
|
EXPORTED:
|
|
|
|
METHOD describe()
|
|
|
|
ENDCLASS
|
|
|
|
//
|
|
|
|
METHOD describe() CLASS HBProfileMethod
|
|
|
|
RETURN "Method"
|
|
|
|
// ---------------------------------------------------------
|
|
// Class: HBProfileOPCode
|
|
|
|
CREATE CLASS HBProfileOPCode INHERIT HBProfileEntity
|
|
|
|
EXPORTED:
|
|
|
|
METHOD describe()
|
|
|
|
ENDCLASS
|
|
|
|
//
|
|
|
|
METHOD describe() CLASS HBProfileOPCode
|
|
|
|
RETURN "OPCode"
|
|
|
|
// ---------------------------------------------------------
|
|
// Class: HBProfile
|
|
|
|
CREATE CLASS HBProfile
|
|
|
|
EXPORTED:
|
|
|
|
VAR aProfile
|
|
|
|
METHOD init()
|
|
METHOD gather()
|
|
METHOD forEach( b )
|
|
METHOD sort( b )
|
|
METHOD nameSort()
|
|
METHOD callSort()
|
|
METHOD timeSort()
|
|
METHOD totalCalls()
|
|
METHOD totalTicks()
|
|
METHOD totalSeconds()
|
|
|
|
PROTECTED:
|
|
|
|
METHOD gatherFunctions()
|
|
METHOD gatherMethods()
|
|
METHOD reset()
|
|
METHOD ignoreSymbol( cSymbol )
|
|
|
|
ENDCLASS
|
|
|
|
//
|
|
|
|
METHOD init() CLASS HBProfile
|
|
|
|
LOCAL lProfile := __SetProfiler( .F. )
|
|
|
|
::reset()
|
|
|
|
__SetProfiler( lProfile )
|
|
|
|
RETURN Self
|
|
|
|
METHOD reset() CLASS HBProfile
|
|
|
|
::aProfile := {}
|
|
|
|
RETURN Self
|
|
|
|
METHOD ignoreSymbol( cSymbol ) CLASS HBProfile
|
|
|
|
RETURN hb_LeftEq( cSymbol, "HBPROFILE" ) .OR. cSymbol == "__SETPROFILER"
|
|
|
|
METHOD gatherFunctions() CLASS HBProfile
|
|
|
|
LOCAL lProfile := __SetProfiler( .F. )
|
|
LOCAL nSymCount := __dynsCount()
|
|
LOCAL cName
|
|
LOCAL n
|
|
|
|
// 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 )
|
|
|
|
// If we're not ignoring the symbol...
|
|
IF ! ::ignoreSymbol( cName := __dynsGetName( n ) )
|
|
// Yes, it is, add it to the profile.
|
|
AAdd( ::aProfile, HBProfileFunction():new( cName, __dynsGetPrf( n ) ) )
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
NEXT
|
|
|
|
__SetProfiler( lProfile )
|
|
|
|
RETURN Self
|
|
|
|
METHOD gatherMethods() CLASS HBProfile
|
|
|
|
LOCAL lProfile := __SetProfiler( .F. )
|
|
LOCAL n := 1
|
|
LOCAL cClass
|
|
LOCAL nMembers
|
|
LOCAL aMembers
|
|
LOCAL nMember
|
|
|
|
// For each class in the environment...
|
|
DO WHILE ! Empty( cClass := __className( n ) )
|
|
|
|
// If we're not ignoring the class' methods...
|
|
IF ! ::ignoreSymbol( cClass )
|
|
|
|
// 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, HBProfileMethod():new( cClass + ":" + aMembers[ nMember ], __GetMsgPrf( n, aMembers[ nMember ] ) ) )
|
|
ENDIF
|
|
|
|
NEXT
|
|
|
|
ENDIF
|
|
|
|
++n
|
|
|
|
ENDDO
|
|
|
|
__SetProfiler( lProfile )
|
|
|
|
RETURN Self
|
|
|
|
METHOD gather() CLASS HBProfile
|
|
|
|
LOCAL lProfile := __SetProfiler( .F. )
|
|
|
|
// Reset the profile.
|
|
::reset()
|
|
|
|
// Gather function calls
|
|
::gatherFunctions()
|
|
|
|
// Gather method calls
|
|
::gatherMethods()
|
|
|
|
__SetProfiler( lProfile )
|
|
|
|
RETURN Self
|
|
|
|
METHOD forEach( b ) CLASS HBProfile
|
|
|
|
LOCAL lProfile := __SetProfiler( .F. )
|
|
|
|
AEval( ::aProfile, b )
|
|
|
|
__SetProfiler( lProfile )
|
|
|
|
RETURN Self
|
|
|
|
METHOD sort( b ) CLASS HBProfile
|
|
|
|
LOCAL lProfile := __SetProfiler( .F. )
|
|
|
|
ASort( ::aProfile, , , b )
|
|
|
|
__SetProfiler( lProfile )
|
|
|
|
RETURN Self
|
|
|
|
METHOD nameSort() CLASS HBProfile
|
|
|
|
LOCAL lProfile := __SetProfiler( .F. )
|
|
|
|
::sort( {| oX, oY | oX:cName < oY:cName } )
|
|
|
|
__SetProfiler( lProfile )
|
|
|
|
RETURN Self
|
|
|
|
METHOD callSort() CLASS HBProfile
|
|
|
|
LOCAL lProfile := __SetProfiler( .F. )
|
|
|
|
::sort( {| oX, oY | oX:nCalls > oY:nCalls } )
|
|
|
|
__SetProfiler( lProfile )
|
|
|
|
RETURN Self
|
|
|
|
METHOD timeSort() CLASS HBProfile
|
|
|
|
LOCAL lProfile := __SetProfiler( .F. )
|
|
|
|
::sort( {| oX, oY | oX:nTicks > oY:nTicks } )
|
|
|
|
__SetProfiler( lProfile )
|
|
|
|
RETURN Self
|
|
|
|
METHOD totalCalls() CLASS HBProfile
|
|
|
|
LOCAL lProfile := __SetProfiler( .F. )
|
|
LOCAL nCalls := 0
|
|
|
|
::forEach( {| o | nCalls += o:nCalls } )
|
|
|
|
__SetProfiler( lProfile )
|
|
|
|
RETURN nCalls
|
|
|
|
METHOD totalTicks() CLASS HBProfile
|
|
|
|
LOCAL lProfile := __SetProfiler( .F. )
|
|
LOCAL nTicks := 0
|
|
|
|
::forEach( {| o | nTicks += o:nTicks } )
|
|
|
|
__SetProfiler( lProfile )
|
|
|
|
RETURN nTicks
|
|
|
|
METHOD totalSeconds() CLASS HBProfile
|
|
|
|
LOCAL lProfile := __SetProfiler( .F. )
|
|
LOCAL nSeconds := 0
|
|
|
|
::forEach( {| o | nSeconds += o:nSeconds } )
|
|
|
|
__SetProfiler( lProfile )
|
|
|
|
RETURN nSeconds
|
|
|
|
// ---------------------------------------------------------
|
|
// Class: HBProfileLowLevel
|
|
|
|
CREATE CLASS HBProfileLowLevel INHERIT HBProfile
|
|
|
|
EXPORTED:
|
|
|
|
METHOD gather()
|
|
|
|
PROTECTED:
|
|
|
|
METHOD gatherOPCodes()
|
|
|
|
ENDCLASS
|
|
|
|
//
|
|
|
|
METHOD gather() CLASS HBProfileLowLevel
|
|
|
|
LOCAL lProfile := __SetProfiler( .F. )
|
|
|
|
// Gather functions and methods.
|
|
::super:gather()
|
|
|
|
// Also gather opcodes.
|
|
::gatherOPCodes()
|
|
|
|
__SetProfiler( lProfile )
|
|
|
|
RETURN Self
|
|
|
|
METHOD gatherOPCodes() CLASS HBProfileLowLevel
|
|
|
|
LOCAL nMax := __opCount()
|
|
LOCAL cName
|
|
LOCAL nOP
|
|
|
|
// Loop over all the harbour OP codes. Note that they start at 0.
|
|
FOR nOP := 0 TO nMax - 1
|
|
// If we're not ignoring this opcode.
|
|
IF ! ::ignoreSymbol( cName := "OPCODE( " + Str( nOP, 3 ) + " )" )
|
|
// Add it to the profile.
|
|
AAdd( ::aProfile, HBProfileOpcode():new( cName, __opGetPrf( nOP ) ) )
|
|
ENDIF
|
|
NEXT
|
|
|
|
RETURN Self
|
|
|
|
// ---------------------------------------------------------
|
|
// Class: HBProfileReport
|
|
|
|
CREATE CLASS HBProfileReport
|
|
|
|
PROTECTED:
|
|
|
|
VAR oProfile
|
|
|
|
METHOD writeLines( aLines )
|
|
METHOD header()
|
|
METHOD emitHeader()
|
|
METHOD line( oEntity )
|
|
METHOD emitLine( oEntity )
|
|
|
|
EXPORTED:
|
|
|
|
METHOD init( oProfile )
|
|
METHOD generate( bFilter )
|
|
|
|
ENDCLASS
|
|
|
|
//
|
|
|
|
METHOD init( oProfile ) CLASS HBProfileReport
|
|
|
|
LOCAL lProfile := __SetProfiler( .F. )
|
|
|
|
::oProfile := oProfile
|
|
|
|
__SetProfiler( lProfile )
|
|
|
|
RETURN Self
|
|
|
|
METHOD writeLines( aLines ) CLASS HBProfileReport
|
|
|
|
AEval( aLines, {| c | QOut( c ) } )
|
|
|
|
RETURN Self
|
|
|
|
METHOD header() CLASS HBProfileReport
|
|
|
|
RETURN { ;
|
|
"Name Type Calls Ticks Seconds", ;
|
|
"=================================== ========== ======== =========== ===========" }
|
|
|
|
METHOD emitHeader() CLASS HBProfileReport
|
|
|
|
::writeLines( ::Header() )
|
|
|
|
RETURN Self
|
|
|
|
METHOD line( oEntity ) CLASS HBProfileReport
|
|
|
|
RETURN { ;
|
|
PadR( oEntity:cName, 35 ) + " " + ;
|
|
PadR( oEntity:describe(), 8 ) + " " + ;
|
|
Str( oEntity:nCalls, 10 ) + " " + ;
|
|
Str( oEntity:nTicks, 11 ) + " " + ;
|
|
Str( oEntity:nSeconds, 11, 2 ) }
|
|
|
|
METHOD emitLine( oEntity ) CLASS HBProfileReport
|
|
|
|
::writeLines( ::line( oEntity ) )
|
|
|
|
RETURN Self
|
|
|
|
METHOD generate( bFilter ) CLASS HBProfileReport
|
|
|
|
LOCAL lProfile := __SetProfiler( .F. )
|
|
|
|
hb_default( @bFilter, {|| .T. } )
|
|
|
|
::emitHeader():oProfile:forEach( {| o | iif( Eval( bFilter, o ), ::emitLine( o ), NIL ) } )
|
|
|
|
__SetProfiler( lProfile )
|
|
|
|
RETURN Self
|
|
|
|
// ---------------------------------------------------------
|
|
// Class: HBProfileReportToFile
|
|
|
|
CREATE CLASS HBProfileReportToFile INHERIT HBProfileReport
|
|
|
|
PROTECTED:
|
|
|
|
VAR hFile
|
|
|
|
METHOD writeLines( aLines )
|
|
|
|
EXPORTED:
|
|
|
|
METHOD generate( bFilter, cFile )
|
|
|
|
ENDCLASS
|
|
|
|
//
|
|
|
|
METHOD writeLines( aLines ) CLASS HBProfileReportToFile
|
|
|
|
IF ::hFile != F_ERROR
|
|
AEval( aLines, {| c | FWrite( ::hFile, c + hb_eol() ) } )
|
|
ENDIF
|
|
|
|
RETURN Self
|
|
|
|
METHOD generate( bFilter, cFile ) CLASS HBProfileReportToFile
|
|
|
|
LOCAL lProfile := __SetProfiler( .F. )
|
|
|
|
IF ( ::hFile := FCreate( hb_defaultValue( cFile, "hbprof.txt" ) ) ) != F_ERROR
|
|
::super:generate( bFilter )
|
|
FClose( ::hFile )
|
|
ELSE
|
|
// TODO: Throw an error
|
|
ENDIF
|
|
|
|
__SetProfiler( lProfile )
|
|
|
|
RETURN Self
|
|
|
|
// ---------------------------------------------------------
|
|
// Class: HBProfileReportToArray
|
|
|
|
CREATE CLASS HBProfileReportToArray INHERIT HBProfileReport
|
|
|
|
PROTECTED:
|
|
|
|
VAR aReport
|
|
|
|
METHOD writeLines( aLines )
|
|
|
|
EXPORTED:
|
|
|
|
METHOD generate( bFilter )
|
|
|
|
ENDCLASS
|
|
|
|
//
|
|
|
|
METHOD writeLines( aLines ) CLASS HBProfileReportToArray
|
|
|
|
AEval( aLines, {| c | AAdd( ::aReport, c ) } )
|
|
|
|
RETURN Self
|
|
|
|
METHOD generate( bFilter ) CLASS HBProfileReportToArray
|
|
|
|
::aReport := {}
|
|
::super:generate( bFilter )
|
|
|
|
RETURN ::aReport
|
|
|
|
// ---------------------------------------------------------
|
|
// Class: HBProfileReportToString
|
|
|
|
CREATE CLASS HBProfileReportToString INHERIT HBProfileReportToArray
|
|
|
|
EXPORTED:
|
|
|
|
METHOD generate( bFilter )
|
|
|
|
ENDCLASS
|
|
|
|
//
|
|
|
|
METHOD generate( bFilter ) CLASS HBProfileReportToString
|
|
|
|
LOCAL cReport := ""
|
|
|
|
AEval( ::super:generate( bFilter ), {| c | cReport += c + hb_eol() } )
|
|
|
|
RETURN cReport
|
|
|
|
// ---------------------------------------------------------
|
|
// Class: HBProfileReportToTBrowse
|
|
|
|
CREATE CLASS HBProfileReportToTBrowse INHERIT HBProfileReportToArray
|
|
|
|
PROTECTED:
|
|
|
|
VAR nEntity
|
|
|
|
METHOD emitHeader()
|
|
METHOD emitLine( oEntity )
|
|
METHOD addColumns( oBrowse )
|
|
|
|
EXPORTED:
|
|
|
|
METHOD generate( bFilter, nTop, nLeft, nBottom, nRight )
|
|
METHOD currentEntity()
|
|
|
|
ENDCLASS
|
|
|
|
//
|
|
|
|
METHOD emitHeader() CLASS HBProfileReportToTBrowse
|
|
|
|
// No header required.
|
|
|
|
RETURN Self
|
|
|
|
METHOD emitLine( oEntity ) CLASS HBProfileReportToTBrowse
|
|
|
|
// Don't "emit" anything, simply add the entity to the array.
|
|
AAdd( ::aReport, oEntity )
|
|
|
|
RETURN Self
|
|
|
|
METHOD generate( bFilter, nTop, nLeft, nBottom, nRight ) CLASS HBProfileReportToTBrowse
|
|
|
|
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 := iif( nSkip > 0, ;
|
|
Min( Len( ::aReport ), ::nEntity + nSkip ), ;
|
|
Max( 1, ::nEntity + nSkip ) ), ::nEntity - nPos }
|
|
|
|
::addColumns( oBrowse )
|
|
|
|
__SetProfiler( lProfile )
|
|
|
|
RETURN oBrowse
|
|
|
|
METHOD addColumns( oBrowse ) CLASS HBProfileReportToTBrowse
|
|
|
|
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 HBProfileReportToTBrowse
|
|
|
|
RETURN ::aReport[ ::nEntity ]
|