Follow us on Facebook
Follow us on Twitter
Signalogic on LinkedIn

Source code example for real-time VoIp packet processing

Source Code Home

' Edited / streamlined VB source code example for real-time VoIP processing
' using SigC54xx systems
' Streamlined for Technical Support Purposes:  28 Jun 2001, JHB
' Copyright (C) Signalogic 1999-2001


' variables and definitions

' operating mode

Global Const REALTIME = 1
Global Const SIMULATION = 2
 
Public OpMode As Integer  ' set to one of above values
 

' MELP functional mode

Global Const ANA_SYN = 1
Global Const ANALYSIS = 2
Global Const SYNTHESIS = 4

Public MelpMode As Integer  ' set to one of above values


' System output mode

Global Const ASCII = 1
Global Const TIM = 2
Global Const SERIAL_PORT = 4
Global Const WAV = 8
Global Const ANALOG = &H10

Public InMode As Integer   ' set to one or combination of above values
Public OutMode As Integer  '    ""


' Audio Loopback operation

Global Const LOOPBACK_ENABLED = 1
Global Const LOOPBACK_DISABLED = 0

Public AudioLoopback As Integer  ' set to one of above values


' physical addresses of DSP properties (see DSGetSymbolAddr function references)

Public getframe_addr As Long
Public sendframe_addr As Long
Public getcoeff_addr As Long
Public sendcoeff_addr As Long

Public speech_in_addr As Long
Public speech_out_addr As Long
Public chbuf_addr As Long

Public bzyflg_addr As Long
Public melpflg_addr As Long
Public melp_mode_addr As Long
Public audio_loopback_addr As Long

Public op_mode_addr As Long

Public flag_addr As Long


'misc

Public gNewSound() As Integer

' define memory buffer pointers

Public inbufk As Long
Public outbufk As Long
Public coeff_inbufk As Long
Public coeff_outbufk As Long
 


' host code and SigC54xx board initialization

Function Initialize() As Boolean

Dim hWnd As Long
Dim szBoard As String * 150
Dim rc As Long
Dim wBoardClass As Integer
Dim initflag As Boolean
Dim w As Integer
Dim wProcList As Integer
Dim i, nIndex As Integer
Dim HwEntry As HWLISTENTRY
   


   hBoard = 0
   hEngine = 0
   RunState = 0
   nCurBuf = 0
    
   initflag = True
    
  ' rc = DSInitToolLib()  ' only necessary if Toollib objects are being used;
                          ' not the case for most VB and MFC programs

   DSShowEngMgrStatusWindow  ' show Engine Manager status message window

   Call DSAddEngMgrStatusLine(ByVal "Starting Algorithm IDE")  ' add a "here we
                                                               ' are" line to
                                                               ' status window

 ' display Hardware Manager driver-selection dialog
   
   hWnd = DSShowHardwareSelectorDlg(0, szBoard)
    
   If (hWnd = IDCANCEL) Then
      Initialize = False
      Exit Function
   End If


 ' open driver or Engine Manager; try Hypersignal-Macro first
    
   hEngine = DSEngineOpen(ByVal DS_EO_HSM, ByVal 0&, NUL)
  
   If (hEngine = NUL) Then
   
      initflag = False
      GoTo Abort
   End If


 ' assign board handle
    
   hBoard = DSAssignBoard(hEngine, ByVal szBoard, 0, 0, 0)
   
   If (hBoard = NUL) Then
      initflag = False
      GoTo Abort
   End If

    
 ' set module site #1 on board as active  (assumes SigC54xx processor
 ' module is inserted into module site #1)
 
   rc = DSWriteBoardReg(hBoard, &HB, 1)


 ' deal with number of processors
   
   nIndex = DSGetHWMgrEntryIndex(szBoard) ' get index of entry matching szBoard

   rc = DSGetHWMgrEntry(nIndex, HwEntry) ' read entry into HWLISTENTRY structure
   
   wProcList = 0
   
   For i = 0 To HwEntry.NumProcessors - 1
      wProcList = wProcList * 2 Or 1
   Next
   

 ' init processor(s)
 '
 ' note:  for algorithm IDE, if module is 3-processor module, then init
 '        processors 1 and 2 also,
 '        to take them in/out of reset leave them idling with no PLL multiplier
 '        and reduce power consumption

   rc = DSInitProcessor(hBoard, wProcList)
   
   If rc <= 0 Then
      initflag = False
      GoTo Abort
   End If
   
   wBoardClass = DSGetBoardClass(hBoard)
    
   rc = DSGetMemArch(hBoard)
   If rc <= 0 Then initflag = False


 ' load DSP program file specified in DSP/Analog Hardware Manager dialog box
 ' to one or more processors
    
   rc = DSLoadFileProcessor(hBoard, ByVal 0&, &H1)
   
   If rc <= 0 Then
      
      MsgBox "DSP code file was not loaded"
      initflag = False
      GoTo Abort
   End If
    
   rc = DSGetMemSize(hBoard, &H1)      ' not needed; example only
   If rc <= 0 Then initflag = False
    
   rc = DSSetProcessorList(hBoard, &H1)  ' this was already set by last
                                         ' DSLoadFileProcessor, DSInitProcessor,
   If rc <= 0 Then initflag = False      ' DSResetProcessor call, but can do it
                                         ' any time using DSSetProcessorList
                                         ' function

 ' set the message blaster (MSGBLAST.VBX) to capture buffer ready messages
 ' from the DSP engine

   WndProc.hWndTarget = frmConfig.hWnd
   WndProc.MsgList(0) = WM_DSPENGINE_BUFRDY
 
 ' register handle of graph window with engine, to receive "buffer ready"
 ' messages
   
   rc = DSRegisterEngineMsgWnd(hEngine, DS_REMW_SETDSPDATARDYMSG, _         
frmConfig.hWnd)  ' register callback window for buffer ready messages


