'callstack' macro

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
Tigra
Posts: 155
Joined: Jan 07, 2007 17:21

'callstack' macro

Postby Tigra » Jul 12, 2007 13:09

I'm still working on my little 'pretty printer' program and occasionally get a mysterious crash, "my bad" as it is said.

I was finding it difficult to find which module/function was the cause, so I cobbled together a simple callstack routine.

I've written it as an include file and a module that must be linked in or compiled in.

The macros are only active when compiled with -g.

Suggestions, improvements, etc, are welcome.

Tigra

Code: Select all

'   callstk.bi
'   last at: 788
'   last date: 2007-07-12 08:58:36

#ifndef CALLSTK_BI

#define CALLSTK_BI

#if __FB_DEBUG__

Type fwdTCallstackEntry As TCallstackEntry

Type TCallstack
   Public:
      As Integer callstackDepth
      As fwdTCallstackEntry Ptr Ptr cs
      Declare Constructor()
      Declare Destructor()
      Declare Sub Push( ByVal cse as fwdTCallstackEntry Ptr )
      Declare Sub Pop( ByVal cse as fwdTCallstackEntry Ptr )
End Type

Common Shared As TCallstack Ptr callstack

Type TCallstackEntry
   Public:
      As TCallstack Ptr cs
      As Integer callstackDepth
      As String Filename
      As String fname
      As Integer lineno
      Declare Constructor ( ByVal fi As String, ByVal fn As String, ByVal ln As Integer, ByRef cs As TCallstack Ptr )
      Declare Destructor()
End Type

#define _join_(a,b) a##b

#macro CallstackPush()
   Dim As TCallstackEntry _join_(__callstackentry__,__LINE__) = TCallstackEntry( __FILE__, __FUNCTION__, __LINE__, callstack )
#endmacro

#macro CallstackNote(Note)
   ' the line number is incremented inside the TCallstackEntry ctor, so the -1 makes it zero
   Dim As TCallstackEntry _join_(__callstackentry__,__LINE__) = TCallstackEntry( Note, "", -1, callstack )
#endmacro

#macro CallstackInitialize()
   callstack = new TCallstack()
#endmacro

#macro CallstackTerminate()
   delete(callstack)
#endmacro

#else

#macro CallstackPush()
#endmacro

#macro CallstackNote(Note)
#endmacro

#macro CallstackInitialize()
#endmacro

#macro CallstackTerminate()
#endmacro

#endif


Code: Select all

'   callstk.bas
'   last at: 575
'   last date: 2007-07-12 08:53:57

#if __FB_DEBUG__

#include once "callstk.bi"

Constructor TCallstack()
   cs = 0
   callstackDepth = 0
End Constructor

Destructor TCallstack()
   ''~ For i as integer = callstackDepth - 1 To 0 Step -1
   For i as integer = 0 to callstackDepth - 1
      If cs[i]->lineno > 0 Or cs[i]->fname <> "" Then
         print cs[i]->Filename & ":" & cs[i]->lineno & ": " & cs[i]->fname
      Else
         print cs[i]->Filename
      End If
   Next
   Delete(cs)
End Destructor

Sub TCallstack.Push( ByVal cse as fwdTCallstackEntry Ptr )
   callstackDepth += 1
   cs = reallocate(cs, callstackDepth * len(cse) )
   cs[ callstackDepth-1 ] = cse
End Sub

Sub TCallstack.Pop( ByVal cse as fwdTCallstackEntry Ptr )
   cse->cs = 0
   If cse->callstackDepth <= callstackDepth Then
      callstackDepth = cse->callstackDepth - 1
      cs = reallocate(cs, callstackDepth * len(cse) )
   End If
End Sub

Private Function InStrRev ( ByVal Expression As String, ByVal FindExpression As String, ByVal Start As Integer = 1, ByVal LastIndex As Integer = -1) As Integer
   If Start < 1 Then Start = 1
   If LastIndex < 1 Or LastIndex > Len(Expression) Then LastIndex = Len(Expression)+1
   InStrRev = 0
   Do
      Start = InStr( Start, Expression, FindExpression )
      If Start > LastIndex Then Exit Function
      If Start <> 0 Then InStrRev = Start: Start += 1
   Loop While Start <> 0
End Function

Constructor TCallstackEntry ( ByVal fi As String, ByVal fn As String, ByVal ln As Integer, ByRef cs As TCallstack Ptr )
   this.cs = cs
   this.callstackDepth = cs->callstackDepth + 1
   this.Filename = Mid$(fi, InStrRev(fi, "/") + 1)
   this.fname = fn
   this.lineno = ln+1
   cs->Push @this
End Constructor

Destructor TCallstackEntry ()
   this.cs->Pop @this
End Destructor

#else

#endif


Code: Select all

'   test-cs.bas
'   last at: 552
'   last date: 2007-07-12 09:05:44

' fbc test-cs.bas callstk.bas
' fbc --d ABORT_TEST=1  est-cs.bas callstk.bas
' fbc -g test-cs.bas callstk.bas
' fbc -g -d ABORT_TEST=1 test-cs.bas callstk.bas

#include once "callstk.bi"

Private Sub StartOfApp Constructor
   CallstackInitialize()
End Sub

Private Sub EndOfApp Destructor
   Print "Cleanup..."
   CallstackTerminate()
End Sub

private sub two()
   CallstackPush()
   CallstackNote("I am here")
   Scope
      CallstackNote("I am inside ")
#if ABORT_TEST
      Error 0
#endif
   End Scope
End Sub

private sub one()
   CallstackPush()
   two()
end sub

CallstackPush()

one()

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest