rfcmst.c

BT rfcli master proc.

         puts "Attempt: $c"
         set port_speed $ps
         set max_frame_size $fs
         RFC_START_REQ - - - $psm_remote $port_speed $max_frame_size $respond_phandle
         RFC_START_CFM
         #If result_code is not success we need to wait
         while {$result_code == 1} {
               RFC_START_CFM
         }
         puts "result_code: $result_code"
         if {$result_code != 6} {return $result_code}
     }
     return $result_code
}

proc register_rfcomm {} {
     global phandle server_chan accept
     set state 0x00
     while {$state == 0} {
     #Register with RFCOMM
           puts "Register with RFCOMM"
           RFC_REGISTER_REQ $phandle
           RFC_REGISTER_CFM
           puts "Server Channel: $server_chan"
           puts "Accept        : $accept"
           puts "phandle       : $phandle"
           if {$accept == 1} {
              puts "RFCOMM Registration Accepted"
              incr state +1
           } else { 
                  puts "RFCOMM Registration NOT Accepted"
           }
     }
}

#Check Transmit Buffer for Packets to Transmit
proc checkpetxbuffer {} {
   global tx_buffer
   puts "Check Transmit Buffer for Packets to Transmit"
   if {$tx_buffer(noofpackets) > 0x00} {
      puts "Port Entity has $tx_buffer(noofpackets) packet(s) to transmit"
      set pckcount $tx_buffer(noofpackets)
   } else {
      puts "Port Entity has no packets to transmit"
      set pckcount 0x00
   }
   return $pckcount
}

#Check For Packet in Receiver Buffer
proc checkperxbuffer {} {
   global rx_buffer
   puts "Check For Packet in Receiver Buffer"
   if {$rx_buffer(noofpackets) > 0x00} {
      puts "Port Entity has received $rx_buffer(noofpackets) packet(s)"
      set pckcount $rx_buffer(noofpackets)
   } else {
      puts "Port Entity has no receive packets"
      set pckcount 0x00
   }
   return $pckcount
}

#Load Packet in Tranmit Buffer
proc putpktpetxbuffer {petxpacket} {
   global tx_buffer
   puts "Load Packet in Tranmit Buffer"
   #Check for space in the buffer
   if {$tx_buffer(noofpackets) < $tx_buffer(buffersize)} {
      set errcode 0x00
      #Put tx packet at bottom of the tx buffer
      set bptr $tx_buffer(bottomptr)
      set tx_buffer($bptr) $petxpacket
      #Calculate Next available position in tx buffer
      incr tx_buffer(noofpackets)
      incr tx_buffer(bottomptr) 
      #Check if bottom pointer needs to wrap around
      if {$tx_buffer(bottomptr) == $tx_buffer(buffersize)} {
         set tx_buffer(bottomptr) 0x00 
      }
   } else {
      set errcode 0x01
   }
   return $errcode
}

#Transmit RFCOMM Data
proc transmittx {} {
  global tx_buffer
  puts "Transmit RFCOMM Data"
  set txptr $tx_buffer(topptr)
  RFC_DATA_REQ - - - ? $tx_buffer($txptr)
  #Decrement the number of packets
  incr tx_buffer(noofpackets) -1
  #Increment the top of tx buffer pointer
  incr tx_buffer(topptr) 
  #Check if top pointer needs to wrap around
  if {$tx_buffer(topptr) == $tx_buffer(buffersize)} {
     set tx_buffer(topptr) 0 
  }
  #If number of packets is 0 then reset the both tx buffer pointers
  if { $tx_buffer(noofpackets) == 0} {
    set tx_buffer(topptr) 0 
    set tx_buffer(bottomptr) 0
  }
  incr tx_buffer(transmitted)
}

#Receive RFCOMM Data
proc receiverx {} {
  global rx_buffer
  global credits
  puts "Receive RFCOMM Data"
  set result [RFC_DATA_IND]
  puts "Credits $credits"
  if {$rx_buffer(noofpackets)} {
    incr rx_buffer(bottomptr)
  }
  set rxptr $rx_buffer(bottomptr)
  set rx_buffer($rxptr) $result
  #Increment number of received packets
  incr rx_buffer(noofpackets)
  #Check for bottom pointer needs to wrap around
  if {$rx_buffer(bottomptr) == $rx_buffer(buffersize)} {
     set rx_buffer(bottomptr) 0
  }
  incr rx_buffer(received)
}
 