Abort:

   If initflag = False Then
      MsgBox ("Board Initialization Failed")
      HardwareCleanup
      Initialize = False
      Exit Function
   End If


 ' get physical addresses from the DSP program COFF file (symbol table area);
 ' this avoids modifying host-side code when DSP code changes
   
   speech_out_addr = DSGetSymbolAddress(hBoard, ByVal NUL, "_spee_out")
   speech_in_addr = DSGetSymbolAddress(hBoard, ByVal NUL, "_speech_in")

   chbuf_addr = DSGetSymbolAddress(hBoard, ByVal NUL, "_chbuf")

   bzyflg_addr = DSGetSymbolAddress(hBoard, ByVal NUL, "_bzyflg")
   melpflg_addr = DSGetSymbolAddress(hBoard, ByVal NUL, "_melpflg")
   
   flag_addr = DSGetSymbolAddress(hBoard, ByVal NUL, "BZYADD")
   melp_mode_addr = DSGetSymbolAddress(hBoard, ByVal NUL, "_melpmode")
   op_mode_addr = DSGetSymbolAddress(hBoard, ByVal NUL, "_opmode")
   audio_loopback_addr = DSGetSymbolAddress(hBoard, ByVal NUL, _                
                             "_audio_loopback")
   
   getframe_addr = DSGetSymbolAddress(hBoard, ByVal NUL, "_getframeaddr")
   sendframe_addr = DSGetSymbolAddress(hBoard, ByVal NUL, "_sendframeaddr")
   getcoeff_addr = DSGetSymbolAddress(hBoard, ByVal NUL, "_getcoeffaddr")
   sendcoeff_addr = DSGetSymbolAddress(hBoard, ByVal NUL, "_sendcoeffaddr")

   
   Initialize = True
    
End Function


Sub RunMode()

   Dim bzyflgval As Integer
   Dim flagval As Integer
   Dim w As Integer
   
   Dim i, j, k, rc, ret As Long
   Dim FRAMESIZE As Long
   Dim FsDesired, FsActual as Single
   Dim dwFsMode As Long, dwFsActual As Long
   Dim ChanList(MAXCHANNELS) As Integer
   Dim szChanList, szChan, szChar As String
   Dim chan As Integer
   Dim fRange As Boolean

   
   If (RunState = 0) Then
  
    ' initialize channel list to default
    
      For j = 0 To (MAXCHANNELS - 1)
         ChanList(j) = j
      Next
      
      
    ' initialize algorithm data

      If OpMode = REALTIME Then
         
         Fs = CSng(frmConfig.txtSampFreqRT)
         BufferSize = CLng(frmConfig.txtBufferSize)
         
         szChanList = frmConfig.txtChanListRT
         szChan = ""
         fRange = False
         k = 0
         
         For j = 1 To Len(szChanList)
          
            szChar = Mid(szChanList, j, 1)
            
            If (szChar >= "0") And (szChar <= "9") Then
               
               szChan = szChan + szChar
               
               If j = Len(szChanList) Then GoTo ChanCheck
               
            ElseIf Len(szChan) > 0 Then
               
