rfcmst.c

BT rfcli master proc.

#Local Script

proc start_request {port_speed max_frame_size} {
     global result_code connectionAttempts
     global psm_remote respond_phandle
     #Start Request 
     puts "RFC START Request"
     set ps $port_speed 
     set fs $max_frame_size
     for {set c 1} {$c < $connectionAttempts} {incr c} {
         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 "DM Registration Accepted"
              incr state +1
           } else { 
                  puts "DM 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
   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
   #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"
  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 "Wait to receive 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
   switch $fclstate {
      0 {transmittx}
      1 {receiverx}
      default {puts "Unknown FCL State"}
   }
}

#Read Bluetooth Address Message
proc readbdaddr {remotebdaddr} {
     puts "Bluetooth Address:"
     set nap0 [lindex $remotebdaddr 1]
     set nap1 [lindex $remotebdaddr 2]
     set uap [lindex $remotebdaddr 3]
     set lap0 [lindex $remotebdaddr 4]
     set lap1 [lindex $remotebdaddr 5]
     set lap2 [lindex $remotebdaddr 6]
     set nap [expr (($nap0*0x100)+$nap1)]
     set lap [expr (($lap0*0x10000)+($lap1*0x100)+$lap2)]
     puts [format "NAP: 0x%x" $nap]
     puts [format "UAP: 0x%x" $uap]
     puts [format "LAP: 0x%x" $lap]
}

#Read Local Name Message 
proc readlocalname {remotename remotenamelength} {
     puts "READ LOCAL NAME"
     puts "Length = [expr $remotenamelength-1]"
     set rln0 [format "%s" $remotename]
     set rln [lreplace $rln0 0 0]
     puts "Local Name ASCII: $rln"
     set fln {}
     foreach el $rln {
         lappend fln [format "%1c" $el]
     }
     puts "Local Name: $fln" 
     set lfln [llength $fln]
     puts "Length of Name: $lfln"
}

#Change Local Name Message
proc changelocalname {changename changenamelength} {
     puts "CHANGE LOCAL NAME"
     puts "Length = [expr $changenamelength-1]"
     puts "$changename"
     set cln0 [format "%s" $changename]
     set cln [lreplace $cln0 0 0]
     puts "Local Name ASCII: $cln"
     set fln {}
     foreach el $cln {
         lappend fln [format "%1c" $el]
     }
     puts "Local Name: $fln" 
     set lfln [llength $fln]
     puts "Length of Name: $lfln"
}

#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 {puts "Data transfer complete"}
     0x01 {readbdaddr [lindex $result 5]}
     0x02 {readlocalname [lindex $result 5] [lindex $result 4]}
     0x03 {changelocalname [lindex $result 5] [lindex $result 4]} 
   }
}

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
     }
   }
}

#Connect to Casira
puts "Connect to Casira"
BC_connect com1 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
}
#Put Messages in Transmit Buffer
puts "Put Messages in Transmit Buffer"
for {set cnt 0} {$cnt < $tx_buffer(buffersize)} {incr cnt} {
   switch $cnt {
      0 {set txmsg {1}}
      1 {set txmsg {2}}
      2 {set txmsg {3 "1: Name changed by RFCLI"}}
      3 {set txmsg {1}}
      4 {set txmsg {2}}
      5 {set txmsg {3 "2: Name changed by RFCLI"}}
      6 {set txmsg {1}}
      7 {set txmsg {2}}
      8 {set txmsg {3 "3: Name changed by RFCLI"}}
      9 {set txmsg {0}}
      default {set txmsg {0}}
   }
   if {[putpktpetxbuffer $txmsg]} {
      puts "Message failed to load in PE Tx Buffer"
   } 
}
#printtxbuffer
#Initialise System Variables
puts "Initialise System Variables"
set use_flow_control 0x01
set bd_addr.lap 0x10e46
set bd_addr.uap 0x5b
set bd_addr.nap 0x02
set max_frame_size 0x7f
set initial_credits 0x07
puts "Connection Attempts: $connectionAttempts"
#Register with RFCOMM
puts "Register with RFCOMM"
register_rfcomm
#Initialise RFCOMM
puts "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 Device Manager
puts "Register with Device Manager"
puts "DM phandle: $phandle"
DM_AM_REGISTER_REQ $phandle
DM_AM_REGISTER_CFM
#Request RFCOMM Start
puts "Request RFCOMM Start"
start_request ${sys_pars.port_speed} ${sys_pars.max_frame_size}
#RFCOMM Parameter Negotiation
puts "RFCOMM Parameter Negotiation"
RFC_PARNEG_REQ $mux_id - - $max_frame_size $use_flow_control $initial_credits
RFC_PARNEG_CFM
puts "Credits: ${dlc_pars.initial_credits}"
#RFCOMM Establish
puts "RFCOMM Establish"
RFC_ESTABLISH_REQ $mux_id $loc_server_chan $rem_server_chan
RFC_ESTABLISH_CFM
set state 1
#Main Loop
puts "Main Loop"
while {$state} {
  checkstate
}
puts "All Done"
puts "Number of Transmitted Packets = $tx_buffer(transmitted)"
puts "Number of Received Packets    = $rx_buffer(received)"


#Remote script

proc start_request {port_speed max_frame_size} {
     global result_code connectionAttempts
     global psm_remote respond_phandle
     #Start Request 
     puts "RFC START Request"
     set ps $port_speed 
     set fs $max_frame_size
     for {set c 1} {$c < $connectionAttempts} {incr c} {