#Flow Control Layer 
proc flowcontrollayer {fclstate} {
   global state
   puts "Flow Control Layer"
   switch $fclstate {
      0 {transmittx}
      1 {receiverx}
      default {puts "Unknown FCL State"}
   }
}

#Read Bluetooth Address Message
proc readbdaddr {} {
     puts "Read Bluetooth Address Message"
     DM_HCI_READ_BD_ADDR
     set result [DM_HCI_READ_BD_ADDR_COMPLETE]
     puts "Bluetooth Address: "
     set lap [lindex $result 2]
     #Create correct number of bytes for lap
     set lap0 [expr $lap/0x10000]
     set laptemp [expr $lap%0x10000]
     set lap1 [expr $laptemp/0x100]
     set lap2 [expr $laptemp%0x100]
     set uap [lindex $result 3]
     set nap [lindex $result 4]
     puts [format "NAP: 0x%x" $nap]
     puts [format "UAP: 0x%x" $uap]
     puts [format "LAP: 0x%x" $lap]
     #Create correct number of bytes for nap
     set nap0 [expr $nap/0x100]
     set nap1 [expr $nap%0x100]
     #Create response character
     set resp 0x01
     #Bind Message together
     set bd "$resp $nap0 $nap1 $uap $lap0 $lap1 $lap2"
     #Put Message in the transmit buffer
     if {[putpktpetxbuffer $bd]} {
       puts "Read Local Bluetooth Address Message failed to load in PE Tx Buffer"
     } 
}

#Read Local Name Message
proc readlocalname {} {
     puts "Read Local Name Message"
     DM_HCI_READ_LOCAL_NAME
     set result [DM_HCI_READ_LOCAL_NAME_COMPLETE]
     puts "Local Name: [lindex $result 2]"
     set rln0 0x02
     set rln1 [lindex $result 2]
     set rln2 [split $rln1 {}]
     set strl [llength $rln2]
     for {set c 0} {$c < $strl} {incr c} {
         scan [lindex $rln2 $c] %c rln3
         lappend rln0 $rln3
     }
     if {[putpktpetxbuffer $rln0]} {
       puts "Read Local Name Message failed to load in PE Tx Buffer"
     } 
}

#Change Local Name Message
proc changelocalname {changename changenamelength} {
     set cln [lreplace $changename 0 0] 
     set changename $cln
     puts "Change Local Name Message"
     DM_HCI_READ_LOCAL_NAME
     set result [DM_HCI_READ_LOCAL_NAME_COMPLETE]
     puts "Old Local Name = [lindex $result 2]"
     puts "Requested Name = $changename"
     DM_HCI_CHANGE_LOCAL_NAME $changename
     set result [DM_HCI_CHANGE_LOCAL_NAME_COMPLETE]
     #Read the local name and send back to the master
     DM_HCI_READ_LOCAL_NAME
     set result [DM_HCI_READ_LOCAL_NAME_COMPLETE]
     puts "Local Name: [lindex $result 2]"
     set rln0 0x03
     set rln1 [lindex $result 2]
     set rln2 [split $rln1 {}]
     set strl [llength $rln2]
     for {set c 0} {$c < $strl} {incr c} {
         scan [lindex $rln2 $c] %c rln3
         lappend rln0 $rln3
     }
     if {[putpktpetxbuffer $rln0]} {
       puts "Change Local Name Message failed to load in PE Tx Buffer"
     } 
}

#Data Transfer Complete
proc datacomplete {} {
     global taskcompleteflag 
     puts "Data transfer complete"
     if {[putpktpetxbuffer 0]} {
       puts "Change Local Name Message failed to load in PE Tx Buffer"
     } 
     set taskcompleteflag 1
}