ChanCheck:     chan = CInt(szChan)

               If (fRange = True) Then
                   i = ChanList(k - 1) + 1
               Else
                   i = chan
               End If
                  
               Do While (i <= chan)
                  ChanList(k) = i
                  i = i + 1
                  k = k + 1
               Loop
                  
               If ((szChar = "-") Or (szChar = ".")) And (k > 0) Then
                  fRange = True
               Else
                  fRange = False
               End If
               
               szChan = ""
               
            End If
         Next
         
         NumChan = k
         
      End If
      
      
    ' write properties to DSP/data acquisition board

    ' main type in low byte
      rc = DSPutDSPProperty(hBoard, DSP_BOARDCLASS, wBoardClass And &HFF)
    
    ' subtype in high byte
      rc = DSPutDSPProperty(hBoard, DSP_BOARDSUBCLASS, wBoardClass \ 256)

    ' main operating mode = LBR codec mode
      rc = DSPutDSPProperty(hBoard, DSP_OPMODE, 9)

         
      FRAMESIZE = 180  ' default value for MELP
         
      rc = DSPutDSPProperty(hBoard, DSP_FRMSIZ, FRAMESIZE)

      rc = DSPutDSPProperty(hBoard, DSP_BUFLEN, BufferSize * NumChan)

      ret = DSPutDSPProperty(hBoard, DSP_NUMCHAN, NumChan)  ' number of channels

      w = 0
      For j = 0 To (NumChan - 1)
         w = w Or Shift(ChanList(j), 4 * j)
      Next

      ret = DSPutDSPProperty(hBoard, DSP_CHANLIST, w)       ' channel list
         
      rc = DSPutDSPProperty(hBoard, DSP_SCALEIN, Shift(1&, 8))
      
      ret = DSPutDSPProperty(hBoard, DSP_FILTTYPE1, 0)  ' disable trace 1
                                                        ' real-time filter

      ret = DSPutDSPProperty(hBoard, DSP_FILTTYPE2, 0)  ' disable trace 2
                                                        ' real-time filter

      ret = DSPutDSPProperty(hBoard, DSP_TRIGLEVEL, 0)  ' free-run triggering

      ret = DSPutDSPProperty(hBoard, DSP_TRIGCHANLIST, 0)

      ret = DSPutDSPProperty(hBoard, DSP_HOSTBUFNUM, 0) ' starting buffer
                                                        ' numbers

      ret = DSPutDSPProperty(hBoard, DSP_BUFNUM, 0)     ' set initial buffer
                                                        ' number to zero

      ret = DSPutDSPProperty(hBoard, DSP_GAINLIST, 0)   ' gain list


    ' determine sampling rate ctrl. reg. value, and actual rate (closest rate
    ' possible to desired)
    ' CalcSampFreq returns ctrl. reg. value directly, uses ptr to return actual 
    ' sampling frequency (in Hz)

      FsDesired = 8000  ' default value for MELP

      dwFsMode = DSCalcSampFreq(hBoard, FsDesired, NumChan, ChanList(0), _      
                           FsActual)

      ActualFs.Text = Str$(FsActual)

      ret = DSPutDSPProperty(hBoard, DSP_FSMODE, dwFsMode) ' sampling rate
                                                           ' control register
                                                           ' (mode value)
   
      dwFsActual = FsActual
      ret = DSPutDSPProperty(hBoard, DSP_FSVALUE, dwFsActual) ' actual sampling
                                                              ' rate (in Hz)
      
    ' init flag at DSP
       
      w = 1
      rc = DSPutMem(hBoard, DS_GM_LINEAR_DATA_RT, flag_addr, DS_GM_SIZE16, w, 1)
      

    ' run the DSP(s)

      rc = DSRunProcessor(hBoard, &H1)
 
      CurFrame = 0
      nCurBuf = 0
      RunState = 1  ' initialization, waveform file stored
   
   End If


   frmConfig.List1.AddItem "Real-Time mode enabled"
       
   frmConfig.List1.TopIndex = Max(frmConfig.List1.ListCount - 1, 0)
   
   rc = DSGetMem(hBoard, DS_GM_LINEAR_DATA, flag_addr, DS_GM_SIZE16, flagval, 1)
         
   While (flagval = 1)
   
      frmConfig.List1.AddItem "Waiting for DSP to initialize"
      frmConfig.List1.TopIndex = Max(frmConfig.List1.ListCount - 1, 0)
      rc = DSGetMem(hBoard, DS_GM_LINEAR_DATA, flag_addr, DS_GM_SIZE16, _
                    flagval,  1)
      DoEvents
      
   Wend
    
    
 ' some things to set for MELP operation
         
   rc = DSPutMem(hBoard, DS_GM_LINEAR_DATA_RT, getframe_addr, DS_GM_SIZE32, _
                 inbufk, 1)
         
   rc = DSPutMem(hBoard, DS_GM_LINEAR_DATA_RT, sendframe_addr, DS_GM_SIZE32, _
                 outbufk, 1)
         
   rc = DSPutMem(hBoard, DS_GM_LINEAR_DATA_RT, getcoeff_addr, DS_GM_SIZE32, _
                 coeff_inbufk, 1)
         
   rc = DSPutMem(hBoard, DS_GM_LINEAR_DATA_RT, sendcoeff_addr, DS_GM_SIZE32, _
                 coeff_outbufk, 1)
         
   rc = DSPutMem(hBoard, DS_GM_LINEAR_DATA_RT, melp_mode_addr, DS_GM_SIZE16, _
                 MelpMode, 1)
   
   rc = DSPutMem(hBoard, DS_GM_LINEAR_DATA_RT, op_mode_addr, DS_GM_SIZE16, _
                 OpMode, 1)
 
   rc = DSPutMem(hBoard, DS_GM_LINEAR_DATA_RT, audio_loopback_addr, _
                 DS_GM_SIZE16, AudioLoopback, 1)
 

   w = 0
   
   rc = DSPutMem(hBoard, DS_GM_LINEAR_DATA, bzyflg_addr, DS_GM_SIZE16, w, 1)
 
   rc = DSPutMem(hBoard, DS_GM_LINEAR_DATA, melpflg_addr, DS_GM_SIZE16, w, 1)
   
   
 ' Let DSP free run
 
   rc = DSPutMem(hBoard, DS_GM_LINEAR_DATA, flag_addr, DS_GM_SIZE16, w, 1)
                            
   rc = DSGetMem(hBoard, DS_GM_LINEAR_DATA, bzyflg_addr, DS_GM_SIZE16, _
                 bzyflgval, 1)

   if (bzyflgval <> 0) Then

      frmConfig.List1.AddItem "Sanity check failed; DSP may not be"
      frmConfig.List1.AddItem "  able to access external SRAM using"
      frmConfig.List1.AddItem "  zero-waite state timing"
      frmConfig.List1.TopIndex = Max(frmConfig.List1.ListCount - 1, 0)

   End If
  

 ' if real-time mode, initialize to waiting for WM_BUFREADY message
    
   If (fSerialCommMode or fNetworkMode) Then  ' see WndProc procedure for
                                              ' real-time processing

      ReDim gNewSound(0 To (MAX_PACKET_DELAY + 1) * (NUMCOEFFS + 2)) ' redim for
                                                                     ' max pkt
                                                                     ' delay

      RxJitterBufferOutPtr = MAX_PACKET_DELAY  ' initialize jitter buffer to
                                               ' maximum packet delay
      RxJitterBufferInPtr = 0

      TxPacketCounter = 0
      RxPacketCounter = 0
       
    ' start hardware buffer ready message stream
         
      rc = DSWaitForBuffer(hBoard, nCurBuf, 0&, DS_WFB_POLLED)
         
   End If
  
