# Bbuuzzb Tcl sort module.
# Rick Smereka, Copyright (C) 2006.

# 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 sort module works by loading the contents of a table into
# memory (list) until the memory limit has been reached or the end of the 
# table. Each time record memory is at the maximum allowed, the contents of 
# the sort list is sorted using 'lsort' and a 'bin' table is written. If 
# more than one 'bin' table was written, the 'bin' tables are then merged. 
# A sort specification list stores any number of sort specifications.

# Initial tcl version. Mar/2006, Rick Smereka

# Fixed bug in 'db_set_sort_max_open_bin' with the range check 'if'
# statement that would cause an error if the supplied number of bins
# was out of range. Apr/2006, Rick Smereka

# Fixed bug in 'dbeng_sort_match_tables' that called
# 'db_io_code_log' incorrectly. Fixed bug in 'dbeng_sort_rl_delete'
# that defined the global 'dbengsrt_sort_memory_in_usr' incorrectly.
# May/2006, Rick Smereka

# global data
# sort order constants
const DBENGSRT_ORDER_ASCENDING 1
const DBENGSRT_ORDER_DESCENDING 2

# 'bin' delete flag constants
const DBENGSRT_NDELBIN 1
const DBENGSRT_DELBIN 2

# default 'dbeng_table' maximums
const DBENGSRT_MAX_SORT_ALLOC 100000
const DBENGSRT_MAX_OPEN_BIN 10

# bin record counter
set dbengsrt_record_count 0

# total number of records processed
set dbengsrt_total_records 0

# total bin files in use
set dbengsrt_total_files 0

# bytes in use by record data
set dbengsrt_sort_memory_in_use 0

# list to hold record contents
set dbengsrt_rec_list {}

# list to hold sort specs
set dbengsrt_spec_list {}

# list to hold 'bin' 'tid's
set dbengsrt_bin_list {}

