# fxpstres -  A program to stress test the fixed point math ('fxp') API.
# Rick Smereka, Copyright (C) 2005.

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, get a copy via the Internet at
# http://gnu.org/copyleft/gpl.html or write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA

# You can contact the author via email at rsmereka@future-lab.com

# This program contains an infinite loop and will have to be
# forced to terminate. The program works by picking a random
# math operation/comparison, generating random floating point
# numbers (in string form) and using the fixed point API ('fxp')
# to carry out the operation/comparison.

# Program syntax:

#    fxpstres

# Output will be sent to 'stdout'. The logger may also
# be used as the 'fxp' API is coded to write log messages if the
# logger is enabled.

# Initial tcl version Apr/2005, Rick Smereka

# required path to library modules
set TCLDIR /home/rick/gpl/tcl

# required modules
source $TCLDIR/lib/stdhead.tcl

# global data
set trans_no 0

# operation codes
const FXPS_ADD 1
const FXPS_SUB 2
const FXPS_MUL 3
const FXPS_DIV 4
const FXPS_EQ 5
const FXPS_LT 6
const FXPS_GT 7
const FXPS_LE 8
const FXPS_GE 9
const FXPS_MAXCOM 9

const VERSION "1.01.01-2005.04.03"
const APNAME "fxpstres.tcl"

 
proc pick_com {} {
   # Pick a random operation/comparison.
   global FXPS_MAXCOM

   set rnd_num [rnd 1 $FXPS_MAXCOM]
   return $rnd_num
}

proc do_com {com_num} {
   # Dispatch command.
   global FXPS_ADD FXPS_SUB FXPS_MUL FXPS_DIV
   global FXPS_EQ FXPS_LT FXPS_GT FXPS_LE FXPS_GE
   set mname "do_com"

   logman "$mname:enter"
   set n1 [get_num]
   set n2 [get_num]
   set fxp1 [fxp_iconv $n1]

   if {$fxp1 == ""} {
      logman "$mname:bad rc from fxp_iconv(fxp1)"
      return
   }

   set fxp2 [fxp_iconv $n2]

   if {$fxp2 == ""} {
      logman "$mname:bad rc from fxp_iconv(fxp2)"
      return
   }

   switch $com_num \
      $FXPS_ADD {do_add $fxp1 $fxp2} \
      $FXPS_SUB {do_sub $fxp1 $fxp2} \
      $FXPS_MUL {do_mul $fxp1 $fxp2} \
      $FXPS_DIV {do_div $fxp1 $fxp2} \
      $FXPS_EQ {do_eq $fxp1 $fxp2} \
      $FXPS_LT {do_lt $fxp1 $fxp2} \
      $FXPS_GT {do_gt $fxp1 $fxp2} \
      $FXPS_LE {do_le $fxp1 $fxp2} \
      $FXPS_GE {do_ge $fxp1 $fxp2} \
      default {app_out "$mname:unknown command($com_num),ignoring"}

   logman "$mname:normal exit"
}

proc do_add {fxp1 fxp2} {
   # Perform a fixed point addition on two 'fxp' numbers.
   set mname "do_add"

   logman "$mname:enter"
   set result [fxp_add $fxp1 $fxp2]

   if {$result == ""} {
      app_out "$mname:exit:bad rc from fxp_add(fxp1,fxp2)"
      return
   }

   report_math $fxp1 $fxp2 $result "+"
   logman "$mname:normal exit"
}

proc do_sub {fxp1 fxp2} {
   # Perform a fixed point subtraction on two 'fxp' numbers.
   set mname "do_sub"

   logman "$mname:enter"
   set result [fxp_sub $fxp1 $fxp2]

   if {$result == ""} {
      app_out "$mname:exit:bad rc from fxp_sub(fxp1,fxp2)"
      return
   }

   report_math $fxp1 $fxp2 $result "-"
   logman "$mname:normal exit"
}

proc do_mul {fxp1 fxp2} {
   # Perform a fixed point multiplication on two 'fxp' numbers.
   set mname "do_mul"

   logman "$mname:enter"
   set result [fxp_mul $fxp1 $fxp2]

   if {$result == ""} {
      app_out "$mname:exit:bad rc from fxp_mul(fxp1,fxp2)"
      return
   }

   report_math $fxp1 $fxp2 $result "*"
   logman "$mname:normal exit"
}

proc do_div {fxp1 fxp2} {
   # Perform a fixed point division on two 'fxp' numbers.
   set mname "do_div"

   logman "$mname:enter"
   set result [fxp_div $fxp1 $fxp2]

   if {$result == ""} {
      app_out "$mname:exit:bad rc from fxp_div(fxp1,fxp2)"
      return
   }

   report_math $fxp1 $fxp2 $result "/"
   logman "$mname:normal exit"
}

proc do_eq {fxp1 fxp2} {
   # Perform a fixed point equality test.
   set mname "do_eq"

   logman "$mname:enter"
   set result [fxp_eq $fxp1 $fxp2]
   report_comp $fxp1 $fxp2 $result "="
   logman "$mname:normal exit"
}

proc do_lt {fxp1 fxp2} {
   # Perform a fixed point less than comparison.
   set mname "do_lt"

   logman "$mname:enter"
   set result [fxp_lt $fxp1 $fxp2]
   report_comp $fxp1 $fxp2 $result "<"
   logman "$mname:normal exit"
}

