diff --git a/harbour/ChangeLog b/harbour/ChangeLog index dae1b9857a..9881f43ca8 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -8,6 +8,31 @@ 2002-12-01 23:12 UTC+0100 Foo Bar */ +2004-01-26 11:45 UTC+0100 Ryszard Glab + * source/compiler/harbour.c + *fixed generation of codeblock's pcode with debugging info + + * source/debug/dbgmenu.prg + * source/debug/dbgtmenu.prg + * source/debug/dbgtmitm.prg + * source/debug/dbgtwin.prg + * source/debug/debugger.prg + * source/debug/tbrwtext.prg + *added Tracepoint support + *added support for PPO files + *added monitoring of local variables used in a codeblock + *local variables are displayed correctly when the + callstack window is browsed + *other minor fixes + + * source/vm/debug.c + *renamed '__vm*' functions to 'hb_dbg_*' + *fixed support for local variables inside of codeblock + + * source/vm/hvm.c + *added 'hb_dbg_ProcLevel' function which return the + size of procedure stack calls (the debugger support) + 2004-01-25 10:11 UTC+0100 Antonio Linares * makefile.nt * makefile.vc diff --git a/harbour/source/compiler/harbour.c b/harbour/source/compiler/harbour.c index cf28f76743..b7a20175e5 100644 --- a/harbour/source/compiler/harbour.c +++ b/harbour/source/compiler/harbour.c @@ -720,24 +720,6 @@ void hb_compVariableAdd( char * szVarName, BYTE cValueType ) pLastVar->pNext = pVar; } -/* - if( hb_comp_bDebugInfo ) - { - BYTE * pBuffer = ( BYTE * ) hb_xgrab( strlen( szVarName ) + 5 ); - int iVar = hb_compStaticGetPos( szVarName, pFunc ); - - pBuffer[0] = HB_P_STATICNAME; - pBuffer[1] = (hb_compVariableScope( szVarName )==HB_VS_GLOBAL_STATIC)?1:0; - pBuffer[2] = HB_LOBYTE( iVar ); - pBuffer[3] = HB_HIBYTE( iVar ); - - memcpy( ( BYTE * ) ( & ( pBuffer[4] ) ), szVarName, strlen( szVarName ) + 1 ); - - hb_compGenPCodeN( pBuffer, strlen( szVarName ) + 5 , 0 ); - - hb_xfree( pBuffer ); - } -*/ } break; @@ -3788,21 +3770,11 @@ void hb_compCodeBlockStart() { PFUNCTION pBlock; -#if 0 - if( hb_comp_iWarnings >= 3 ) - { - /* Not generating yet - will be generated in hb_compCodeBlockEnd() */ - hb_compGenPCode1( HB_P_PUSHBLOCK ); - pBlock->lPCodePos--; - } -#endif - pBlock = hb_compFunctionNew( NULL, HB_FS_STATIC ); pBlock->pOwner = hb_comp_functions.pLast; pBlock->iStaticsBase = hb_comp_functions.pLast->iStaticsBase; hb_comp_functions.pLast = pBlock; -/* hb_compLinePushIfDebugger(); */ } void hb_compCodeBlockEnd( void ) @@ -3811,7 +3783,9 @@ void hb_compCodeBlockEnd( void ) PFUNCTION pFunc;/* pointer to a function that owns a codeblock */ USHORT wSize; USHORT wLocals = 0; /* number of referenced local variables */ + USHORT wLocalsCnt, wLocalsLen; USHORT wPos; + int iLocalPos; PVAR pVar, pFree; if( hb_comp_functions.pLast && @@ -3840,13 +3814,17 @@ void hb_compCodeBlockEnd( void ) */ /* Count the number of referenced local variables */ + wLocalsLen = 0; pVar = pCodeblock->pStatics; while( pVar ) { + if( hb_comp_bDebugInfo ) + wLocalsLen += (4 + strlen(pVar->szName)); pVar = pVar->pNext; ++wLocals; } - + wLocalsCnt = wLocals; + if( ( pCodeblock->lPCodePos + 3 ) <= 255 && pCodeblock->wParamCount == 0 && wLocals == 0 ) { /* NOTE: 3 = HB_P_PUSHBLOCKSHORT + BYTE( size ) + _ENDBLOCK */ @@ -3860,7 +3838,8 @@ void hb_compCodeBlockEnd( void ) wSize = ( USHORT ) pCodeblock->lPCodePos + 8 + wLocals * 2; if( hb_comp_bDebugInfo ) { - wSize += (3 + strlen( hb_comp_files.pLast->szFileName ) + strlen( hb_comp_functions.pLast->szName )); + wSize += (3 + strlen( hb_comp_files.pLast->szFileName ) + strlen( pFunc->szName )); + wSize += wLocalsLen; } hb_compGenPCode3( HB_P_PUSHBLOCK, HB_LOBYTE( wSize ), HB_HIBYTE( wSize ), ( BOOL ) 0 ); @@ -3874,24 +3853,47 @@ void hb_compCodeBlockEnd( void ) { wPos = hb_compVariableGetPos( pFunc->pLocals, pVar->szName ); hb_compGenPCode2( HB_LOBYTE( wPos ), HB_HIBYTE( wPos ), ( BOOL ) 0 ); - - pFree = pVar; - pVar = pVar->pNext; - hb_xfree( ( void * ) pFree ); } if( hb_comp_bDebugInfo ) { BYTE * pBuffer; - pBuffer = ( BYTE * ) hb_xgrab( 3 + strlen( hb_comp_files.pLast->szFileName ) + strlen( hb_comp_functions.pLast->szName ) ); + pBuffer = ( BYTE * ) hb_xgrab( 3 + strlen( hb_comp_files.pLast->szFileName ) + strlen( pFunc->szName ) ); pBuffer[0] = HB_P_MODULENAME; memcpy( ( BYTE * ) ( &( pBuffer[1] ) ), ( BYTE * ) hb_comp_files.pLast->szFileName, strlen( hb_comp_files.pLast->szFileName ) ); pBuffer[ strlen( hb_comp_files.pLast->szFileName ) + 1 ] = ':'; - memcpy( ( BYTE * ) ( &( pBuffer[ strlen( hb_comp_files.pLast->szFileName ) + 2 ] ) ), ( BYTE * ) hb_comp_functions.pLast->szName, strlen( hb_comp_functions.pLast->szName ) + 1 ); - hb_compGenPCodeN( pBuffer, 3 + strlen( hb_comp_files.pLast->szFileName ) + strlen( hb_comp_functions.pLast->szName ), 0 ); + memcpy( ( BYTE * ) ( &( pBuffer[ strlen( hb_comp_files.pLast->szFileName ) + 2 ] ) ), ( BYTE * ) pFunc->szName, strlen( pFunc->szName ) + 1 ); + hb_compGenPCodeN( pBuffer, 3 + strlen( hb_comp_files.pLast->szFileName ) + strlen( pFunc->szName ), 0 ); hb_xfree( pBuffer ); + + /* generate the name of reference local variables */ + pVar = pCodeblock->pStatics; + iLocalPos = -1; + while( wLocalsCnt-- ) + { + pBuffer = ( BYTE * ) hb_xgrab( strlen( pVar->szName ) + 4 ); + + pBuffer = ( BYTE * ) hb_xgrab( strlen( pVar->szName ) + 4 ); + + pBuffer[0] = HB_P_LOCALNAME; + pBuffer[1] = HB_LOBYTE( iLocalPos ); + pBuffer[2] = HB_HIBYTE( iLocalPos ); + iLocalPos--; + + memcpy( ( BYTE * ) ( & ( pBuffer[3] ) ), pVar->szName, strlen( pVar->szName ) + 1 ); + + hb_compGenPCodeN( pBuffer, strlen( pVar->szName ) + 4 , 0 ); + + hb_xfree( pBuffer ); + + pFree = pVar; + + pVar = pVar->pNext; + hb_xfree( ( void * ) pFree ); + } + } hb_compGenPCodeN( pCodeblock->pCode, pCodeblock->lPCodePos, ( BOOL ) 0 ); diff --git a/harbour/source/debug/dbgmenu.prg b/harbour/source/debug/dbgmenu.prg index 03e0efd135..8e2fd1bebe 100644 --- a/harbour/source/debug/dbgmenu.prg +++ b/harbour/source/debug/dbgmenu.prg @@ -53,10 +53,11 @@ #include "hbclass.ch" #xcommand MENU [] => [ := ] TDbMenu():New() -#xcommand MENUITEM [ PROMPT ] [ ACTION ] ; +#xcommand MENUITEM [ PROMPT ] ; + [ IDENT ] [ ACTION ] ; [ ] => ; [ := ] TDbMenu():AddItem( TDbMenuItem():New( ,; - [{|Self|}] ,[<.checked.>] ) ) + [{|Self|}] ,[<.checked.>], [] ) ) #xcommand SEPARATOR => TDbMenu():AddItem( TDbMenuItem():New( "-" ) ) #xcommand ENDMENU => ATail( TDbMenu():aMenus ):Build() @@ -69,12 +70,13 @@ function __dbgBuildMenu( oDebugger ) // Builds the debugger pulldown menu local oPublic, oPrivate, oStatic, oLocal, oAll, oSort local oCallStack local oCBTrace + local oPPo MENU oMenu MENUITEM " ~File " MENU MENUITEM " ~Open..." ACTION oDebugger:Open() - MENUITEM " ~Resume" ACTION oDebugger:NotSupported() + MENUITEM " ~Resume" ACTION oDebugger:Resume() MENUITEM " O~S Shell" ACTION oDebugger:OSShell() SEPARATOR MENUITEM " e~Xit Alt-X " ACTION oDebugger:Exit(), oDebugger:Hide(), __Quit() @@ -116,10 +118,10 @@ function __dbgBuildMenu( oDebugger ) // Builds the debugger pulldown menu MENUITEM " ~Point " MENU - MENUITEM " ~Watchpoint..." ACTION oDebugger:AddWatchpoint() - MENUITEM " ~Tracepoint..." ACTION oDebugger:NotSupported() + MENUITEM " ~Watchpoint..." ACTION oDebugger:WatchpointAdd() + MENUITEM " ~Tracepoint..." ACTION oDebugger:TracepointAdd() MENUITEM " ~Breakpoint F9 " ACTION oDebugger:ToggleBreakPoint() - MENUITEM " ~Delete..." ACTION oDebugger:DelWatchpoint() + MENUITEM " ~Delete..." ACTION oDebugger:WatchpointDel() ENDMENU MENUITEM " ~Monitor " @@ -147,7 +149,8 @@ function __dbgBuildMenu( oDebugger ) // Builds the debugger pulldown menu MENUITEM " ~Options " MENU - MENUITEM " ~Preprocessed Code" ACTION oDebugger:NotSupported() + MENUITEM oPPo PROMPT " ~Preprocessed Code" IDENT "PPO"; + ACTION (IIF( oDebugger:OpenPPO(), oPPo:Toggle(), NIL)) MENUITEM oLineNumbers PROMPT " ~Line Numbers" ; ACTION ( oDebugger:LineNumbers(), oLineNumbers:Toggle() ) CHECKED MENUITEM " ~Exchange Screens" ACTION oDebugger:NotSupported() diff --git a/harbour/source/debug/dbgtmenu.prg b/harbour/source/debug/dbgtmenu.prg index e6b20739be..ba61dc260d 100644 --- a/harbour/source/debug/dbgtmenu.prg +++ b/harbour/source/debug/dbgtmenu.prg @@ -82,6 +82,7 @@ CLASS TDbMenu /* debugger menu */ METHOD EvalAction() METHOD GetHotKeyPos( nKey ) METHOD GetItemOrdByCoors( nRow, nCol ) + METHOD GetItemByIdent( uIdent ) METHOD GoBottom() METHOD GoDown() INLINE ::aItems[ ::nOpenPopup ]:bAction:GoRight() METHOD GoLeft() @@ -264,6 +265,19 @@ METHOD GetItemOrdByCoors( nRow, nCol ) CLASS TDbMenu return 0 +METHOD GetItemByIdent( uIdent ) CLASS TDbMenu + + local n + + for n := 1 to Len( ::aItems ) + if VALTYPE(::aItems[ n ]:Ident) == VALTYPE(uIdent) .AND.; + ::aItems[n]:Ident == uIdent + return ::aItems[ n ] + endif + next + +return NIL + METHOD GoBottom() CLASS TDbMenu local oPopup diff --git a/harbour/source/debug/dbgtmitm.prg b/harbour/source/debug/dbgtmitm.prg index d996ae27eb..c831cc6053 100644 --- a/harbour/source/debug/dbgtmitm.prg +++ b/harbour/source/debug/dbgtmitm.prg @@ -63,6 +63,7 @@ CLASS TDbMenuItem DATA cPrompt DATA bAction DATA lChecked + DATA Ident METHOD New( cPrompt, bAction, lChecked ) METHOD Display( cClrText, cClrHotKey ) @@ -70,7 +71,7 @@ CLASS TDbMenuItem ENDCLASS -METHOD New( cPrompt, bAction, lChecked ) CLASS TDbMenuItem +METHOD New( cPrompt, bAction, lChecked, nIdent ) CLASS TDbMenuItem DEFAULT lChecked TO .f. diff --git a/harbour/source/debug/dbgtwin.prg b/harbour/source/debug/dbgtwin.prg index 9e476343f7..61b88ec0c2 100644 --- a/harbour/source/debug/dbgtwin.prg +++ b/harbour/source/debug/dbgtwin.prg @@ -84,7 +84,8 @@ CLASS TDbWindow // Debugger windows and dialogs METHOD ShowModal() METHOD LButtonDown( nMRow, nMCol ) METHOD LDblClick( nMRow, nMCol ) - METHOD LoadColors() INLINE ::cColor := __DbgColors()[ 1 ] + METHOD LoadColors() + METHOD Move() METHOD KeyPressed( nKey ) METHOD Refresh() @@ -335,3 +336,14 @@ METHOD KeyPressed( nKey ) CLASS TDbWindow endif return nil + +METHOD LoadColors() CLASS TDbWindow +LOCAL aClr:=__DbgColors() + + ::cColor := aClr[ 1 ] + IF( ::Browser!=NIL ) + ::Browser:ColorSpec := aClr[ 2 ] + "," + aClr[ 5 ] + "," + aClr[ 3 ] + ENDIF + +RETURN nil + diff --git a/harbour/source/debug/debugger.prg b/harbour/source/debug/debugger.prg index 107a81e5ef..718702b34a 100644 --- a/harbour/source/debug/debugger.prg +++ b/harbour/source/debug/debugger.prg @@ -77,7 +77,7 @@ /* Information structure hold by DATA aCallStack - aCallStack = { { cFunctionName, aLocalVariables, nStartLine , cPrgName }, ... } */ +*/ #define CSTACK_FUNCTION 1 //function name #define CSTACK_LOCALS 2 //an array with local variables #define CSTACK_LINE 3 //start line @@ -91,6 +91,7 @@ #define VAR_POS 2 #define VAR_TYPE 3 #define VAR_FUNCNAME 4 +#define VAR_LEVEL 5 //eval stack level of the function /* Information structure hold by ::aWatch (watchpoints) */ @@ -98,6 +99,11 @@ #define WP_EXPR 2 //source of an expression #define WP_BLOCK 3 //codeblock to retrieve a value +/* Information structure hold by ::aTrace (tracepoints) +*/ +#define TR_IDX 1 //index into ::aWatch item storing expression +#define TR_VALUE 2 //the current value of the expression + static s_oDebugger static s_lExit := .F. Static nDump @@ -129,6 +135,7 @@ procedure __dbgEntry( nMode, uParam1, uParam2, uParam3 ) // debugger entry poin local cProcName local nVarIndex, cVarName local nAt + LOCAL aTrace, uValue, lSuccess, nLen IF( s_lExit ) RETURN @@ -142,12 +149,35 @@ procedure __dbgEntry( nMode, uParam1, uParam2, uParam3 ) // debugger entry poin do case case nMode == HB_DBG_SHOWLINE + IF( s_oDebugger:lTracepoints ) + nLen := LEN(s_oDebugger:aTrace) + FOR nAt:=1 TO nLen + aTrace := s_oDebugger:aTrace[ nAt ] + uValue := GetWatchValue( s_oDebugger:aWatch[ aTrace[TR_IDX] ], @lSuccess, hb_dbg_ProcLevel()-1 ) + IF( !lSuccess ) + uValue := NIL + ENDIF + IF( (VALTYPE(uValue) != VALTYPE(aTrace[TR_VALUE])) .OR. ; + (uValue != aTrace[TR_VALUE]) ) + aTrace[TR_VALUE] := uValue + s_oDebugger:lTrace :=.F. + s_oDebugger:lCodeblock :=.F. + s_oDebugger:lGo :=.F. + s_oDebugger:lToCursor :=.F. + s_oDebugger:lNextRoutine :=.F. + s_oDebugger:aCallStack[ 1 ][CSTACK_LINE] := uParam1 + s_oDebugger:Activate() + RETURN + ENDIF + NEXT + ENDIF + // set the current line number on the CallStack if s_oDebugger:lTrace //In TRACE mode (step over procedure) IF( s_oDebugger:nProcLevel < Len( s_oDebugger:aCallStack ) ) s_oDebugger:lTrace := (! s_oDebugger:IsBreakPoint( uParam1, s_oDebugger:aCallStack[1][ CSTACK_MODULE ] )) .AND.; - (! InvokeDebug()) + (! HB_DBG_INVOKEDEBUG()) if s_oDebugger:lTrace RETURN ENDIF @@ -163,16 +193,16 @@ procedure __dbgEntry( nMode, uParam1, uParam2, uParam3 ) // debugger entry poin s_oDebugger:lToCursor := .F. ELSE s_oDebugger:lToCursor := (! s_oDebugger:IsBreakPoint( uParam1, s_oDebugger:aCallStack[1][ CSTACK_MODULE ] )) .AND.; - (! InvokeDebug()) + (! HB_DBG_INVOKEDEBUG()) if s_oDebugger:lToCursor RETURN ENDIF ENDIF ENDIF - IF( s_oDebugger:lNextRoutine .AND. !InvokeDebug() ) + IF( s_oDebugger:lNextRoutine .AND. !HB_DBG_INVOKEDEBUG() ) s_oDebugger:lNextRoutine := (! s_oDebugger:IsBreakPoint( uParam1, s_oDebugger:aCallStack[1][ CSTACK_MODULE ] )) .AND.; - (! InvokeDebug()) + (! HB_DBG_INVOKEDEBUG()) if s_oDebugger:lNextRoutine RETURN ENDIF @@ -183,14 +213,14 @@ procedure __dbgEntry( nMode, uParam1, uParam2, uParam3 ) // debugger entry poin endif IF( s_oDebugger:lCodeblock ) + s_oDebugger:lCodeblock := .F. IF( !s_oDebugger:lCBTrace ) - s_oDebugger:lCodeblock := .F. RETURN ENDIF ENDIF s_oDebugger:aCallStack[ 1 ][CSTACK_LINE] := uParam1 - if !s_oDebugger:lGo .or. InvokeDebug() + if !s_oDebugger:lGo .or. HB_DBG_INVOKEDEBUG() s_oDebugger:lGo := .F. s_oDebugger:Activate() endif @@ -205,15 +235,16 @@ procedure __dbgEntry( nMode, uParam1, uParam2, uParam3 ) // debugger entry poin s_oDebugger:lNextRoutine :=.F. ENDIF endif - s_oDebugger:StackProc( uParam1 ) - s_oDebugger:LoadVars() + s_oDebugger:StackProc( uParam1, hb_dbg_ProcLevel()-1 ) +// s_oDebugger:LoadVars() case nMode == HB_DBG_LOCALNAME - cProcName := ProcName( 1 ) + cProcName := IIF(s_oDebugger:lCodeblock, s_oDebugger:aCallStack[1][CSTACK_FUNCTION], ProcName( 1 )) nVarIndex := uParam1 cVarName := IIF(valtype(uParam2)=='C',uParam2,'NIL') - - AAdd( s_oDebugger:aCallStack[ 1 ][ CSTACK_LOCALS ], { cVarName, nVarIndex, "Local", cProcName } ) + nAt := hb_dbg_ProcLevel()-1 + AAdd( s_oDebugger:aCallStack[ 1 ][ CSTACK_LOCALS ], ; + { cVarName, nVarIndex, "Local", cProcName, nAt } ) if s_oDebugger:lShowLocals if ( nAt := AScan( s_oDebugger:aVars,; // Is there another var with this name ? { | aVar | aVar[ 1 ] == cVarName } ) ) != 0 @@ -263,7 +294,7 @@ procedure __dbgEntry( nMode, uParam1, uParam2, uParam3 ) // debugger entry poin s_oDebugger:lCodeblock := .F. endif s_oDebugger:EndProc() - s_oDebugger:LoadVars() +// s_oDebugger:LoadVars() endcase @@ -278,7 +309,7 @@ CLASS TDebugger DATA cImage DATA cAppImage, nAppRow, nAppCol, cAppColors, nAppCursor DATA aBreakPoints, aCallStack, aColors - DATA aWatch, aTracePoints + DATA aWatch, aTrace, lTracepoints DATA aLastCommands, nCommand, oGetListCommand DATA lAnimate, lEnd, lCaseSensitive, lMonoDisplay, lSortVars DATA cSearchString, cPathForFiles, cSettingsFileName, aPathDirs @@ -295,6 +326,7 @@ CLASS TDebugger DATA aToCursor DATA lNextRoutine INIT .F. DATA oBrwPnt, oWndPnt + DATA lppo INIT .F. //view preprocessed output METHOD New() METHOD Activate() @@ -336,6 +368,8 @@ CLASS TDebugger METHOD MonoDisplay() METHOD NextWindow() METHOD Open() + METHOD OpenPPO() + METHOD Resume() INLINE IIF( LEN(::aCallStack[1])>0, ::ShowCodeLine( ::aCallStack[1][ CSTACK_LINE ], ::aCallStack[1][ CSTACK_MODULE ] ), NIL) METHOD OSShell() METHOD PathForFiles() @@ -392,11 +426,17 @@ CLASS TDebugger METHOD ToggleCaseSensitive() INLINE ::lCaseSensitive := ! ::lCaseSensitive METHOD ShowWorkAreas() INLINE __dbgShowWorkAreas( Self ) - METHOD AddWatchpoint() - METHOD DelWatchpoint() - METHOD ShowWatchpoints() - METHOD HideWatchpoints() - METHOD EditWatch( nVar ) + METHOD TracepointAdd( cExpr ) + METHOD WatchpointAdd( cExpr ) + METHOD WatchpointDel( nPos ) + METHOD WatchpointsShow() + METHOD WatchpointsHide() + METHOD WatchpointEdit( nVar ) + METHOD WatchGetInfo( aVar ) + + METHOD VarGetInfo( aVar ) + METHOD VarGetValue( aVar ) + METHOD VarSetValue( aVar, uValue ) METHOD NotSupported() INLINE Alert( "Not implemented yet!" ) @@ -416,7 +456,8 @@ METHOD New() CLASS TDebugger ::lTrace := .f. ::aBreakPoints := {} ::aWatch := {} - ::aTracePoints := {} + ::aTrace := {} + ::lTracepoints := .F. ::aCallStack := {} ::lGo := .T. //Clipper compatible ::aVars := {} @@ -476,12 +517,12 @@ METHOD Activate() CLASS TDebugger if ::lShowCallStack ::ShowCallStack() endif - ::loadVars() - ::ShowVars() // ::RestoreAppStatus() ENDIF + ::loadVars() + ::ShowVars() IF( ::oWndPnt != NIL ) - ::ShowWatchpoints() + ::WatchpointsShow() ENDIF // new function ShowCodeLine( nline, cFilename) ::ShowCodeLine( ::aCallStack[1][ CSTACK_LINE ], ::aCallStack[1][ CSTACK_MODULE ] ) @@ -637,6 +678,7 @@ METHOD CallStackProcessKey( nKey ) CLASS TDebugger endcase if lUpdate + ::LoadVars() // jump to source line for a function if ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_LINE ] != nil ::ShowCodeLine( ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_LINE ], ::aCallStack[ ::oBrwStack:Cargo ][ CSTACK_MODULE ] ) @@ -782,8 +824,8 @@ METHOD CommandWindowProcessKey( nKey ) CLASS TDebugger case Empty( cCommand ) lDisplay = .f. - case SubStr( LTrim( cCommand ), 1, 3 ) == "?? " .or. ; - SubStr( LTrim( cCommand ), 1, 2 ) == "? " + case SubStr( LTrim( cCommand ), 1, 2 ) == "??" .or. ; + SubStr( LTrim( cCommand ), 1, 1 ) == "?" lDisplay := !Empty( cResult := DoCommand( Self,cCommand ) ) case Upper( SubStr( LTrim( cCommand ), 1, 4 ) ) == "ANIM" .or. ; @@ -813,6 +855,16 @@ METHOD CommandWindowProcessKey( nKey ) CLASS TDebugger SetCursor( SC_NORMAL ) lDisplay = .f. + case Upper( SubStr( LTrim( cCommand ), 1, 3 ) ) == "WP " + //add watchpoint + ::WatchpointAdd( SUBSTR( LTRIM(cCommand), 3 ) ) + lDisplay = .f. + + case Upper( SubStr( LTrim( cCommand ), 1, 3 ) ) == "TP " + //add tracepoint + ::TracepointAdd( SUBSTR( LTRIM(cCommand), 3 ) ) + lDisplay = .f. + otherwise cResult = "Command error" lDisplay = .t. @@ -847,7 +899,7 @@ METHOD EditColor( nColor, oBrwColors ) CLASS TDebugger local lPrevScore := Set( _SET_SCOREBOARD, .f. ) local lPrevExit := Set( _SET_EXIT, .t. ) local cColor := PadR( '"' + ::aColors[ nColor ] + '"',; - oBrwColors:aColumns[ 2,1 ]:Width ) + oBrwColors:getColumn(2):Width ) oBrwColors:RefreshCurrent() oBrwColors:ForceStable() @@ -876,13 +928,16 @@ METHOD EditSet( nSet, oBrwSets ) CLASS TDebugger local GetList := {} local lPrevScore := Set( _SET_SCOREBOARD, .f. ) local lPrevExit := Set( _SET_EXIT, .t. ) - local cSet := PadR( ValToStr( Set( nSet ) ), oBrwSets:aColumns[ 2 ]:Width ) + local cSet := PadR( ValToStr( Set( nSet ) ), oBrwSets:getColumn(2):Width ) + local cType := VALTYPE(SET(nSet)) oBrwSets:RefreshCurrent() oBrwSets:ForceStable() SetCursor( SC_NORMAL ) - @ Row(), Col() GET cSet COLOR SubStr( ::ClrModal(), 5 ) + @ Row(), Col()+13 GET cSet COLOR SubStr( ::ClrModal(), 5 ) ; + VALID iif( Type(cSet) != cType, (Alert( "Must be of type '"+cType+"'" ), .f. ), .t. ) + READ SetCursor( SC_NONE ) @@ -899,25 +954,81 @@ METHOD EditSet( nSet, oBrwSets ) CLASS TDebugger return nil +METHOD VarGetValue( aVar ) CLASS TDebugger +LOCAL nProcLevel, uValue +LOCAL cProc + + IF( aVar[ VAR_TYPE ] = "L" ) + nProcLevel := hb_dbg_procLevel() - aVar[ VAR_LEVEL ] + cProc := aVar[ VAR_FUNCNAME ] +/* + IF( cProc = '(b)' ) + //get local var defined in a codeblock + DO WHILE !((cProc:=ProcName( nProcLevel )) == "__EVAL" .OR. cProc == "EVAL" ) + nProcLevel++ + ENDDO + ELSE + DO WHILE( !((uValue:=ProcName( nProcLevel )) == cProc) ) + nProcLevel++ + ENDDO + ENDIF +*/ + uValue := hb_dbg_vmVarLGet( nProcLevel, aVar[ VAR_POS ] ) + + ELSEIF( aVar[ VAR_TYPE ] = "S" ) + uValue := hb_dbg_vmVarSGet( aVar[ VAR_POS ] ) + + ELSE + //Public or Private + uValue := aVar[ VAR_POS ] + ENDIF + +RETURN uValue + + +METHOD VarSetValue( aVar, uValue ) CLASS TDebugger +LOCAL nProcLevel +LOCAL cProc + + IF( aVar[ VAR_TYPE ] = "L" ) + nProcLevel := hb_dbg_procLevel() - aVar[VAR_LEVEL] //skip debugger stack + cProc := aVar[ VAR_FUNCNAME ] +/* + IF( cProc = '(b)' ) + //get local var defined in a codeblock + DO WHILE !((cProc:=ProcName( nProcLevel )) == "__EVAL" .OR. cProc == "EVAL" ) + nProcLevel++ + ENDDO + ELSE + DO WHILE( !(ProcName( nProcLevel ) == cProc) ) + nProcLevel++ + ENDDO + ENDIF +*/ + hb_dbg_vmVarLSet( nProcLevel, aVar[ VAR_POS ], uValue ) + + ELSEIF( aVar[ VAR_TYPE ] = "S" ) + hb_dbg_vmVarSSet( aVar[ VAR_POS ], uValue ) + + ELSE + //Public or Private + aVar[ VAR_POS ] := uValue + &( aVar[ VAR_NAME ] ) := uValue + + ENDIF + +RETURN self + + METHOD EditVar( nVar ) CLASS TDebugger local cVarName := ::aVars[ nVar ][ 1 ] local uVarValue := ::aVars[ nVar ][ 2 ] local cVarType := ::aVars[ nVar ][ 3 ] - local nProcLevel := 1 local aArray local cVarStr - if ::aVars[ nVar ][ 3 ] == "Local" - while ProcName( nProcLevel ) != ::aVars[ nVar ][ 4 ] - nProcLevel++ - end - uVarValue := __vmVarLGet( nProcLevel, ::aVars[ nVar ][ 2 ] ) - endif - - if ::aVars[ nVar ][ 3 ] == "Static" - uVarValue := __vmVarSGet( ::aVars[ nVar ][ 2 ] ) - endif + uVarValue := ::VarGetValue( ::aVar[ nVar ] ) do case case ValType( uVarValue ) == "A" @@ -933,50 +1044,19 @@ METHOD EditVar( nVar ) CLASS TDebugger if LastKey() != K_ESC do case - case cVarStr == "{ ... }" - cVarType := ::aVars[ nVar ][ 3 ] + case cVarStr == "{ ... }" + // aArray := ::VarGetValue( ::aVars[ nVar ] ) + if Len( aArray ) > 0 + __DbgArrays( uVarValue, cVarName ) + else + Alert( "Array is empty" ) + endif - do case - case cVarType == "Local" - aArray := __vmVarLGet( nProcLevel, ::aVars[ nVar ][ 2 ] ) + case Upper( SubStr( cVarStr, 1, 5 ) ) == "CLASS" + __DbgObject( uVarValue, cVarName ) - case cVarType == "Static" - aArray := __vmVarSGet( ::aVars[ nVar ][ 2 ] ) - - otherwise - aArray := ::aVars[ nVar ][ 2 ] - endcase - - if Len( aArray ) > 0 - __DbgArrays( aArray, cVarName ) - else - Alert( "Array is empty" ) - endif - - case Upper( SubStr( cVarStr, 1, 5 ) ) == "CLASS" - do case - case cVarType == "Local" - __DbgObject( __vmVarLGet( nProcLevel, ::aVars[ nVar ][ 2 ] ), cVarName ) - - case cVarType == "Static" - __DbgObject( __vmVarSGet( ::aVars[ nVar ][ 2 ] ), cVarName ) - - otherwise - __DbgObject( ::aVars[ nVar ][ 2 ], cVarName ) - endcase - - otherwise - do case - case cVarType == "Local" - __vmVarLSet( nProcLevel, ::aVars[ nVar ][ 2 ], &cVarStr ) - - case cVarType == "Static" - __vmVarSSet( ::aVars[ nVar ][ 2 ], &cVarStr ) - - otherwise - ::aVars[ nVar ][ 2 ] := &cVarStr - &( ::aVars[ nVar ][ 1 ] ) := ::aVars[ nVar ][ 2 ] - endcase + otherwise + ::VarSetValue( ::aVar[ nVar ], &cVarStr ) endcase endif @@ -1006,7 +1086,7 @@ METHOD HandleEvent() CLASS TDebugger if ::nSpeed != 0 Inkey( ::nSpeed / 10 ) endif - if InvokeDebug() //NextKey() == K_ALT_D + if HB_DBG_INVOKEDEBUG() //NextKey() == K_ALT_D ::lAnimate := .f. else KEYBOARD Chr( 255 ) // Forces a Step(). Only 0-255 range is supported @@ -1092,7 +1172,8 @@ METHOD HandleEvent() CLASS TDebugger ::Exit() */ case nKey == K_UP .or. nKey == K_DOWN .or. nKey == K_HOME .or. ; - nKey == K_END .or. nKey == K_ENTER .or. nKey == K_PGDN .or. nKey == K_PGUP + nKey == K_END .or. nKey == K_ENTER .or. nKey == K_PGDN .or. ; + nKey == K_PGUP .OR. nKey == K_DEL oWnd := ::aWindows[ ::nCurrentWindow ] oWnd:KeyPressed( nKey ) @@ -1463,7 +1544,7 @@ METHOD ShowVars() CLASS TDebugger if ::oWndVars == nil - ::LoadVars() +// ::LoadVars() nTop := IIF(::oWndPnt!=NIL .AND. ::oWndPnt:lVisible,::oWndPnt:nBottom+1,1) ::oWndVars := TDbWindow():New( nTop, 0, nTop+Min( 5, Len( ::aVars )+1 ),; @@ -1501,7 +1582,7 @@ METHOD ShowVars() CLASS TDebugger oCol:=TBColumnNew( "", ; { || PadR( If( Len( ::aVars ) > 0, ; AllTrim( Str( ::oBrwVars:Cargo[1] -1 ) ) + ") " + ; - GetVarInfo( ::aVars[ Max( ::oBrwVars:Cargo[1], 1 ) ] ), ; + ::VarGetInfo( ::aVars[ Max( ::oBrwVars:Cargo[1], 1 ) ] ), ; " " ), ; ::oWndVars:nWidth() - 2 ) } ) ::oBrwVars:AddColumn( oCol ) @@ -1523,8 +1604,9 @@ METHOD ShowVars() CLASS TDebugger else - ::LoadVars() +// ::LoadVars() + ::oBrwVars:cargo[1] :=1 ::oWndVars:cCaption := "Monitor:" + ; iif( ::lShowLocals, " Local", "" ) + ; iif( ::lShowStatics, " Static", "" ) + ; @@ -1569,27 +1651,26 @@ METHOD ShowVars() CLASS TDebugger return nil -static function GetVarInfo( aVar ) - - local nProcLevel := 1 +METHOD VarGetInfo( aVar ) CLASS TDebugger +LOCAL uValue + uValue := ::VarGetValue( aVar ) do case - case aVar[ 3 ] == "Local" - while ProcName( nProcLevel ) != aVar[ 4 ] - nProcLevel++ - end - return aVar[ 1 ] + " : " + ValToStr( __vmVarLGet( nProcLevel, aVar[ 2 ] ) ) + case aVar[ VAR_TYPE ] = "L" + return aVar[ VAR_NAME ] + " : " + ValToStr( uValue ) - case aVar[ 3 ] == "Public" .or. aVar[ 3 ] == "Private" - return aVar[ 1 ] + " <" + aVar[ 3 ] + ", " + ValType( aVar[ 2 ] ) + ; - ">: " + ValToStr( aVar[ 2 ] ) + case aVar[ VAR_TYPE ] = "S" + return aVar[ VAR_NAME ] + " : " + ValToStr( uValue ) + + OTHERWISE + return aVar[ VAR_NAME ] + " <" + aVar[ VAR_TYPE ] + ", " + ; + ValType( uValue ) + ; + ">: " + ValToStr( uValue ) - case aVar[ 3 ] == "Static" - return aVar[ 1 ] + " : " + ValToStr( __vmVarSGet( aVar[ 2 ] ) ) endcase return "" @@ -1599,7 +1680,7 @@ static function CompareLine( Self ) return { | a | a[ 1 ] == Self:oBrwText:nRow } // it was nLine -METHOD StackProc(cModuleName) CLASS TDebugger +METHOD StackProc( cModuleName ) CLASS TDebugger // always treat filename as lower case - we need it consistent for comparisons LOCAL nPos:=RAT( ":", cModuleName ) @@ -1615,13 +1696,23 @@ METHOD StackProc(cModuleName) CLASS TDebugger return nil METHOD ShowCodeLine( nLine, cPrgName ) CLASS TDebugger +LOCAL nPos + // we only update the stack window and up a new browse // to view the code if we have just broken execution if !::lGo .AND. !::lTrace if ::oWndStack != nil ::oBrwStack:RefreshAll() endif - + + if( ::lppo ) + nPos :=RAT(".PRG", UPPER(cPrgName) ) + IF( nPos > 0 ) + cPrgName := LEFT( cPrgName, nPos-1 ) + ".ppo" + ELSE + cPrgName += cPrgName +".ppo" + ENDIF + endif if cPrgName != ::cPrgName if ! File( cPrgName ) .and. ! Empty( ::cPathForFiles ) cPrgName := ::LocatePrgPath( cPrgName ) @@ -1643,23 +1734,64 @@ METHOD ShowCodeLine( nLine, cPrgName ) CLASS TDebugger return nil METHOD Open() CLASS TDebugger +LOCAL cFileName := ::InputBox( "Please enter the filename", Space( 255 ) ) +LOCAL cPrgName - local cFileName := ::InputBox( "Please enter the filename", Space( 30 ) ) + cFileName:= ALLTRIM( cFileName ) if (cFileName != ::cPrgName .OR. valtype(::cPrgName)=='U') + if ! File( cFileName ) .and. ! Empty( ::cPathForFiles ) + cFileName := ::LocatePrgPath( cFileName ) + endif ::cPrgName := cFileName + ::lppo := RAT(".PPO", UPPER(cFilenAME)) > 0 + ::lPulldown:GetItemByIdent( "PPO" ):lChecked := ::lppo ::oBrwText := nil ::oBrwText := TBrwText():New( ::oWndCode:nTop + 1, ::oWndCode:nLeft + 1,; - ::oWndCode:nBottom - 1, ::oWndCode:nRight - 1, ::cPathForFiles+::cPrgName,; + ::oWndCode:nBottom - 1, ::oWndCode:nRight - 1, cFileName,; __DbgColors()[ 2 ] + "," + __DbgColors()[ 5 ] + "," + ; __DbgColors()[ 3 ] + "," + __DbgColors()[ 6 ] ) - ::oWndCode:Browser := ::oBrwText ::RedisplayBreakpoints() // check for breakpoints in this file and display them ::oWndCode:SetCaption( ::cPrgName ) ::oWndCode:Refresh() // to force the window caption to update endif + return nil +METHOD OpenPPO() CLASS TDebugger +LOCAL nPos +LOCAL lSuccess:=.F. + + nPos := RAT(".PPO", UPPER(::cPrgName)) + IF( nPos == 0 ) + nPos := RAT(".PRG", UPPER(::cPrgName)) + IF( nPos > 0 ) + ::cPrgName := LEFT(::cPrgName,nPos-1) + ".ppo" + ELSE + ::cPrgName += ".ppo" + ENDIF + lSuccess := FILE(::cPrgName) + ::lppo := lSuccess + ELSE + ::cPrgName := LEFT(::cPrgName,nPos-1) + ".prg" + lSuccess := FILE( ::cPrgName ) + ::lppo := !lSuccess + ENDIF + + IF( lSuccess ) + ::oBrwText := nil + ::oBrwText := TBrwText():New( ::oWndCode:nTop + 1, ::oWndCode:nLeft + 1,; + ::oWndCode:nBottom - 1, ::oWndCode:nRight - 1, ::cPrgName,; + __DbgColors()[ 2 ] + "," + __DbgColors()[ 5 ] + "," + ; + __DbgColors()[ 3 ] + "," + __DbgColors()[ 6 ] ) + ::oWndCode:Browser := ::oBrwText + ::RedisplayBreakpoints() // check for breakpoints in this file and display them + ::oWndCode:SetCaption( ::cPrgName ) + ::oWndCode:Refresh() // to force the window caption to update + endif + +return lSuccess + // check for breakpoints in the current file and display them METHOD RedisplayBreakPoints() CLASS TDebugger @@ -1900,6 +2032,7 @@ METHOD Local() CLASS TDebugger ::lShowLocals := ! ::lShowLocals if ::lShowPublics .or. ::lShowPrivates .or. ::lShowStatics .or. ::lShowLocals + ::LoadVars() ::ShowVars() else ::HideVars() @@ -1912,6 +2045,7 @@ METHOD Private() CLASS TDebugger ::lShowPrivates := ! ::lShowPrivates if ::lShowPublics .or. ::lShowPrivates .or. ::lShowStatics .or. ::lShowLocals + ::LoadVars() ::ShowVars() else ::HideVars() @@ -1924,6 +2058,7 @@ METHOD Public() CLASS TDebugger ::lShowPublics := ! ::lShowPublics if ::lShowPublics .or. ::lShowPrivates .or. ::lShowStatics .or. ::lShowLocals + ::LoadVars() ::ShowVars() else ::HideVars() @@ -2070,6 +2205,7 @@ METHOD Static() CLASS TDebugger ::lShowStatics := ! ::lShowStatics if ::lShowPublics .or. ::lShowPrivates .or. ::lShowStatics .or. ::lShowLocals + ::LoadVars() ::ShowVars() else ::HideVars() @@ -2143,7 +2279,7 @@ METHOD ViewSets() CLASS TDebugger oWndSets:bPainted := { || oBrwSets:ForceStable(),RefreshVarsS(oBrwSets)} oWndSets:bKeyPressed := { | nKey | SetsKeyPressed( nKey, oBrwSets, Len( aSets ),; oWndSets, "System Settings",; - { || ::EditSet( n, oBrwSets ) } ) } + { || ::EditSet( oBrwSets:Cargo[1], oBrwSets ) } ) } SetCursor( SC_NONE ) oWndSets:ShowModal() @@ -2399,28 +2535,65 @@ METHOD NextRoutine() CLASS TDebugger RETURN self -METHOD AddWatchpoint() CLASS TDebugger -LOCAL cExpr:=SPACE(255) -LOCAL bExpr +METHOD WatchpointAdd( cExpr ) CLASS TDebugger +LOCAL cErr LOCAL aWatch - cExpr := ALLTRIM( ::InputBox( "Enter Watchpoint", cExpr ) ) + IF( cExpr == NIL ) + cExpr:=SPACE(255) + cExpr := ALLTRIM( ::InputBox( "Enter Watchpoint", cExpr ) ) + IF( LASTKEY() == K_ESC ) + RETURN self + ENDIF + ENDIF + cExpr := ALLTRIM( cExpr ) IF( EMPTY(cExpr) ) RETURN self ENDIF aWatch := {"wp", cExpr, NIL} - aWatch[WP_BLOCK] := CreateExpression( cExpr, aWatch ) - IF( aWatch[WP_BLOCK] == NIL ) - ALERT( "Expression error" ) + cErr := CreateExpression( cExpr, aWatch ) + IF( !EMPTY(cErr) ) + ALERT( cErr ) RETURN self ENDIF AADD( ::aWatch, aWatch ) - ::ShowWatchpoints() + ::WatchpointsShow() + +RETURN self + +METHOD TracepointAdd( cExpr ) CLASS TDebugger +LOCAL cErr +LOCAL aWatch +LOCAL lSuccess +LOCAL uValue + + IF( cExpr == NIL ) + cExpr:=SPACE(255) + cExpr := ALLTRIM( ::InputBox( "Enter Tracepoint", cExpr ) ) + IF( LASTKEY() == K_ESC ) + RETURN self + ENDIF + ENDIF + cExpr := ALLTRIM( cExpr ) + IF( EMPTY(cExpr) ) + RETURN self + ENDIF + aWatch := {"tp", cExpr, NIL} + cErr := CreateExpression( cExpr, aWatch ) + IF( !EMPTY(cErr) ) + ALERT( cErr ) + RETURN self + ENDIF + AADD( ::aWatch, aWatch ) + uValue := GetWatchValue( aWatch, @lSuccess ) + AADD( ::aTrace, { LEN(::aWatch), IIF(lSuccess, uValue, NIL )} ) + ::lTracepoints :=.T. + ::WatchpointsShow() RETURN self -METHOD ShowWatchPoints() CLASS TDebugger +METHOD WatchPointsShow() CLASS TDebugger local nWidth, n := 1 Local oCol @@ -2472,7 +2645,7 @@ METHOD ShowWatchPoints() CLASS TDebugger oCol:=TBColumnNew( "", ; { || PadR( IIF( LEN( ::aWatch ) > 0, ; AllTrim( Str( ::oBrwPnt:Cargo[1] -1 ) ) + ") " + ; - GetWatchInfo( ::aWatch[ Max( ::oBrwPnt:Cargo[1], 1 ) ] ), ; + ::WatchGetInfo( ::aWatch[ Max( ::oBrwPnt:Cargo[1], 1 ) ] ), ; " " ), ; ::oWndPnt:nWidth() - 2 ) } ) ::oBrwPnt:AddColumn( oCol ) @@ -2490,7 +2663,8 @@ METHOD ShowWatchPoints() CLASS TDebugger , iif( nKey == K_PGUP, ::oBrwPnt:PageUp(), nil ) ; , iif( nKey == K_HOME, ::oBrwPnt:GoTop(), nil ) ; , iif( nKey == K_END, ::oBrwPnt:GoBottom(), nil ) ; - , iif( nKey == K_ENTER, ::EditWatch( ::oBrwPnt:Cargo[1] ), nil ), ::oBrwPnt:ForceStable() ) } + , iif( nKey == K_DEL, ::WatchpointDel( ::oBrwPnt:Cargo[1] ), nil ) ; + , iif( nKey == K_ENTER, ::WatchpointEdit( ::oBrwPnt:Cargo[1] ), nil ), ::oBrwPnt:ForceStable() ) } else if( ::oBrwPnt:cargo[1] <= 0 ) @@ -2534,27 +2708,59 @@ METHOD ShowWatchPoints() CLASS TDebugger return nil -METHOD EditWatch( nPos ) CLASS TDebugger +METHOD WatchpointEdit( nPos ) CLASS TDebugger +LOCAL cExpr +LOCAL aWatch +LOCAL cErr - ::NotSupported() + cExpr:=PADR( ::aWatch[nPos][WP_EXPR], 255 ) + cExpr := ALLTRIM( ::InputBox( "Enter Watchpoint", cExpr ) ) + IF( LASTKEY() == K_ESC ) + RETURN self + ENDIF + cExpr := ALLTRIM( cExpr ) + IF( EMPTY(cExpr) ) + RETURN self + ENDIF + aWatch := {"wp", cExpr, NIL} + cErr := CreateExpression( cExpr, aWatch ) + IF( !EMPTY(cErr) ) + ALERT( cErr ) + RETURN self + ENDIF + ::aWatch[ nPos ] := aWatch + ::WatchpointsShow() RETURN self -METHOD DelWatchpoint() CLASS TDebugger -LOCAL nPos +METHOD WatchpointDel( nPos ) CLASS TDebugger +LOCAL nIdx IF( ::oWndPnt != NIL .AND. ::oWndPnt:lVisible ) - nPos := ::InputBox( "Enter item number to delete", ::oBrwPnt:cargo[1]-1 ) + IF( nPos == NIL ) + //called from the menu + nPos := ::InputBox( "Enter item number to delete", ::oBrwPnt:cargo[1]-1 ) + ELSE + nPos-- + ENDIF IF( LastKey() != K_ESC ) IF( nPos >=0 .AND. nPos < LEN(::aWatch) ) + ::oBrwPnt:gotop() + IF( ::aWatch[nPos+1][WP_TYPE] == "tp" ) + nIdx := ASCAN( ::aTrace, {|a| a[TR_IDX]==nPos+1} ) + IF( nIdx > 0 ) + ADEL( ::aTrace[nIdx] ) + ASIZE( ::aTrace, LEN(::aTrace)-1 ) + ::lTracepoints := LEN(::aTrace) > 0 + ENDIF + ENDIF ADEL( ::aWatch, nPos+1 ) ASIZE( ::aWatch, LEN(::aWatch)-1 ) - ::oBrwPnt:gotop() IF( LEN(::aWatch) == 0 ) - ::HideWatchpoints() + ::WatchpointsHide() ELSE - ::ShowWatchpoints() + ::WatchpointsShow() ENDIF ENDIF ENDIF @@ -2563,7 +2769,7 @@ LOCAL nPos RETURN self -METHOD HideWatchpoints() CLASS TDebugger +METHOD WatchpointsHide() CLASS TDebugger ::oWndPnt:Hide() ::oWndCode:nTop := IIF(::oWndVars!=NIL .AND. ::oWndVars:lVisible, ::oWndVars:nBottom+1,1) @@ -2575,16 +2781,16 @@ METHOD HideWatchpoints() CLASS TDebugger return nil -STATIC FUNCTION GetWatchInfo( aWatch ) +STATIC FUNCTION GetWatchValue( aWatch, plSuccess ) LOCAL aVars, i, j LOCAL nLen LOCAL cVar, nPos, cProc -LOCAL xVal, cType +LOCAL xVal +LOCAL oErr LOCAL bEBlock - xVal := "Undefined" - cType := 'U' - bEblock := ErrorBlock( {|| BREAK()} ) + plSuccess := .F. + bEblock := ErrorBlock( {|o| BREAK(o)} ) BEGIN SEQUENCE IF( aWatch[WP_BLOCK] != NIL ) nLen :=LEN(aWatch)-WP_BLOCK @@ -2595,23 +2801,32 @@ LOCAL bEBlock //search local variables in current procedure nPos := ASCAN( s_oDebugger:aCallStack[1][CSTACK_LOCALS], {|a| a[VAR_NAME]==cVar} ) IF( nPos > 0 ) - j :=1 + j :=hb_dbg_ProcLevel() - s_oDebugger:aCallStack[1][CSTACK_LOCALS][ nPos ][ VAR_LEVEL ] +/* cProc := s_oDebugger:aCallStack[1][CSTACK_LOCALS][nPos][VAR_FUNCNAME] - while ProcName( j ) != cProc - j++ - end - aVars[i] := __vmVarLGet( j, s_oDebugger:aCallStack[1][CSTACK_LOCALS][ nPos ][ VAR_POS ] ) + IF( cProc = '(b)' ) + //get local var defined in a codeblock + DO WHILE !((cProc:=ProcName( j )) == "__EVAL" .OR. cProc == "EVAL" ) + j++ + ENDDO + ELSE + DO WHILE( ProcName( j ) != cProc ) + j++ + ENDDO + ENDIF +*/ + aVars[i] := hb_dbg_vmVarLGet( j, s_oDebugger:aCallStack[1][CSTACK_LOCALS][ nPos ][ VAR_POS ] ) ELSE //search local statics nPos := ASCAN( s_oDebugger:aCallStack[1][CSTACK_STATICS], {|a| a[VAR_NAME]==cVar} ) IF( nPos > 0 ) - aVars[i] := __vmVarSGet( s_oDebugger:aCallStack[1][CSTACK_STATICS][ nPos ][ 2 ] ) + aVars[i] := hb_dbg_vmVarSGet( s_oDebugger:aCallStack[1][CSTACK_STATICS][ nPos ][ 2 ] ) ELSE //search global statics FOR j:=1 TO LEN(__dbgStatics) nPos := ASCAN( __dbgStatics[j][ 2 ], {|c| c==cVar} ) IF( nPos > 0 ) - aVars[i] :=__vmVarSGet(__dbgStatics[j][1]+nPos ) + aVars[i] :=hb_dbg_vmVarSGet(__dbgStatics[j][1]+nPos ) EXIT ENDIF NEXT @@ -2623,13 +2838,32 @@ LOCAL bEBlock NEXT ENDIF - xVal := EVAL( aWatch[WP_BLOCK], aVars ) - cType := VALTYPE(xVal) - xVal := ValToStr( xVal ) + xVal := EVAL( aWatch[WP_BLOCK], aVars ) + plSuccess :=.T. ENDIF + + RECOVER USING oErr + xVal := oErr:description END SEQUENCE ErrorBlock( bEBlock ) +RETURN xVal + +METHOD WatchGetInfo( aWatch ) CLASS TDebugger +LOCAL xVal +LOCAL ctype +LOCAL lValid + + xVal := GetWatchValue( aWatch, @lValid ) + IF( lValid ) + cType := VALTYPE( xVal ) + xVal := ValToStr( xVal ) + ELSE + //xVal contains error description + cType := 'U' +// xVal := "Undefined" + ENDIF + RETURN aWatch[WP_EXPR]+" <"+aWatch[WP_TYPE]+", " +cType+">: " +xVal @@ -2639,7 +2873,7 @@ LOCAL i,j LOCAL c, lSpace LOCAL cID, cBV, nPos LOCAL oErr, oEBlock -LOCAL bExpr +LOCAL cRet nLen := LEN(cExpr) i := j := 1 @@ -2721,14 +2955,15 @@ LOCAL bExpr // s_oDebugger:InputBox("AFTER", cExpr ) oEBlock := ErrorBlock( {|o| BREAK(o)} ) BEGIN SEQUENCE - bExpr := &( "{|__dbg|"+ cExpr +"}" ) + aWatch[WP_BLOCK] := &( "{|__dbg|"+ cExpr +"}" ) + cRet := NIL RECOVER USING oErr - ALERT( "Expression error: " +oErr:description ) - bExpr := NIL + cRet := "Expression error: " +oErr:description + aWatch[WP_BLOCK] := NIL END SEQUENCE ErrorBlock( oEBlock ) -RETURN bExpr +RETURN cRet STATIC FUNCTION IsIdentChar( cChar, cSeeAlso ) @@ -2843,61 +3078,50 @@ static function ArrayBrowseSkip( nPos, oBrwSets, n ) return iif( oBrwSets:cargo[ 1 ] + nPos < 1, 0 - oBrwSets:cargo[ 1 ] + 1 , ; iif( oBrwSets:cargo[ 1 ] + nPos > Len(oBrwSets:cargo[ 2 ][ 1 ]), ; Len(oBrwSets:cargo[ 2 ][ 1 ]) - oBrwSets:cargo[ 1 ], nPos ) ) - + +/* + ?? + displays inspect window with value or display nothing on error + ? + displays either result or error description in command window +*/ static function DoCommand( o,cCommand ) - local bLastHandler, cResult, nLocals := len( o:aCallStack[1][CSTACK_LOCALS] ) - local nProcLevel := 1, oE, i, vtmp +LOCAL aCmnd +LOCAL cResult +LOCAL lValid - if nLocals > 0 - while ProcName( nProcLevel ) != o:aCallStack[1][CSTACK_LOCALS][1][VAR_FUNCNAME] - nProcLevel++ - enddo - for i := 1 to nLocals - __mvPrivate( o:aCallStack[1][CSTACK_LOCALS][i][ VAR_NAME ] ) - __mvPut( o:aCallStack[1][CSTACK_LOCALS][i][ VAR_NAME ], ; - __vmVarLGet( nProcLevel, o:aCallStack[1][CSTACK_LOCALS][i][ VAR_POS ] ) ) - next - endif + cCommand := ALLTRIM( cCommand ) + aCmnd := { NIL, NIL, NIL } + IF( cCommand = "??" ) + cCommand := SUBSTR( cCommand, 3 ) + aCmnd[WP_TYPE] := "??" + + ELSEIF( cCommand = "?" ) + cCommand := SUBSTR( cCommand, 2 ) + aCmnd[WP_TYPE] := "?" + ENDIF + aCmnd[WP_EXPR] := cCommand + cResult := CreateExpression( cCommand, aCmnd ) + IF( EMPTY(cResult) ) + //valid syntax + cResult := GetWatchValue( aCmnd, @lValid ) + IF( aCmnd[WP_TYPE] == "??" ) + IF( lValid ) + o:Inspect( aCmnd[WP_EXPR], cResult ) + ENDIF + cResult := '' //discard result + ELSE + IF( lValid ) + cResult := ValToStr( cResult ) + ENDIF + ENDIF + ELSE + IF( aCmnd[WP_TYPE] == "??" ) + cResult := '' //ignore error + ENDIF + ENDIF - bLastHandler := ErrorBlock({ |objErr| BREAK (objErr) }) - - - // clipper does not require a space in the command, though it allows it - if SubStr( LTrim( cCommand ), 1, 2 ) == "??" - - begin sequence - o:Inspect( AllTrim( SubStr( LTrim( cCommand ), 3 ) ),; - &( AllTrim( SubStr( LTrim( cCommand ), 3 ) ) ) ) - cResult := "" - recover using oE - cResult = "Command error: " + oE:description - end sequence - - elseif SubStr( LTrim( cCommand ), 1, 1 ) == "?" - - begin sequence - cResult := ValToStr( &( AllTrim( SubStr( LTrim( cCommand ), 2 ) ) ) ) - - recover using oE - cResult := "Command error: " + oE:description - - end sequence - - else - cResult := "Command error" - - endif - - ErrorBlock(bLastHandler) - - for i := 1 to nLocals - vtmp := __mvGet( o:aCallStack[1][CSTACK_LOCALS][i][ VAR_NAME ] ) - if !(Valtype( vtmp ) $ "AO") - __vmVarLSet( nProcLevel, o:aCallStack[1][CSTACK_LOCALS][i][ VAR_POS ], vtmp ) - endif - next - -Return cResult +RETURN cResult static function PathToArray( cList ) diff --git a/harbour/source/debug/tbrwtext.prg b/harbour/source/debug/tbrwtext.prg index 1e2221d77e..3771dfe27c 100644 --- a/harbour/source/debug/tbrwtext.prg +++ b/harbour/source/debug/tbrwtext.prg @@ -72,6 +72,9 @@ CLASS TBrwText FROM HBEditor DATA lLineNumbers // If .T. source code lines are preceded by their number + ACCESS colorSpec INLINE ::cColorSpec + ASSIGN colorSpec(cClr) INLINE ::cColorSpec:=cClr + METHOD New(nTop, nLeft, nBottom, nRight, cFileName, cColor) METHOD GoTop() // Methods available on a standard TBrowse, needed to handle a HBEditor like a TBrowse diff --git a/harbour/source/vm/debug.c b/harbour/source/vm/debug.c index e8f589eef3..90b096d9ac 100644 --- a/harbour/source/vm/debug.c +++ b/harbour/source/vm/debug.c @@ -97,7 +97,7 @@ static USHORT hb_stackLenGlobal( void ) return uiCount; } -HB_FUNC( __VMSTKGCOUNT ) +HB_FUNC( HB_DBG_VMSTKGCOUNT ) { hb_retni( hb_stackLenGlobal() ); } @@ -106,7 +106,7 @@ HB_FUNC( __VMSTKGCOUNT ) * $FuncName$ __vmStkGList() * $Description$ Returns the global stack * $End$ */ -HB_FUNC( __VMSTKGLIST ) +HB_FUNC( HB_DBG_VMSTKGLIST ) { PHB_ITEM pReturn; PHB_ITEM * pItem; @@ -142,7 +142,7 @@ static USHORT hb_stackLen( int iLevel ) return uiCount; } -HB_FUNC( __VMSTKLCOUNT ) +HB_FUNC( HB_DBG_VMSTKLCOUNT ) { int iLevel = hb_parni( 1 ) + 1; @@ -160,7 +160,7 @@ HB_FUNC( __VMSTKLCOUNT ) * [x+1 .. y] Locals * [y+1 ..] Pushed data * $End$ */ -HB_FUNC( __VMSTKLLIST ) +HB_FUNC( HB_DBG_VMSTKLLIST ) { PHB_ITEM pReturn; PHB_ITEM * pItem; @@ -184,7 +184,7 @@ HB_FUNC( __VMSTKLLIST ) /* TODO : put bLocals / bParams */ /* somewhere for declared parameters */ /* and locals */ -HB_FUNC( __VMPARLLIST ) +HB_FUNC( HB_DBG_VMPARLLIST ) { int iLevel = hb_parni( 1 ) + 1; PHB_ITEM * pBase = hb_stack.pBase; @@ -204,24 +204,50 @@ HB_FUNC( __VMPARLLIST ) hb_itemRelease( hb_itemReturn( pReturn ) ); } -HB_FUNC( __VMVARLGET ) +static void hb_dbgStop() +{ +} + +HB_FUNC( HB_DBG_VMVARLGET ) { int iLevel = hb_parni( 1 ) + 1; + int iLocal = hb_parni( 2 ); PHB_ITEM * pBase = hb_stack.pBase; while( ( iLevel-- > 0 ) && pBase != hb_stack.pItems ) pBase = hb_stack.pItems + ( *pBase )->item.asSymbol.stackbase; - hb_itemReturn( hb_itemUnRef( *(pBase + 1 + hb_parni( 2 )) ) ); + if( iLocal > SHRT_MAX ) + { + hb_dbgStop(); + iLocal -= USHRT_MAX; + iLocal--; + } + if( iLocal >= 0 ) + hb_itemReturn( hb_itemUnRef( *(pBase + 1 + iLocal) ) ); + else + hb_itemReturn( hb_codeblockGetVar( *(pBase+1), ( LONG ) iLocal ) ); } -HB_FUNC( __VMVARLSET ) +HB_FUNC( HB_DBG_VMVARLSET ) { int iLevel = hb_parni( 1 ) + 1; + int iLocal = hb_parni( 2 ); PHB_ITEM * pBase = hb_stack.pBase; + PHB_ITEM pLocal; while( ( iLevel-- > 0 ) && pBase != hb_stack.pItems ) pBase = hb_stack.pItems + ( *pBase )->item.asSymbol.stackbase; - hb_itemCopy( hb_itemUnRef(*(pBase + 1 + hb_parni( 2 ))), *(hb_stack.pBase + 4) ); + if( iLocal > SHRT_MAX ) + { + iLocal -= USHRT_MAX; + iLocal--; + } + if( iLocal >= 0 ) + pLocal = *(pBase + 1 + iLocal); + else + pLocal = hb_codeblockGetVar( *(pBase+1), ( LONG ) iLocal ); + + hb_itemCopy( hb_itemUnRef(pLocal), *(hb_stack.pBase + 4) ); } diff --git a/harbour/source/vm/hvm.c b/harbour/source/vm/hvm.c index b3b84bd4d9..64846bb3c5 100644 --- a/harbour/source/vm/hvm.c +++ b/harbour/source/vm/hvm.c @@ -245,6 +245,10 @@ static LONG s_lRecoverBase; #define HB_RECOVER_ADDRESS -3 #define HB_RECOVER_VALUE -4 +/* Stores level of procedures call stack +*/ +static ULONG s_ulProcLevel = 0; + int hb_vm_aiExtraParams[HB_MAX_MACRO_ARGS], hb_vm_iExtraParamsIndex = 0; PHB_SYMB hb_vm_apExtraParamsSymbol[HB_MAX_MACRO_ARGS]; @@ -3258,7 +3262,8 @@ void hb_vmDo( USHORT uiParams ) /* printf( "\VmDo nItems: %i Params: %i Extra %i\n", hb_stack.pPos - hb_stack.pBase, uiParams, hb_vm_aiExtraParams[hb_vm_iExtraParamsIndex - 1] ); */ - + s_ulProcLevel++; + if( hb_vm_iExtraParamsIndex && HB_IS_SYMBOL( pItem = hb_stackItemFromTop( -( uiParams + hb_vm_aiExtraParams[hb_vm_iExtraParamsIndex - 1] + 2 ) ) ) && pItem->item.asSymbol.value == hb_vm_apExtraParamsSymbol[hb_vm_iExtraParamsIndex - 1] ) { uiParams += hb_vm_aiExtraParams[--hb_vm_iExtraParamsIndex]; @@ -3420,6 +3425,7 @@ void hb_vmDo( USHORT uiParams ) hb_vmDebuggerEndProc(); s_bDebugging = bDebugPrevState; + s_ulProcLevel--; } void hb_vmSend( USHORT uiParams ) @@ -3440,6 +3446,7 @@ void hb_vmSend( USHORT uiParams ) printf( "\n VmSend nItems: %i Params: %i Extra %i\n", hb_stack.pPos - hb_stack.pBase, uiParams, hb_vm_aiExtraParams[hb_vm_iExtraParamsIndex - 1] ); */ + s_ulProcLevel++; if( hb_vm_iExtraParamsIndex && HB_IS_SYMBOL( pItem = hb_stackItemFromTop( -( uiParams + hb_vm_aiExtraParams[hb_vm_iExtraParamsIndex - 1] + 2 ) ) ) && pItem->item.asSymbol.value == hb_vm_apExtraParamsSymbol[hb_vm_iExtraParamsIndex - 1] ) { uiParams += hb_vm_aiExtraParams[--hb_vm_iExtraParamsIndex]; @@ -3648,6 +3655,7 @@ void hb_vmSend( USHORT uiParams ) } s_bDebugging = bDebugPrevState; + s_ulProcLevel--; } static HARBOUR hb_vmDoBlock( void ) @@ -5014,13 +5022,17 @@ ULONG hb_vmFlagEnabled( ULONG flags ) return s_VMFlags & (flags); } +/* ------------------------------------------------------------------------ */ +/* The debugger support functions */ +/* ------------------------------------------------------------------------ */ + void hb_vmRequestDebug( void ) { HB_TRACE(HB_TR_DEBUG, ("hb_vmRequestDebug()")); s_bDebugRequest = TRUE; } -HB_FUNC( INVOKEDEBUG ) +HB_FUNC( HB_DBG_INVOKEDEBUG ) { BOOL bRequest = s_bDebugRequest; s_bDebugRequest = FALSE; @@ -5031,7 +5043,7 @@ HB_FUNC( INVOKEDEBUG ) * $FuncName$ __vmVarSList() * $Description$ Return the statics array. Please aClone before assignments * $End$ */ -HB_FUNC( __VMVARSLIST ) +HB_FUNC( HB_DBG_VMVARSLIST ) { PHB_ITEM pStatics = hb_arrayClone( &s_aStatics, NULL ); @@ -5043,7 +5055,7 @@ HB_FUNC( __VMVARSLIST ) * $FuncName$ __vmVarSLen() * $Description$ Return the statics array length. * $End$ */ -HB_FUNC( __VMVARSLEN ) +HB_FUNC( HB_DBG_VMVARSLEN ) { hb_retnl( s_aStatics.item.asArray.value->ulLen ); } @@ -5052,7 +5064,7 @@ HB_FUNC( __VMVARSLEN ) * $FuncName$ __vmVarSGet() * $Description$ Return a specified statics * $End$ */ -HB_FUNC( __VMVARSGET ) +HB_FUNC( HB_DBG_VMVARSGET ) { /* hb_itemReturn( s_aStatics.item.asArray.value->pItems + hb_stack.iStatics + hb_parni( 1 ) - 1 ); */ @@ -5064,12 +5076,17 @@ HB_FUNC( __VMVARSGET ) * $FuncName$ __vmVarSSet(,) * $Description$ Sets the value of a specified statics * $End$ */ -HB_FUNC( __VMVARSSET ) +HB_FUNC( HB_DBG_VMVARSSET ) { hb_itemCopy( s_aStatics.item.asArray.value->pItems + hb_parni( 1 ) - 1, * ( hb_stack.pBase + 3 ) ); } +HB_FUNC( HB_DBG_PROCLEVEL ) +{ + hb_retnl( s_ulProcLevel - 1 ); /* Don't count self */ +} + /* ------------------------------------------------------------------------ */ /* The garbage collector interface */ /* ------------------------------------------------------------------------ */