#Process Next Received Packet in Receiver Buffer
proc processrx {} {
   global rx_buffer
   puts "Process receive buffer"
   #Get the Next Received packet to process
   set rxptr $rx_buffer(topptr)
   #Decrement the number of packets
   incr rx_buffer(noofpackets) -1
   #Increment the top of rx buffer pointer
   incr rx_buffer(topptr) 
   #Check if top pointer needs to wrap around
   if {$rx_buffer(topptr) == $rx_buffer(buffersize)} {
      set rx_buffer(topptr) 0 
   }
   #If number of packets is 0 then reset the both rx buffer pointers
   if {$rx_buffer(noofpackets) == 0} {
     set rx_buffer(topptr) 0 
     set rx_buffer(bottomptr) 0
   }
   set result $rx_buffer($rxptr) 
   puts "Payload: [lindex $result 5]"
   set firstchar [lindex [lindex $result 5] 0]
   puts "First character of payload $firstchar"
   switch $firstchar {
     0x00 {datacomplete}
     0x01 {readbdaddr}
     0x02 {readlocalname}
     0x03 {changelocalname [lindex $result 5] [lindex $result 4]} 
   }
}

#Steady State
proc steadystate {} {
   puts "Steady State"
}

#Check Receiver Buffer for Space
proc receiverspace {} {
   global rx_buffer
   if {$rx_buffer(noofpackets) < $rx_buffer(buffersize)} {
     return 1
   } else {
     return 0
   }
}

#Check State
proc checkstate {} {
   global state
   switch $state {
      0 {puts "Task Complete"}
      1 {steadystate}
      2 {if {[checkpetxbuffer]} {flowcontrollayer 0}}
      3 {if {[receiverspace]} {flowcontrollayer 1}}
      4 {if {[checkperxbuffer]} {processrx}}
      default {puts "Unknown State"}
   }
   incr state
   #Check to see if we have done all processing
   if {$state == 5} {
     if {[checkpetxbuffer] || [checkperxbuffer]} {
       set state 1
     } else {
       set state 0
     }
   }
}

#Make a connection to the Casira on comport2
BC_connect com2 bcsp 115200
#Initialise Port Entity Transmit Buffer
puts "Initialise Port Entity Transmit Buffer"
set tx_buffer(noofpackets) 0
set tx_buffer(txcredits) 0
set tx_buffer(pointer) 0
set tx_buffer(buffersize) 10
set tx_buffer(topptr) 0
set tx_buffer(bottomptr) 0
set tx_buffer(transmitted) 0
for {set cnt 0} {$cnt < $tx_buffer(buffersize)} {incr cnt} {
  set tx_buffer($cnt) 0xc0ffee
}
#Initialise Port Entity Receive Buffer
puts "Initialise Port Entity Receive Buffer"
set rx_buffer(noofpackets) 0
set rx_buffer(txcredits) 0
set rx_buffer(pointer) 0
set rx_buffer(topptr) 0
set rx_buffer(bottomptr) 0
set rx_buffer(buffersize) 10
set rx_buffer(received) 0
for {set cnt 0} {$cnt < $rx_buffer(buffersize)} {incr cnt} {
  set rx_buffer($cnt) 0xc0ffee
}
#Initialise System Variables
puts "Initialise System Variables"
set use_flow_control 0x01
set max_frame_size 0x7f
set initial_credits 0x07
set state 1
set taskcompleteflag 0
#Register with RFCOMM
register_rfcomm
#Initialise RFCOMM
RFC_INIT_REQ $phandle $psm_local $use_flow_control $fc_type $fc_threshold $fc_timer $rsvd_4 $rsvd_5
RFC_INIT_CFM
#Register with the Device Manager
puts "Register with Device Manager"
puts "DM phandle: $phandle"
DM_AM_REGISTER_REQ $phandle
DM_AM_REGISTER_CFM
#Listen
listen
#Output Waiting For Connection Message
puts "Waiting For Connection Message"
#Connect as Slave
rfc_connect_slv
#Wait for an incoming data primitive
puts "Connection made, starting transfer"
#Main Loop
puts "Main Loop"
while {$state} {
  if {$taskcompleteflag} {
    #Flush Transmit buffer to tell the Master to finish
    set state 2
    checkstate
    set state 0
  } else {
    checkstate
  }
}
puts "All Done"
puts "Number of Transmitted Packets = $tx_buffer(transmitted)"
puts "Number of Received Packets    = $rx_buffer(received)"