proc do_gt {fxp1 fxp2} {
   # Perform a fixed point greater than comparison.
   set mname "do_gt"

   logman "$mname:enter"
   set result [fxp_gt $fxp1 $fxp2]
   report_comp $fxp1 $fxp2 $result ">"
   logman "$mname:normal exit"
}

proc do_le {fxp1 fxp2} {
   # Perform a fixed point less than or equal comparison.
   set mname "do_le"

   logman "$mname:enter"
   set result [fxp_le $fxp1 $fxp2]
   report_comp $fxp1 $fxp2 $result "<="
   logman "$mname:normal exit"
}

proc do_ge {fxp1 fxp2} {
   # Perform a fixed point greater than or equal comparison.
   set mname "do_ge"

   logman "$mname:enter"
   set result [fxp_ge $fxp1 $fxp2]
   report_comp $fxp1 $fxp2 $result ">="
   logman "$mname:normal exit"
}

proc report_math {f1 f2 result op} {
   # Report the result of a math operation.
   global FXP_DEFAULT trans_no
   set mname "report_math"

   logman "$mname:enter"

   if {![fxp_get_list $f1 f1_num f1_scale]} {
      logman "$mname:exit:bad rc(0) from fxp_get_list(f1)"
      return
   }

   if {![fxp_get_list $f2 f2_num f2_scale]} {
      logman "$mname:exit:bad rc(0) from fxp_get_list(f2)"
      return
   }
   
   if {![fxp_get_list $result result_num result_scale]} {
      logman "$mname:exit:bad rc(0) from fxp_get_list(result)"
      return
   }

   if {![fxp_oconv $f1 $FXP_DEFAULT cf1]} {
      logman "$mname:exit:bad rc from fxp_oconv(f1)"
      return
   }

   if {![fxp_oconv $f2 $FXP_DEFAULT cf2]} {
      logman "$mname:exit:bad rc from fxp_oconv(f1)"
      return
   }

   # set result scale to largest of the two numbers except
   # for divide where we set the scale to the smallest
   if {$op == "/"} {
      if {$f2_scale < $f1_scale} {
         set out_scale $f2_scale
      } else {
         set out_scale $f1_scale
      }
   } else {
      if {$f1_scale > $f2_scale} {
         set out_scale $f1_scale
      } else {
         set out_scale $f2_scale
      }
   }

   if {![fxp_oconv $result $out_scale cr]} {
      logman "$mname:exit:bad rc from fxp_oconv(result)"
      return
   }

   app_out "$trans_no:$cf1$op$cf2=$cr"
   logman "$mname:normal exit"
}

proc report_comp {f1 f2 result op} {
   # Report the result of a comparison.
   global trans_no FXP_DEFAULT
   set mname "report_comp"

   # we really don't need the elements of the 'fxp' list
   # but we do this to verify the list
   if {![fxp_get_list $f1 f1_num f1_scale]} {
      logman "$mname:exit:bad rc(0) from fxp_get_list(f1)"
      return
   }

   if {![fxp_get_list $f2 f2_num f2_scale]} {
      logman "$mname:exit:bad rc(0) from fxp_get_list(f2)"
      return
   }

   if {![fxp_oconv $f1 $FXP_DEFAULT cf1]} {
      logman "$mname:exit:bad rc from fxp_oconv(f1)"
      return
   }

   if {![fxp_oconv $f2 $FXP_DEFAULT cf2]} {
      logman "$mname:exit:bad rc from fxp_oconv(f1)"
      return
   }

   app_out "$trans_no:$cf1$op$cf2=$result"
}

proc get_num {} {
   # Generate a random floating point number in string form.
   # Returns the number.
   set mname "get_num"

   logman "$mname:enter"

   # first generate integer portion
   set ival [rnd 0 999]

   # decide whether number should have a fractional portion
   set is_frac [rnd 0 1]

   if {$is_frac} {
      set fval [rnd 0 999]
   } else {
      set fval 0
   }

   if {$is_frac} {
      # prevent a leaning zero from being in the number as it causes
      # tcl to freak out and think it's an octal number
      if {$ival > 0 && $fval > 0} {
         set result "$ival.$fval"
      } elseif {$ival == 0} {
         set result ".$fval"
      } else {
         set result "$ival.$fval"
      }
   } else {
      set result $ival
   }

   logman "$mname:normal exit:result=$result"
   return $result
}

proc app_out {mes} {
   # Display a message and if the logger is active, log
   # the message also.
   puts $mes

   if {[logman_is_active]} {
      logman $mes
   }
}

# Program main line
# global tcl_platform APNAME VERSION trans_no
set fxpcom 0

#if {[logman_start /work/logs/fxpstres.log $APNAME]} {
#   puts "error starting log"
#   return 0
#}

# seed random generator
expr srand([clock clicks])
set trans_no 0

# program logo
app_out "$APNAME for $tcl_platform(platform) Version $VERSION"
app_out "by Rick Smereka, Copyright 2005"
app_out "$APNAME comes with ABSOLUTELY NO WARRANTY"
app_out "THis is free software, and you are welcome to redistribute it"
app_out "under cetain conditions; see 'gpl.txt' for information."

# main loop, infinite
while {1} {
   set fxpcom [pick_com]
   incr trans_no
   do_com $fxpcom
}

if {[logman_is_active]} {
   logman_end
}

exit