proc db_sort {tid specs} {
   # Sort a table. The parameter 'specs' must contain
   # a list (delimited by 'DBENG_LIST_DELIM') of sort
   # specifications. A single sort specification is in
   # the form:

   #    field_num[,A|D]

   # The sort specification starts with the field number
   # followed by an optional order ('A' for ascending,
   # 'D' for desending). A comma must separate the field
   # number from the sort order. If no order is given, an
   # ascending sort is assumed for that field.
   # The sorted table contents replace the unsorted
   # contents. Returns a 'dbeng' code.
   global DBENG_OK DBENG_NO_SUCH_TID DBENG_INVALID_FUNCTION DBENG_TABLE_LOCKED
   global DBENG_INTERNAL_ERROR
   global dbeng_table DBENG_RECORD_CHANGED DBENG_EOF dbengsrt_record_count
   global dbengsrt_total_records dbengsrt_total_files dbengsrt_rec_list
   global dbengsrt_sort_memory_in_use dbengsrt_record_count
   set mname "db_sort"

   if {![dbeng_atid_lookup $tid]} {
      db_io_code_log $mname "exit:bad tid" $DBENG_NO_SUCH_TID
      return $DBENG_NO_SUCH_TID
   }

   if {$specs == ""} {
      db_io_code_log $mname "exit:empty(specs)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   logman "$mname:enter:tid=$tid,specs=$specs"

   # check for locked table
   if {$dbeng_table($tid,is_table_locked)} {
      db_io_code_log $mname "table is locked" $DBENG_TABLE_LOCKED
      return $DBENG_TABLE_LOCKED
   }

   if {$dbeng_table($tid,enforce_change_rec_flag) && \
       $dbeng_table($tid,change_rec_flag)} {
      db_io_code_log $mname "record changed" $DBENG_RECORD_CHANGED
      return $DBENG_RECORD_CHANGED
   }

   set ret [db_top $tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "exit:bad rc from db_top" $ret
      return $ret
   }

   # build list of sort specifications
   set ret [dbeng_sort_sl_load $specs]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "exit:bad rc from db_sort_sl_load" $ret
      dbeng_sort_term
      return $ret
   }

   # force source table 'process_deleted' flag down (save prev value)
   set delete_flag $dbeng_table($tid,process_deleted)
   set dbeng_table($tid,process_deleted) 0
   set dbengsrt_record_count 0
   set dbengsrt_total_records 0
   set dbengsrt_total_files 0
   set done 0

   # get first source record, not fatal if table is empty
   set ret [db_next $tid]

   if {$ret != $DBENG_OK} {
      set dbeng_table($tid,process_deleted) $delete_flag
      dbeng_sort_term

      if {$ret == $DBENG_EOF} {
         db_io_code_log $mname "exit:table empty" $DBENG_OK
         return $DBENG_OK
      }

      db_io_code_log $mname "exit:error getting first source rec" $ret
      return $ret
   }

   # loop to load each source active record into the sort record list
   while {!$done} {
      # if sort record memory is at max, flush
      if {$dbengsrt_sort_memory_in_use > $dbeng_table($tid,sort_max_mem)} {
         logman "$mname:sort rec memory at max, flushing"
         set ret [dbeng_sort_flush_rec]

         if {$ret != $DBENG_OK} {
            db_io_code_log $mname "exit:bad rc from dbeng_sort_flush_rec" $ret
            dbeng_sort_term
            db_top $tid
            set dbeng_table($tid,process_deleted) $delete_flag
            return $ret
         }
         
         set dbengsrt_total_records [expr $dbengsrt_total_records + \
             $dbengsrt_record_count]
         set dbengsrt_record_count 0
      }

      set ret [dbeng_sort_rl_add $tid]

      if {$ret != $DBENG_OK} {
         db_io_code_log $mname "exit:bad rc from dbeng_sort_rl_add" $ret
         set dbeng_table($tid,process_deleted) $delete_flag
         dbeng_sort_term
         db_top $tid
         return $ret
      }

      incr dbengsrt_record_count

      # get next source record
      set ret [db_next $tid]
      
      switch $ret \
         $DBENG_EOF {set done 1} \
         $DBENG_OK {set done 0} \
         default {db_io_code_log $mname "exit:error getting record" $ret; \
                  set dbeng_table($tid,process_deleted) $delete_flag; \
                  dbeng_sort_term; db_top $tid; return $ret}
   }

   # close input table but retain array elements
   set ret [dbeng_ll_close $tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "exit:error closing input table" $ret
      set dbeng_table($tid,process_deleted) $delete_flag
      dbeng_sort_term
      return $ret
   }

   # sort/flush whatever is left in memory
   set ret [dbeng_sort_flush_rec]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "exit:bad rc from dbeng_sort_flush_rec" $ret
      dbeng_term_term
      dbeng_ll_open $tid
      set dbeng_table($tid,process_deleted) $delete_flag
      return $ret
   }

   if {$dbengsrt_total_files == 0} {
      logman "$mname:no bin tables after load"
      set dbengsrt_total_records $dbengsrt_record_count
   } else {
      logman "$mname:$dbengsrt_total_files bin table(s) after load,matching"
      set ret [dbeng_sort_match_bin $tid]

      if {$ret != $DBENG_OK} {
         db_io_code_log $mname "exit:bad rc from dbeng_sort_match_bin" $ret
         dbeng_sort_term
         dbeng_ll_open $tid
         set dbeng_table($tid,process_deleted) $delete_flag
         return $ret
      }
   }

   # change single bin table to source table
   set ret [dbeng_sort_set_final $tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "exit:bad rc from dbeng_sort_set_final" $ret
      set dbeng_table($tid,process_deleted) $delete_flag
      dbeng_sort_term
      return $ret
   }
   
   set dbeng_table($tid,process_deleted) $delete_flag
   dbeng_sort_term

   # force a count
   set ret [db_count $tid active_num deleted_num]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "exit:bad rc from db_count" $DBENG_INTERNAL_ERROR
      return $DBENG_INTERNAL_ERROR
   }

   set dbeng_table($tid,active_record_count) $active_num
   set dbeng_table($tid,deleted_record_count) $deleted_num

   # fix-up record count
   set ret [dbeng_set_record_count $tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "exit:bad rc from dbeng_set_record_count" \
                     $DBENG_INTERNAL_ERROR
      return $DBENG_INTERNAL_ERROR
   }

   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc db_get_sort_max_mem {tid mem} {
   # Obtain the current value of the 'dbeng_table' element
   # 'sort_max_mem'. Returns the current allowable maximum
   # sort record memory in 'mem' upon success. Returns a
   # 'dbeng' code.
   global DBENG_OK DBENG_NO_SUCH_TID dbeng_table
   upvar $mem umem
   set mname "db_get_sort_max_mem"

   logman "$mname:enter"

   if {![dbeng_atid_lookup $tid]} {
      db_io_code_log $mname "exit:bad tid" $DBENG_NO_SUCH_TID
      return $DBENG_NO_SUCH_TID
   }

   set umem $dbeng_table($tid,sort_max_mem)
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc db_set_sort_max_mem {tid mem} {
   # Set the current value of the 'dbeng_table' element
   # 'sort_max_mem'. Returns a 'dbeng' code.
   global DBENG_OK DBENG_NO_SUCH_TID DBENG_INVALID_FUNCTION dbeng_table
   set mname "db_set_sort_max_mem"

   logman "$mname:enter"

   if {![dbeng_atid_lookup $tid]} {
      db_io_code_log $mname "exit:bad tid" $DBENG_NO_SUCH_TID
      return $DBENG_NO_SUCH_TID
   }

   if {![num $mem]} {
      db_io_code_log $mname "non-numeric(mem)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   # acceptable range is >= 2000 bytes
   if {$mem < 2000} {
      db_io_code_log $mname "out of range(mem)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   set dbeng_table($tid,sort_max_mem) $mem
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc db_get_sort_max_open_bin {tid open_bin} {
   # Obtain the current value of the 'dbeng_table' element
   # 'sort_max_open_bin'. Returns the current allowable maximum
   # number of open bin tables in 'open_bin' upon success. Returns a
   # 'dbeng' code.
   global DBENG_OK DBENG_NO_SUCH_TID dbeng_table
   upvar $open_bin uopen_bin
   set mname "db_get_sort_max_open_bin"

   logman "$mname:enter"

   if {![dbeng_atid_lookup $tid]} {
      db_io_code_log $mname "exit:bad tid" $DBENG_NO_SUCH_TID
      return $DBENG_NO_SUCH_TID
   }

   set uopen_bin $dbeng_table($tid,sort_max_open_bin)
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc db_set_sort_max_open_bin {tid open_bin} {
   # Set the current value of the 'dbeng_table' element
   # 'sort_max_open_bin'. Returns a 'dbeng' code.
   global DBENG_OK DBENG_NO_SUCH_TID DBENG_INVALID_FUNCTION dbeng_table
   set mname "db_set_sort_max_open_bin"

   logman "$mname:enter"

   if {![dbeng_atid_lookup $tid]} {
      db_io_code_log $mname "exit:bad tid" $DBENG_NO_SUCH_TID
      return $DBENG_NO_SUCH_TID
   }

   if {![num $open_bin]} {
      db_io_code_log $mname "non-numeric(open_bin)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   # acceptable range is >= 3
   if {$open_bin < 3} {
      db_io_code_log $mname "out of range(open_bin)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   set dbeng_table($tid,sort_max_open_bin) $open_bin
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc dbeng_sort_flush_rec {} {
   # Sort and write out the contents of the sort rec list to a bin file.
   # Returns a 'dbeng' code.
   global DBENG_OK dbengsrt_record_count
   set mname "dbeng_sort_flush_rec"

   logman "$mname:enter:rcount=$dbengsrt_record_count"
   set ret [dbeng_sort_l]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "exit:bad rc from dbeng_sort_l" $ret
      return $ret
   }

   # create a new bin file for the data
   set ret [dbeng_sort_alloc_bin tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "exit:bad rc from dbeng_sort_alloc_bin" $ret
      return $ret
   }

   set ret [dbeng_sort_write_sort_data $tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "exit:bad rc from dbeng_sort_write_sort_data" $ret
      return $ret
   }

   dbeng_sort_rl_delete
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc dbeng_sort_l {} {
   # Sort record contents. The sort record must have already been loaded.
   global DBENG_OK dbengsrt_rec_list
   set mname "dbeng_sort_ll"

   logman "$mname:enter"
   set rec_list $dbengsrt_rec_list
   set new_list [lsort -command dbeng_sort_compare $rec_list]
   set dbengsrt_rec_list $new_list
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}
   
proc dbeng_sort_compare {a b} {
   # Compare two records according to sort specifications.
   # This comparison procedure is called by 'lsort'.
   # On data error, this procedure returns zero.
   global DBENG_FM DBENGSRT_ORDER_DESCENDING
   global dbengsrt_rec_list dbengsrt_spec_list
   set mname "dbeng_sort_compare"
   set cval 0
   set fm [format "%c" $DBENG_FM]

   # logman "$mname:a=$a,b=$b"

   if {$dbengsrt_spec_list == ""} {
      logman "$mname:exit:sort spec list empty"
      return 0
   }

   # loop through all sort specifications comparing until not equal
   set nspecs [llength $dbengsrt_spec_list]

   for {set i 0} {$i < $nspecs} {incr i} {
      # extract spec sublist
      set spec_list [lindex $dbengsrt_spec_list $i]
      # logman "$mname:spec_list=$spec_list"

      # extract field number and sort order from specs
      set field_num [lindex $spec_list 0]
      set sort_order [lindex $spec_list 1]
      # logman "$mname:field_num=$field_num,sort_order=$sort_order"

      # get contents of both fields
      if {![ll_word $a lfield $field_num $fm]} {
         logman "$mname:exit:bad rc(0) from ll_word(lfield)"
         return 0
      }

      if {![ll_word $b rfield $field_num $fm]} {
         logman "$mname:exit:bad rc(0) from ll_word(rfield)"
         return 0
      }

      # logman "$mname:lfield=$lfield,rfield=$rfield"

      # compare and exit if not equal
      set cval [string compare $lfield $rfield]

      if {$cval != 0} {
         # set the comparison result based on the sort spec order
         # and the initial value of 'cval'
         if {$sort_order == $DBENGSRT_ORDER_DESCENDING} {
            if {$cval > 0} {
               set cval -1
            } else {
               set cval 1
            }
         }

         return $cval
      }
   }

   # if we made it here, all fields are equal
   set cval 0
   return $cval
}

proc dbeng_sort_write_sort_data {tid} {
   # Write the contents of the sorted record list to a temp system
   # table. The table is assumed to be open. The output table will
   # be closed (with the 'dbeng_table' array elements retained)
   # once all records have been written. Returns a 'dbeng' code.
   global DBENG_OK DBENG_NO_SUCH_TID dbengsrt_rec_list
   set mname "dbeng_sort_write_sort_data"

   logman "$mname:enter"

   if {![dbeng_atid_lookup $tid]} {
      db_io_code_log $mname "exit:bad tid" $DBENG_NO_SUCH_TID
      return $DBENG_NO_SUCH_TID
   }

   set nrecs [llength $dbengsrt_rec_list]

   for {set i 0} {$i <$nrecs} {incr i} {
      set rec [lindex $dbengsrt_rec_list $i]
      set ret [dbeng_write_string_recd $tid $rec]

      if {$ret != $DBENG_OK} {
         db_io_code_log $mname "exit:bad rc from dbeng_write_string_recd" $ret
         return $ret
      }
   }

   set ret [dbeng_ll_close $tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "error closing bin table" $ret
      return $ret
   }

   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc dbeng_sort_set_final {tid} {
   # Take a single bin table and make it the source table.
   # 'tid' is the source table tid.
   # Returns a 'dbeng' code.
   global DBENG_OK DBENG_INVALID_FUNCTION DBENG_INTERNAL_ERROR
   global DBENGSRT_NDELBIN
   global dbeng_table dbengsrt_bin_list dbengsrt_total_files
   set mname "dbeng_sort_set_final"

   logman "$mname:enter:tid=$tid"

   if {![dbeng_atid_lookup $tid]} {
      db_io_code_log $mname "exit:bad tid" $DBENG_NO_SUCH_TID
      return $DBENG_NO_SUCH_TID
   }

   if {$dbengsrt_total_files != 1} {
      db_io_code_log $mname "dbengsrt_total_files not one" \
                     $DBENG_INVALID_FUNCTION
      dbeng_ll_open $tid
      return $DBENG_INVALID_FUNCTION
   }

   if {$dbengsrt_bin_list == ""} {
      db_io_code_log $mname "exit: no bin files" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   # blow away the original table and perform a rename from the
   # only bin table to the original table name
   file delete $dbeng_table($tid,name)
   set bintid [lindex $dbengsrt_bin_list 0]

   if {![qrename $dbeng_table($bintid,name) $dbeng_table($tid,name)]} { 
      db_io_code_log $mname "exit:bad rc from qrename(0)" \
                     $DBENG_INTERNAL_ERROR
      return $DBENG_INTERNAL_ERROR
   }
   
   # eliminate the only bin list member
   set ret [dbeng_sort_bl_delete $bintid $DBENGSRT_NDELBIN]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "exit:bad rc from dbeng_sort_bl_delete" $ret
      return $ret
   }

   # re-open input table (now sorted)
   set ret [dbeng_ll_open $tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "exit:bad rc from dbeng_ll_open" $ret
      return $ret
   }

   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc dbeng_sort_match_bin {sourcetid} {
   # Create a single table from all the bin tables.
   # Returns a 'dbeng' code.
   global DBENG_OK DBENG_INVALID_FUNCTION DBENG_NO_SUCH_TID
   global dbeng_table dbengsrt_bin_list
   set mname "dbeng_sort_match_bin"

   logman "$mname:enter"

   if {![dbeng_atid_lookup $sourcetid]} {
      db_io_code_log $mname "exit:bad tid" $DBENG_NO_SUCH_TID
      return $DBENG_NO_SUCH_TID
   }

   if {$dbengsrt_bin_list == ""} {
      db_io_code_log $mname "exit:bin list empty" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   # main loop which consolidates multiple bin tables into one
   # bin table
   while {1} {
      # check for single bin file
      set nbins [llength $dbengsrt_bin_list]

      if {$nbins == 1} {
         set tid [lindex $dbengsrt_bin_list 0]
         logman "$mname:top of loop single bin tid=$tid"
         db_io_code_log $mname "exit:single bin after match" $DBENG_OK
         return $DBENG_OK
      }

      # create a new bin file for the data
      set ret [dbeng_sort_alloc_bin tid]

      if {$ret != $DBENG_OK} {
         db_io_code_log $mname "exit:bad rc from dbeng_sort_alloc_bin" $ret
         return $ret
      }

      set files_open 0
      set nbins [llength $dbengsrt_bin_list]

      # loop through the bin list, opening
      for {set i 0} {$i < $nbins} {incr i} {
         # open up to max input tables
         if {$files_open >= $dbeng_table($sourcetid,sort_max_open_bin)} {
            logman "$mname:max bin files opened"
            break
         }

         set bintid [lindex $dbengsrt_bin_list $i]

         # ignore our output bin table
         if {$bintid != $tid} {
            set ret [dbeng_ll_open $bintid]

            if {$ret != $DBENG_OK} {
               logman "$mname:error($ret) opening bin:tid=$bintid"
               dbeng_sort_bl_delete_all
               return $ret
            }

            incr files_open
         }
      }

      # match tables
      set ret [dbeng_sort_match_tables $tid]

      if {$ret != $DBENG_OK} {
         db_io_code_log $mname "exit:bad rc from dbeng_sort_match_tables" $ret
         dbeng_sort_bl_delete_all
         return $ret
      }

      # close output bin table
      set ret [dbeng_ll_close $tid]

      if {$ret != $DBENG_OK} {
         db_io_code_log $mname "exit:bad rc from dbeng_ll_close" $ret
         dbeng_sort_bl_delete_all
         return $ret
      }
   }

   db_io_code_log $mname "abnormal exit" $DBENG_INTERNAL_ERROR
   return $DBENG_INTERNAL_ERROR
}

proc dbeng_sort_match_tables {out_tid} {
   # Consolidate all open bin tables into a single table.
   # Returns a 'dbeng' code.
   global DBENG_OK DBENGSRT_DELBIN DBENG_INTERNAL_ERROR DBENG_NO_SUCH_TID
   global dbengsrt_bin_list dbeng_table
   set mname "dbeng_sort_match_tables"

   logman "$mname:enter:out_tid=$out_tid"

   if {![dbeng_atid_lookup $out_tid]} {
      db_io_code_log $mname "exit:bad tid" $DBENG_NO_SUCH_TID
      return $DBENG_NO_SUCH_TID
   }

   # obtain the first record of each input table
   set nbins [llength $dbengsrt_bin_list]

   for {set i 0} {$i < $nbins} {incr i} {
      set this_tid [lindex $dbengsrt_bin_list $i]

      # go after only open tables except the output bin table
      if {[dbeng_sort_is_active_input_bin $this_tid $out_tid]} {
         set ret [db_goto $this_tid 1]

         # this should not happen, just in case
         if {$ret != $DBENG_OK} {
            db_io_code_log $mname "unable to goto rec(1) of tid($this_tid)" \
                           $DBENG_INTERNAL_ERROR
            return $DBENG_INTERNAL_ERROR
         }
      }
   }

   set done 0

   # main match loop
   while {!$done} {
      set nbins [llength $dbengsrt_bin_list]
      set default_tid 0

      # set initial default to first input bin table
      for {set i 0} {$i < $nbins} {incr i} {
         set this_tid [lindex $dbengsrt_bin_list $i]

         if {[dbeng_sort_is_active_input_bin $this_tid $out_tid]} {
            set default_tid $this_tid
            set which $this_tid
            break
         }
      }

      # this should never happen, just in case
      if {!$default_tid} {
         db_io_code_log $mname "default tid is zero:no bin tables?" \
                        $DBENG_INTERNAL_ERROR
         return $DBENG_INTERNAL_ERROR
      }

      logman "$mname:default tid=$default_tid"

      # compare loop
      for {set i 0} {$i < $nbins} {incr i} {
         set this_tid [lindex $dbengsrt_bin_list $i]

         # don't compare the initial default bin record
         if {$this_tid != $default_tid && \
             [dbeng_sort_is_active_input_bin $this_tid $out_tid]} {
            if {[dbeng_sort_compare $dbeng_table($this_tid,rec) \
                                    $dbeng_table($which,rec)] < 0} {
               set which $this_tid
            }
         }
      }

      logman "$mname:after compare:which=$which"

      # output chosen record
      set ret [dbeng_write_string_recd $out_tid $dbeng_table($which,rec)]

      if {$ret != $DBENG_OK} {
         db_io_code_log $mname "exit:bad rc from dbeng_write_string_recd" $ret
         return $ret
      }

      # read next record of the chosen input table
      set ret [dbeng_sort_read_bin $which $out_tid]

      if {$ret != $DBENG_OK} {
         db_io_code_log $mname "exit:bad rc from dbeng_sort_read_bin" $ret
         return $ret
      }

      # if only one open bin left (the output), we are done
      set nbins [llength $dbengsrt_bin_list]
      set ret 0

      for {set i 0} {$i < $nbins} {incr i} {
         set this_tid [lindex $dbengsrt_bin_list $i]
         
         if {[dbeng_sort_is_active_input_bin $this_tid $out_tid]} {
            incr ret
         }
      }

      if {$ret == 0} {
         set done 1
      }
   }

   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc dbeng_sort_read_bin {tid out_tid} {
   # Read the next record of the indicated bin table. If EOF
   # is encountered, close and delete the bin table. Returns
   # a 'dbeng' code.
   global DBENG_OK DBENG_NO_SUCH_TID DBENG_INVALID_FUNCTION DBENG_EOF
   global DBENGSRT_DELBIN

   set mname "dbeng_sort_read_bin"

   if {![dbeng_atid_lookup $tid]} {
      db_io_code_log $mname "exit:bad tid" $DBENG_NO_SUCH_TID
      return $DBENG_NO_SUCH_TID
   }

   if {![dbeng_atid_lookup $out_tid]} {
      db_io_code_log $mname "exit:bad tid" $DBENG_NO_SUCH_TID
      return $DBENG_NO_SUCH_TID
   }

   logman "$mname:enter:tid=$tid,out_tid=$out_tid"

   if {![dbeng_sort_is_active_input_bin $tid $out_tid]} {
      logman "$mname:bin($tid) is not an active input bin"
      return $DBENG_INVALID_FUNCTION
   }

   # read the next record, if EOF, close and delete the bin table
   set ret [db_next $tid]

   if {$ret != $DBENG_OK} {
      if {$ret == $DBENG_EOF} {
         logman "$mname:bin($tid) eof,deleting"
         dbeng_sort_bl_delete $tid $DBENGSRT_DELBIN
         return $DBENG_OK
      }

      db_io_code_log $mname "bad rc from db_next" $ret
      return $ret
   }

   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc dbeng_sort_is_active_input_bin {tid out_tid} {
   # Determine whether the bin table 'tid' is open and is not an
   # output table. Returns 1 if the table 'tid' is open and for
   # input, 0 otherwise.
   global dbengsrt_bin_list dbeng_table

   if {$dbengsrt_bin_list == ""} {
      return 0
   }

   if {$tid <= 0} {
      return 0
   }

   if {$tid == $out_tid} {
      return 0
   }

   if {[lsearch -exact -integer $dbengsrt_bin_list $tid] != -1} {
      if {$dbeng_table($tid,handle) != 0} {
         return 1
      }
   }

   return 0
}

proc dbeng_sort_alloc_bin {bintid} {
   # Allocate a bin member and open a temporary system table for it.
   # A new entry in the bin list will be created. Upon success,
   # the tid of the temp sys table will be returned in 'bintid'.
   # Returns a 'dbeng' code.
   global DBENG_OK dbengsrt_bin_list dbengsrt_total_files
   upvar $bintid ubintid
   set mname "dbeng_sort_alloc_bin"

   logman "$mname:enter"

   # create a new system table for the bin file
   set ret [dbeng_tmp_systable tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "exit:bad rc from dbeng_tmp_systable" $ret
      return $ret
   }

   incr dbengsrt_total_files
   logman "$mname:after bin create:total_files=$dbengsrt_total_files"

   # add the bin table tid to the list
   lappend dbengsrt_bin_list $tid
   set ubintid $tid
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc dbeng_sort_sl_load {specs} {
   # Load all sort specifications into a list.
   # Returns a 'dbeng' code.
   global DBENG_OK DBENG_INVALID_FUNCTION DBENG_INTERNAL_ERROR
   global DBENG_LIST_DELIM
   set mname "dbeng_sort_sl_load"

   if {$specs == ""} {
      db_io_code_log $mname "exit:empty(specs)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   logman "$mname:specs=$specs"
   set nwords [ll_words $specs $DBENG_LIST_DELIM]

   for {set i 1} {$i <= $nwords} {incr i} {
      if {![ll_word $specs tmp $i $DBENG_LIST_DELIM]} {
         db_io_code_log $mname "exit:bad rc from ll_word" \
                        $DBENG_INTERNAL_ERROR
         return $DBENG_INTERNAL_ERROR
      }

      set ret [dbeng_sort_sl_add $tmp]

      if {$ret != $DBENG_OK} {
         db_io_code_log $mname "exit:bad rc from dbeng_sort_sl_add" $ret
         return $ret
      }
   }

   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc dbeng_sort_rl_add {tid} {
   # Add the contents of the current record to the sort record list.
   # Returns a 'dbeng' code.
   global DBENG_OK DBENG_NO_SUCH_TID dbengsrt_rec_list 
   global dbengsrt_sort_memory_in_use
   set mname "dbeng_sort_rl_add"

   if {![dbeng_atid_lookup $tid]} {
      db_io_code_log $mname "exit:bad tid" $DBENG_NO_SUCH_TID
      return $DBENG_NO_SUCH_TID
   }
   
   # logman "$mname:enter:tid=$tid"
   set rec ""
   set ret [db_get_rec $tid rec]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "exit:bad rc from db_get_rec" $ret
      return $ret
   }

   # append this list to main sort record list
   lappend dbengsrt_rec_list $rec
   set dbengsrt_sort_memory_in_use [string length $dbengsrt_rec_list]
   # db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc dbeng_sort_rl_delete {} {
   # Delete the sort record list.
   global dbengsrt_rec_list dbengsrt_sort_memory_in_use
   set mname "dbeng_sort_rl_delete"

   logman "$mname:enter"
   set dbengsrt_rec_list ""
   set dbengsrt_sort_memory_in_use 0
   logman "$mname:normal exit"
}   
   
proc dbeng_sort_sl_add {spec} {
   # Add a sort specification to the list. Retunrs a 'dbeng' code.
   global DBENG_OK DBENG_INVALID_FUNCTION DBENG_INTERNAL_ERROR
   global DBENGSRT_ORDER_ASCENDING DBENGSRT_ORDER_DESCENDING
   global dbengsrt_spec_list
   set mname "dbeng_sort_sl_add"

   if {$spec == ""} {
      db_io_code_log $mname "exit:empty(spec)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   logman "$mname:enter:spec=$spec"
   set nwords [ll_words $spec ","]
   set sort_order 0
   
   if {![ll_word $spec fnum 1 ","]} {
      db_io_code_log $mname "exit:bad rc(0) from ll_word(1)" \
                     $DBENG_INTERNAL_ERROR
      return $DBENG_INTERNAL_ERROR
   }

   if {![num $fnum]} {
      db_io_code_log $mname "exit:non-numeric field number" \
                     $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$nwords > 1} {
      if {![ll_word $spec tmp 2 ","]} {
         db_io_code_log $mname "exit:bad rc from ll_word(2)" \
                        $DBENG_INTERNAL_ERROR
         return $DBENG_INTERNAL_ERROR
      }

      set tmp2 [ucase $tmp]

      switch $tmp2 {
         A {
            set sort_order $DBENGSRT_ORDER_ASCENDING
         }

         D {
            set sort_order $DBENGSRT_ORDER_DESCENDING
         }
         
         default {
            db_io_code_log $mname "exit:unknown sort order" \
                           $DBENG_INVALID_FUNCTION
            return $DBENG_INVALID_FUNCTION
         }
      }
   }

   if {!$sort_order} {
      set sort_order $DBENGSRT_ORDER_ASCENDING
   }

   # create a list from the spec field number and sort order
   set spec_list [list $fnum $sort_order]
   logman "$mname:spec_list=$spec_list"

   # append this list to main list
   lappend dbengsrt_spec_list $spec_list
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc dbeng_sort_bl_delete_all {} {
   # Delete all bin tables present in the bin table list.
   # Returns a 'dbeng' code.
   global DBENG_OK DBENGSRT_DELBIN dbengsrt_bin_list
   set mname "dbeng_sort_bl_delete_all"

   logman "$mname:enter"
   set done 0

   while {!$done} {
      if {$dbengsrt_bin_list == ""} {
         set done 1
      } else {
         set tid [lindex $dbengsrt_bin_list 0]
         set ret [dbeng_sort_bl_delete $tid $DBENGSRT_DELBIN]

         if {$ret != $DBENG_OK} {
            db_io_code_log $mname "exit:bad rc from dbeng_sort_bl_delete" $ret
            return $ret
         }
      }
   }

   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc dbeng_sort_bl_delete {lbin delete_flag} {
   # Delete a bin file list entry with or without
   # deleting the physical bin file. Returns a
   # 'dbeng' code.
   global DBENG_OK DBENG_INVALID_FUNCTION DBENG_NOT_EXIST dbengsrt_total_files
   global DBENGSRT_NDELBIN DBENGSRT_DELBIN dbeng_table dbengsrt_bin_list
   set mname "dbeng_sort_bl_delete"

   if {![dbeng_atid_lookup $lbin]} {
      db_io_code_log $mname "exit:bad tid" $DBENG_NO_SUCH_TID
      return $DBENG_NO_SUCH_TID
   }

   if {$dbengsrt_bin_list == ""} {
      db_io_code_log $mname "exit:empty(bin list)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$delete_flag != $DBENGSRT_NDELBIN && $delete_flag != $DBENGSRT_DELBIN} {
      db_io_code_log $mname "exit:out of range(delete_flag)" \
                     $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   logman "$mname:enter:tid=$lbin,bin list=$dbengsrt_bin_list"   

   # search bin list for matching tid
   set pos [lsearch -exact -integer $dbengsrt_bin_list $lbin]
   logman "$mname:lsearch pos=$pos"

   # if no match, error
   if {$pos == -1} {
      db_io_code_log $mname "exit:entry not found" $DBENG_NOT_EXIST
      return $DBENG_NOT_EXIST
   }

   # remove from bin list
   set new_list [lreplace $dbengsrt_bin_list $pos $pos]
   logman "$mname:new_list=$new_list"
   set dbengsrt_bin_list $new_list

   # delete bin if requested
   if {$delete_flag == $DBENGSRT_DELBIN} {
      dbeng_ll_close $lbin
      file delete $dbeng_table($lbin,name)
   }

   # close and remove 'dbeng_table' array elements, not fatal if close fails
   set ret [db_close $lbin]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "bad rc from db_close" $ret
   }

   set dbengsrt_total_files [expr $dbengsrt_total_files - 1]
   logman "$mname:exit(0):new bin list=$dbengsrt_bin_list"
   return $DBENG_OK
}

proc dbeng_sort_term {} {
   # Clear all three lists before exit.
   global dbengsrt_spec_list
   set mname "dbeng_sort_term"

   logman "$mname:enter"
   dbeng_sort_rl_delete
   dbeng_sort_bl_delete_all
   lset dbengsrt_spec_list {}
   logman "$mname:exit"
}