End Sub


' Hardware Message Processing

' Upload analysis coefficients from DSP and send over sync. serial link or IP
' network
'   and/or
' Download analysis coefficients received from sync. serial link or IP network
' to DSP

' Notes: 1) Message arrives every 22.5 msec, or Framesize/Fs, where Framesize =
' 180 pts, and Fs = 8000 Hz.
'
'        2) Each message indicates a packet is ready (analysis) or a packet can
'           be accepted (synthesis) in half-duplex mode, or both (full-duplex
'           mode).
'
'        3) For full-duplex operation, a packet should be read from DSP board
'           memory (DSGetMem function call, and a packet should be written to
'           DSP board memory (DSPutMem function call).
'
'        4) The DS_GM_DIRECTACCESS attribute used in the DSxxxMem calls is used
'           for faster driver operation.


Private Sub WndProc_Message(MsgVal As Integer, wParam As Integer, lParam As _
                            Long, ReturnVal As Long)

   Dim ret As Integer
   Dim fStatus As Boolean
   Dim Index As Integer

   
 ' process buffer ready messages from DirectDSP driver / engine
 
   If (MsgVal = WM_DSPENGINE_BUFRDY) Then
      
      If (fSerialCommMode or fNetWorkMode) Then  ' read one packet from DSP
                                                 ' board and transmit
      
       ' get compressed speech packet from DSP board
       
         If (RunState = 1) Then

            ret = DSGetMem(hBoard, DS_GM_LINEAR_PROGRAM Or DS_GM_DIRECTACCESS, _
                           chbuf_addr, DS_GM_SIZE16, gNewSound(0), NUMCOEFFS)
         End If
         
       ' Tx:  send over sync. serial output
     
'         fStatus = SendSerial(1)
         fStatus = SendNetwork(1)
         
         If (fStatus) Then
      
            If ((TxPacketCounter Mod 100) = 0) Then
      
               frmConfig.List1.AddItem "Tx data frame " & CStr(TxPacketCounter)
               frmConfig.List1.TopIndex = Max(frmConfig.List1.ListCount - 1, 0)
            End If
      
          ' always increment packet counter
    
            TxPacketCounter = TxPacketCounter + 1
            
         End If
         
      End If
      
      If (fSerialCommMode or fNetworkMode) Then  ' get one packet from jitter
                                                 ' buffer and write to DSP board
       
       ' check for packet overrun
       
         If (RxJitterBufferOutPtr = RxJitterBufferInPtr) Then
    
            frmConfig.List1.AddItem "Rx jitter buffer overrun"
            frmConfig.List1.TopIndex = Max(frmConfig.List1.ListCount - 1, 0)
         End If
    
    
       ' Rx:  take next packet out of jitter buffer, write to DSP
       
         Index = (NUMCOEFFS + 2) * RxJitterBufferOutPtr
         
         If (RunState = 1) Then

            ret = DSPutMem(hBoard, DS_GM_LINEAR_PROGRAM Or DS_GM_DIRECTACCESS, _
                           chbuf_addr, DS_GM_SIZE16, gNewSound(Index), _
                           NUMCOEFFS)

         End If
         
       ' toggle output jitter buffer
       
         RxJitterBufferOutPtr = RxJitterBufferOutPtr + 1

         If (RxJitterBufferOutPtr > MAX_PACKET_DELAY) Then _
           RxJitterBufferOutPtr = 0
   
         Index = (NUMCOEFFS + 2) * RxJitterBufferInPtr
       
      End If

      
      If (RunState <> 0) Then
         
       ' instruct engine to wait for next buffer
   
         nCurBuf = nCurBuf Xor 1  ' toggle buffer number
      
         ret = DSWaitForBuffer(hBoard, nCurBuf, 0&, DS_WFB_POLLED)
      
      End If
      
   End If
    
End Sub


' Hardware Cleanup Code--should be done at program close or abort

Sub HardwareCleanup()
  
   Dim rc As Integer
  
   If (hFileInput <> NUL) Then
   
       DSCloseFile (hFileInput)
       hFileInput = NUL
   End If
   
   If (hBoard <> 0) Then
      
      If (RunState <> 0) Then
      
         rc = DSDisableBoard(hBoard)
         If rc = 0 Then ErrorHandler
         
         RunState = 0
      End If
        
      rc = DSFreeBoard(hBoard)
      If rc = 0 Then ErrorHandler
      
      hBoard = 0

   End If
  
   If (hEngine <> 0) Then
      If (DSEngineClose(hEngine) = 0) Then MsgBox ("error closing engine")
      hEngine = 0
   End If
      
End Sub


' error handler procedure that checks different types of DirectDSP error
' messages

Sub ErrorHandler()

Dim nErrorType As Integer
 
   DSShowEngMgrStatusWindow
   
   nErrorType = DSGetEngineErrorStatus(hEngine)
   If nErrorType = 0 Then nErrorType = DSGetEngMgrErrorStatus()
   If nErrorType = 0 Then nErrorType = DSGetHWLibErrorStatus()

End Sub