# DBENG (Bbuuzzb) - A database engine. Library functions.
# Rick Smereka, Copyright (C) 2005-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

# Initial tcl version Sep/2005, Rick Smereka

# The tcl version of this database engine is implemented differently
# than the 'C' version. Instead of using a link list of structures,
# this version uses an array in what looks like two dimensions.
# In reality, there is only one dimension to the 'dbeng_table'
# array. Also, since there is no need for a two-layer API, this
# tcl version has a single layer API with the procedures passing
# the table 'tid' (table id).

# Each table in use stores the following in the 'dbeng_table' array:
#
# element key              description
#
# handle                   file handle (channelID)
# rec                      current record contents
# name                     physical file name
# change_rec_flag          has current record changed? (bol)
# enforce_change_rec_flag  enforce 'change_rec_flag'? (bol)
# process_deleted          retreive recs marked for deletion? (bol)
# is_table_locked          is the table read/write locked? (bol)
# is_systable              is this a system table? (bol)
# sort_max_open_bin        max allowable open bins in sort
# sort_max_mem             max allowable memory in use for sort
# record_number            current record number
# active_record_count      current number of active records in table
# deleted_record_count     current number of deleted records in table
# orig_position            original (start) file pos of record
# current_position         current file position
# record_status            1=active,0=deleted
# autopack                 autopack threshold (0=off)
#
# The 'dbeng_table' array element key is as follows:
#
# tid,element
#
# Where 'tid' is the table id (returned from 'db_open') and element is
# one the of element keys mentioned above.
#
# Added 'gloal' declaration of 'DBENG_NO_SUCH_TID' to procedures
# 'db_get_is_table_locked' and 'db_get_is_table_locked'.
# Modified 'dbeng_ll_new_table' to only open the table if the tid flag
# is a positive number. Mar/2006, Rick Smereka

# Fixed bug in 'db_delete_subsubfield' that failed to check for
# out of range subsubfield number. Apr/2006, Rick Smereka

# Changed 'db_put_subfield'  and 'db_put_subsubfield' to allow for no
# existing record. May/2006, Rick Smereka

# global data
# record, field, subfield, and subsubfield marker/delimiter values (ASCII)
const DBENG_RM 255
const DBENG_FM 254
const DBENG_SFM 253
const DBENG_SSFM 252

# size (in bytes) of the record header
const DBENG_REC_HEAD_SIZE 12

# system table autopack threshold
const DBENG_SYSTABLE_MAX_DELETED 25

set dbeng_table_count 0

proc db_initialize {} {
   # Initialize for database use. Must be called at the beginning
   # of each session. Returns a 'dbeng' code.
   global DBENG_CONFIG_FILE

   # load configuration details
   return [dbeng_config_read $DBENG_CONFIG_FILE]
}

proc db_end {} {
   # Shutdown the database engine. Close all tables in use.
   global dbeng_table DBENG_OK
   set mname "db_end"

   logman "$mname:enter"

   if {![array exists dbeng_table]} {
      logman "$mname:exit(0):array empty"
      return $DBENG_OK
   }

   # get the number of the last tid in use
   set lastid [expr [dbeng_get_tid] - 1]
   logman "$mname:last tid in use is $lastid"

   # loop through the array
   for {set i 1} {$i <= $lastid} {incr i} {
      # use catch to trap any gaps
      if {![catch {set ret $dbeng_table($i,name)}]} {
         db_close $i
      } else {
         logman "$mname:no table in use for tid $i"
      }
   }

   logman "$mname:normal exit"
   return $DBENG_OK
}

proc db_open {fname tid} {
   # Open a table. Returns the table 'tid'
   # upon success. Returns a 'dbeng' code.
   global DBENG_OK DBENG_INVALID_FILE_NAME
   upvar $tid lk
   set lk 0
   set mname "db_open"

   if {$fname == ""} {
      db_io_code_log $mname "fname parameter error" $DBENG_INVALID_FILE_NAME
      return $DBENG_INVALID_FILE_NAME
   }

   logman "$mname:enter:fname=$fname"

   # open the table using 'dbeng_ll_open_table'
   set ret [dbeng_ll_open_table $fname tmptid 0]

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

   set lk $tmptid
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc db_close {tid} {
   # Close a table. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_RECORD_CHANGED
   global dbeng_table_count
   set mname "db_close"

   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 {$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 [dbeng_ll_close $tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "warning:problem closing table" $ret
   }

   dbeng_unset_table $tid
   set dbeng_table_count [expr $dbeng_table_count - 1]
   logman "$mname:normal exit"
   return $DBENG_OK
}

proc db_next {tid} {
   # Obtain the next record in the table. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_RECORD_CHANGED
   global DBENG_FILE_DATA_ERROR DBENG_RM
   set mname "db_next"
   set done 0

   #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 {$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
   }

   # loop to get a record
   while {!$done} {
      set file_pos [tell $dbeng_table($tid,handle)]
      #logman "$mname:fp=$file_pos,op=$dbeng_table($tid,orig_position),\
      #       cp=$dbeng_table($tid,current_position)"
      
      # read/verify record header and return record length and status
      set ret [dbeng_record_header $tid len rec_status]

      if {$ret != $DBENG_OK} {
         if {$ret == $DBENG_FILE_DATA_ERROR} {
            set mes [format "%s:error in header of record %d,tid=%d" \
                      $mname [expr $dbeng_table($tid,record_number) + 1] $tid]
            logman $mes
            #dbeng_ferror $mes
         }

         # goto the top of the table on any error
         db_top $tid
         return $ret
      }

      # store starting position of this record
      set dbeng_table($tid,orig_position) $file_pos
   
      # get status and process only if active record considering the
      # 'process_deleted' flag
      if {$rec_status == "A"} {
         set process 1
      } else {
         set process 0
      }

      set dbeng_table($tid,record_status) $process
      set rm [format "%c" $DBENG_RM]

      if {!$process} {
         if {$rec_status == "D" && $dbeng_table($tid,process_deleted)} {
            set process 1
         }
      }

      # if marked for deletion, skip
      if {!$process && $rec_status == "D"} {
         set tmp [read $dbeng_table($tid,handle) $len]

         if {[string length $tmp] < $len} {
            set mes [format "%s:unexpected end of file reading record\
                     %d of table %s" $mname [expr \
                     $dbeng_table($tid,record_number) + 1] \
                     $dbeng_table($tid,name)]
            logman $mes
            #dbeng_ferror $mes
            return $DBENG_FILE_DATA_ERROR
         }

         # error if record mark is not the last byte
         if {[string index $tmp end] != $rm} {
            set mes [format "%s:error,no record mark on record %d,\
                     table=%s" $mname [expr \
                     $dbeng_table($tid,record_number) + 1] \
                     $dbeng_table($tid,name)]
            logman $mes
            #dbeng_ferror $mes
            return $DBENG_FILE_DATA_ERROR
         }
      }

      if {$process} {
         set done 1
         set tmp [read $dbeng_table($tid,handle) $len]

         if {[string length $tmp] < $len} {
            set mes [format "%s:unexpected end of file reading record\
                     %d of table %s" $mname [expr \
                     $dbeng_table($tid,record_number) + 1] \
                     $dbeng_table($tid,name)]
            logman $mes
            #dbeng_ferror $mes
            return $DBENG_FILE_DATA_ERROR
         }

         if {[string index $tmp end] != $rm} {
            set mes [format "%s:error,no record mark on record %d,\
                     table=%s" $mname [expr \
                     $dbeng_table($tid,record_number) + 1] \
                     $dbeng_table($tid,name)]
            logman $mes
            #dbeng_ferror $mes
            return $DBENG_FILE_DATA_ERROR
         }

         # set record and remove record separator
         set dbeng_table($tid,rec) [string replace $tmp end end]
         set dbeng_table($tid,current_position) [tell $dbeng_table($tid,handle)]
         incr dbeng_table($tid,record_number)
      }
   }

   #logman "$mname:exit(ok)"
   return $DBENG_OK
}

proc db_get_rec_num {tid rec_num} {
   # Obtain the current record number. Returns the current
   # record number in 'rec_num' upon success. Returns
   # a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_NO_RECORD
   upvar $rec_num urec_num
   set mname "db_get_rec_num"
   
   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 urec_num 0

   if {$dbeng_table($tid,record_number) <= 0} {
      db_io_code_log $mname "exit:no current rec" $DBENG_NO_RECORD
      return $DBENG_NO_RECORD
   }

   set urec_num $dbeng_table($tid,record_number)
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc db_get_pos {tid pos} {
   # Obtain the current file position. Returns the position of the
   # start of the current record in 'pos' upon success. Returns
   # a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_NO_RECORD
   upvar $pos upos
   set mname "db_get_pos"

   logman "$mname:enter"
   set upos 0

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

   if {$dbeng_table($tid,orig_position) < 0} {
      db_io_code_log $mname "exit:no current rec" $DBENG_NO_RECORD
      return $DBENG_NO_RECORD
   }

   set upos $dbeng_table($tid,orig_position)
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc db_set_pos {tid pos} {
   # Set the current file position. 'orig_position' will be updated
   # along with channel position. BE VERY CAREFUL. Be sure
   # there is a record at the specified 'pos'. Current record
   # contents are not changed. Only the channel position is
   # moved. A record is not read into the buffer. Returns a
   # 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_RECORD_CHANGED
   global DBENG_INVALID_FUNCTION
   set mname "db_set_pos"

   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 $pos]} {
      db_io_code_log $mname "exit:non-numeric(pos)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$pos < 0} {
      db_io_code_log $mname "exit:out of range(pos)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   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 dbeng_table($tid,orig_position) $pos
   set dbeng_table($tid,current_position) $pos
   seek $dbeng_table($tid,handle) $pos
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc db_get_change_rec_flag {tid flag} {
   # Obtain the current 'change_rec_flag' value. Returns the value
   # of the flag in 'flag' upon success. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_NO_RECORD
   upvar $flag uflag
   set mname "db_get_change_rec_flag"

   logman "$mname:enter"
   set uflag 0

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

   if {$dbeng_table($tid,orig_position) < 0} {
      db_io_code_log $mname "exit:no current rec" $DBENG_NO_RECORD
      return $DBENG_NO_RECORD
   }

   set uflag $dbeng_table($tid,change_rec_flag)
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc db_set_change_rec_flag {tid flag} {
   # Set a new 'change_rec_flag' value. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_INVALID_FUNCTION 
   global DBENG_NO_RECORD
   set mname "db_set_change_rec_flag"

   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 {$flag != 1 && $flag != 0} {
      db_io_code_log $mname "out of range(flag)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {[dbeng_is_active_rec $tid] == $DBENG_NO_RECORD} {
      db_io_code_log $mname "no current rec" $DBENG_NO_RECORD
      return $DBENG_NO_RECORD
   }

   set dbeng_table($tid,change_rec_flag) $flag
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc db_get_delete_flag {tid flag} {
   # Obtain the current 'process_deleted' value. Returns the
   # value of the flag in 'flag' upon success. Returns a
   # 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID
   upvar $flag uflag
   set mname "db_get_delete_flag"

   logman "$mname:enter"
   set uflag 0

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

   set uflag $dbeng_table($tid,process_deleted)
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc db_set_delete_flag {tid flag} {
   # Set a new 'process_deleted' value. Returns a 'dbeng' code.
   # 'flag' must be 1 or 0.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_INVALID_FUNCTION
   set mname "db_set_delete_flag"

   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 {$flag != 1 && $flag != 0} {
      db_io_code_log $mname "invalid(flag)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   set dbeng_table($tid,process_deleted) $flag
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc db_get_enf_change_rec_flag {tid flag} {
   # Obtain the current 'enforce_change_rec_flag' value. Returns the
   # value of the flag in 'flag' upon success. Returns a
   # 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID
   upvar $flag uflag
   set mname "db_get_enf_change_rec_flag"

   logman "$mname:enter"
   set uflag 0

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

   set uflag $dbeng_table($tid,enforce_change_rec_flag)
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc db_set_enf_change_rec_flag {tid flag} {
   # Set a new 'enforce_change_rec_flag' value. Returns a 'dbeng' code.
   # 'flag' must be 1 or 0.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_INVALID_FUNCTION
   set mname "db_set_enf_change_rec_flag"

   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 {$flag != 1 && $flag != 0} {
      db_io_code_log $mname "invalid(flag)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   set dbeng_table($tid,enforce_change_rec_flag) $flag
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc db_get_autopack {tid pvalue} {
   # Obtain the current 'autopack' value. Returns the value in
   # 'pvalue' upon success. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID
   upvar $pvalue upvalue
   set mname "db_get_autopack"

   logman "$mname:enter"
   set upvalue 0

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

   set upvalue $dbeng_table($tid,autopack)
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}
   
proc db_set_autopack {tid pvalue} {
   # Set a new 'autopack' value. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_INVALID_FUNCTION
   set mname "db_set_autopack"

   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 {$pvalue < 0} {
      db_io_code_log $mname "out of range(pvalue)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   set dbeng_table($tid,autopack) $pvalue
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc db_get_is_table_locked {tid flag} {
   # Obtain the current 'is_table_locked' value. Returns the
   # value of the flag in 'flag'. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID
   upvar $flag uflag
   set mname "db_get_is_table_locked"

   logman "$mname:enter:tid=$tid"
   set uflag 0

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

   set uflag $dbeng_table($tid,is_table_locked)
   logman "$mname:normal exit:flag=$uflag"
   return $DBENG_OK
}

proc db_set_is_table_locked {tid flag} {
   # Set a new 'is_table_locked' value. 'flag' must be zero or one.
   # Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_INVALID_FUNCTION DBENG_TABLE_LOCKED
   global DBENG_NO_SUCH_TID
   set mname "db_set_is_table_locked"

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

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

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

   if {$flag != 1 && $flag != 0} {
      db_io_code_log $mname "exit:out of range(flag)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$flag && $dbeng_table($tid,is_table_locked)} {
      db_io_code_log $mname "exit:table already locked" $DBENG_TABLE_LOCKED
      return $DBENG_TABLE_LOCKED
   }

   if {$flag == $dbeng_table($tid,is_table_locked)} {
      db_io_code_log $mname "exit:flag is already same value" $DBENG_OK
      return $DBENG_OK
   }

   if {$flag} {
      set ret [dbeng_lock_table $tid]
   } else {
      set ret [dbeng_unlock_table $tid]
   }

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

proc db_top {tid} {
   # Goto the top of a table. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_RECORD_CHANGED DBENG_NO_SUCH_TID
   set mname "db_top"

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

   seek $dbeng_table($tid,handle) 0
   set dbeng_table($tid,rec) ""
   set dbeng_table($tid,record_number) 0
   set dbeng_table($tid,orig_position) -1
   set dbeng_table($tid,current_position) 0
   set dbeng_table($tid,change_rec_flag) 0
   logman "$mname:normal exit(ok)"
   return $DBENG_OK
}

proc db_get_rec_count {tid active_count deleted_count} {
   # Get the current active and deleted record counts. Upon success,
   # the active record count will be returned in 'active_count'
   # and the deleted record count will be returned in
   # 'deleted_count'. Returns a 'dbeng' code.
   global dbeng_table DBENG_NO_SUCH_TID DBENG_OK
   upvar $active_count uactive_count
   upvar $deleted_count udeleted_count
   set mname "db_get_rec_count"

   logman "$mname:enter"
   set uactive_count 0
   set udeleted_count 0

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

   set uactive_count $dbeng_table($tid,active_record_count)
   set udeleted_count $dbeng_table($tid,deleted_record_count)
   logman "$mname:normal exit(ok)"
   return $DBENG_OK
}

proc db_goto {tid rec_num} {
   # Goto a specific record in the file. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_INVALID_FUNCTION DBENG_RECORD_CHANGED
   global DBENG_NO_SUCH_TID DBENG_EOF
   set mname "db_goto"

   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 {![num $rec_num]} {
      db_io_code_log $mname "non-numeric(rec_num)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$rec_num <= 0} {
      db_io_code_log $mname "out of range(rec_num)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }
      
   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 "error going top" $ret
      return $ret
   }

   set ret [db_next $tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "bad ret first(db_next)" $ret
      return $ret
   }

   for {set i 1} {$i < $rec_num} {incr i} {
      if {[db_next $tid] == $DBENG_EOF && $i < $rec_num} {
         db_io_code_log $mname "exit with eof" $DBENG_EOF
         return $DBENG_EOF
      }
   }

   logman "$mname:normal exit(ok)"
   return $DBENG_OK
}

proc db_count {tid active_num deleted_num} {
   # Physically count the number of active and deleted records in table
   # 'tid' and return upon success. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_RECORD_CHANGED DBENG_NO_SUCH_TID DBENG_EOF
   upvar $active_num uactive_num
   upvar $deleted_num udeleted_num
   set uactive_num 0
   set udeleted_num 0
   set mname "db_count"

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

   # get current value of 'process_deleted' flag
   db_get_delete_flag $tid delete_flag

   # force flag high to process all records
   db_set_delete_flag $tid 1
   set done 0
   set active 0
   set deleted 0
   set ret [db_top $tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "error going top" $ret
      return $ret
   }

   while {!$done} {
      set ret [db_next $tid]

      if {$ret == $DBENG_EOF} {
         set done 1
      } elseif {$ret != $DBENG_OK} {
         return $ret
      } else {
         if {$dbeng_table($tid,record_status)} {
            incr active
         } else {
            incr deleted
         }
      }
   }

   # set flag back to original value
   db_set_delete_flag $tid $delete_flag
   logman "$mname:normal exit:$active active,$deleted deleted records counted"
   set uactive_num $active
   set udeleted_num $deleted
   return $DBENG_OK
}

proc db_pack {tid} {
   # Pack a table by copying only active records. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_RECORD_CHANGED DBENG_NO_SUCH_TID DBENG_EOF
   global DBENG_TABLE_LOCKED DBENG_UNABLE_TO_OPEN DBENG_INTERNAL_ERROR
   set mname "db_pack"

   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"

   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
   }

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

   set ret [dbeng_tmp_systable dest_tid]

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

   logman "$mname:output tmp table is $dbeng_table($dest_tid,name)"
   set dest_name $dbeng_table($dest_tid,name)

   # force source 'process_deleted' flag down (save prev value)
   set delete_flag $dbeng_table($tid,process_deleted)
   set dbeng_table($tid,process_deleted) 0

   # copy source to destination
   set ret [dbeng_ll_copy_table $tid $dest_tid]

   if {$ret != $DBENG_OK} {
      db_close $dest_tid
      file delete $dest_name
      set dbeng_table($tid,process_deleted) $delete_flag
      db_io_code_log $mname "bad ret from dbeng_ll_copy_table" $ret
      return $ret
   }

   # fix-up record counts
   set dbeng_table($tid,active_record_count) \
       $dbeng_table($dest_tid,active_record_count)
   set dbeng_table($tid,deleted_record_count) 0

   # close output (temporary) table
   set ret [db_close $dest_tid]

   if {$ret != $DBENG_OK} {
      file delete $dest_name
      set dbeng_table($tid,process_deleted) $delete_flag
      db_io_code_log $mname "error closing tmp table" $ret
      return $ret
   }

   # close source table (but retain entry in array)
   set ret [dbeng_ll_close $tid]

   if {$ret != $DBENG_OK} {
      file delete $dest_name
      set dbeng_table($tid,process_deleted) $delete_flag
      db_io_code_log $mname "error closing source table" $ret
      return $ret
   }
      
   # delete source table
   file delete $dbeng_table($tid,name)

   # rename temporary table to source
   file rename $dest_name $dbeng_table($tid,name)

   # re-open table
   set ret [dbeng_ll_open $tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "error re-opening source file" $DBENG_UNABLE_TO_OPEN
      return $DBENG_UNABLE_TO_OPEN
   }

   # goto top of table
   db_top $tid

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

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "error setting record count" $DBENG_INTERNAL_ERROR
      return $DBENG_INTERNAL_ERROR
   }

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

proc db_copy_table {src_tid dest_tid} {
   # Copy a table from source to destination. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_INVALID_FUNCTION DBENG_NO_SUCH_TID 
   global DBENG_RECORD_CHANGED
   set mname "db_copy_table"

   logman "$mname:enter"

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

   if {$src_tid <= 0} {
      db_io_code_log $mname "out of range(src_tid)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

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

   if {$dest_tid <= 0} {
      db_io_code_log $mname "out of range(dest_tid)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

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

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

   # check for changed records in both source and destination table
   if {$dbeng_table($src_tid,enforce_change_rec_flag) && \
       $dbeng_table($src_tid,change_rec_flag)} {
      db_io_code_log $mname "record changed" $DBENG_RECORD_CHANGED
      return $DBENG_RECORD_CHANGED
   }

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

   set ret [dbeng_ll_copy_table $src_tid $dest_tid]

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

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

proc db_new {tid} {
   # Initialize for a new record. Note that if the current
   # record has changed and we are enforcing 'change_rec_flag',
   # this proc will return that cide and the initialization will
   # not take place.
   global dbeng_table DBENG_OK DBENG_RECORD_CHANGED DBENG_NO_SUCH_TID
   set mname "db_new"

   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 {$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 dbeng_table($tid,rec) ""
   set dbeng_table($tid,record_number) 0
   set dbeng_table($tid,orig_position) -1
   set dbeng_table($tid,current_postion) 0
   set dbeng_table($tid,change_rec_flag) 0
   logman "$mname:normal exit"
   return $DBENG_OK
}

proc db_get_rec {tid rec_out} {
   # Copy and return the current record into 'rec_out. Returns a
   # 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_NO_RECORD
   upvar $rec_out urec_out
   set mname "db_get_rec"
   
   # logman "$mname:enter"
   
   if {![dbeng_atid_lookup $tid]} {
      db_io_code_log $mname "exit:bad tid" $DBENG_NO_SUCH_TID
      set urec_out ""
      return $DBENG_NO_SUCH_TID
   }

   if {[dbeng_is_active_rec $tid] == $DBENG_NO_RECORD} {
      db_io_code_log $mname "no current rec" $DBENG_NO_RECORD
      set urec_out ""
      return $DBENG_NO_RECORD
   }

   set urec_out $dbeng_table($tid,rec)
   # logman "$mname:normal exit"
   return $DBENG_OK
}

proc db_get_rec_size {tid rec_size} {
   # Get the table record size or length. Record size is returned in
   # 'rec_size' upon success. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_NO_RECORD
   upvar $rec_size urec_size
   set mname "db_get_rec_size"
  
   logman "$mname:enter"
   set urec_size 0

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

   if {[dbeng_is_active_rec $tid] == $DBENG_NO_RECORD} {
      db_io_code_log $mname "no current rec" $DBENG_NO_RECORD
      return $DBENG_NO_RECORD
   }

   set urec_size [string length $dbeng_table($tid,rec)]
   logman "$mname:normal exit"
   return $DBENG_OK
}

proc db_get_field_size {tid field_num field_size} {
   # Get the size or length of field 'field_num' in the current
   # record. Variable 'field_size' will be loaded with the
   # field size upon success. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_NO_RECORD
   global DBENG_INVALID_FUNCTION DBENG_NO_SUCH_FIELD DBENG_FM
   upvar $field_size ufield_size
   set mname "db_get_field_size"
  
   logman "$mname:enter"
   set ufield_size 0

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

   if {![num $field_num]} {
      db_io_code_log $mname "exit:non-numeric(field_num)" \
                     $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$field_num <= 0} {
      db_io_code_log $mname "exit:out of range(field_num)" \
                     $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {[dbeng_is_active_rec $tid] == $DBENG_NO_RECORD} {
      db_io_code_log $mname "no current rec" $DBENG_NO_RECORD
      return $DBENG_NO_RECORD
   }

   set ret [db_get_nfields $tid nfields]

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

   if {$field_num > $nfields} {
      db_io_code_log $mname "exit:field out of range" $DBENG_NO_SUCH_FIELD
      return $DBENG_NO_SUCH_FIELD
   }

   set fm [format "%c" $DBENG_FM]
   set ufield_size [ll_wordlen $dbeng_table($tid,rec) $field_num $fm]
   logman "$mname:normal exit"
   return $DBENG_OK
}
   
proc db_get_subfield_size {tid field_num subfield_num subfield_size} {
   # Get the size or length of subfield 'subfield_num'
   # within the field 'field_num' in the current
   # record. Variable 'subfield_size' will be loaded withe the
   # subfield size upon success. Returns a 'dbeng' code.
   global DBENG_OK DBENG_NO_SUCH_TID DBENG_NO_RECORD
   global DBENG_INVALID_FUNCTION DBENG_NO_SUCH_SUBFIELD DBENG_SFM
   upvar $subfield_size usubfield_size
   set mname "db_get_subfield_size"
  
   logman "$mname:enter"
   set usubfield_size 0

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

   if {![num $field_num]} {
      db_io_code_log $mname "exit:non-numeric(field_num)" \
                     $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$field_num <= 0} {
      db_io_code_log $mname "exit:out of range(field_num)" \
                     $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {![num $subfield_num]} {
      db_io_code_log $mname "exit:non-numeric(subfield_num)" \
                     $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$subfield_num <= 0} {
      db_io_code_log $mname "exit:out of range(subfield_num)" \
                     $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {[dbeng_is_active_rec $tid] == $DBENG_NO_RECORD} {
      db_io_code_log $mname "no current rec" $DBENG_NO_RECORD
      return $DBENG_NO_RECORD
   }

   set ret [db_get_nsubfields $tid $field_num nsubfields]

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

   if {$subfield_num > $nsubfields} {
      db_io_code_log $mname "exit:subfield out of range" $DBENG_NO_SUCH_SUBFIELD
      return $DBENG_NO_SUCH_SUBFIELD
   }

   set ret [db_get_field $tid $field_num thefield]

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

   set sfm [format "%c" $DBENG_SFM]
   set usubfield_size [ll_wordlen $thefield $subfield_num $sfm]
   logman "$mname:normal exit"
   return $DBENG_OK
}

proc db_get_subsubfield_size {tid field_num subfield_num subsubfield_num \
                              subsubfield_size} {
   # Get the size or length of subsubfield 'subsubfield_num'
   # within the subfield 'subfield_num' in the current
   # record. Variable 'subsubfield_size' will be loaded with the
   # subsubfield size upon success. Returns a 'dbeng' code.
   global DBENG_OK DBENG_NO_SUCH_TID DBENG_NO_RECORD
   global DBENG_INVALID_FUNCTION DBENG_NO_SUCH_SUBSUBFIELD DBENG_SSFM
   upvar $subsubfield_size usubsubfield_size
   set mname "db_get_subsubfield_size"
  
   logman "$mname:enter"
   set usubsubfield_size 0

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

   if {![num $field_num]} {
      db_io_code_log $mname "exit:non-numeric(field_num)" \
                     $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$field_num <= 0} {
      db_io_code_log $mname "exit:out of range(field_num)" \
                     $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {![num $subfield_num]} {
      db_io_code_log $mname "exit:non-numeric(subfield_num)" \
                     $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$subfield_num <= 0} {
      db_io_code_log $mname "exit:out of range(subfield_num)" \
                     $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {![num $subsubfield_num]} {
      db_io_code_log $mname "exit:non-numeric(subsubfield_num)" \
                     $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$subsubfield_num <= 0} {
      db_io_code_log $mname "exit:out of range(subsubfield_num)" \
                     $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {[dbeng_is_active_rec $tid] == $DBENG_NO_RECORD} {
      db_io_code_log $mname "no current rec" $DBENG_NO_RECORD
      return $DBENG_NO_RECORD
   }

   set ret [db_get_nsubsubfields $tid $field_num $subfield_num nsubsubfields]

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

   if {$subsubfield_num > $nsubsubfields} {
      db_io_code_log $mname "exit:subsubfield out of range" \
                     $DBENG_NO_SUCH_SUBSUBFIELD
      return $DBENG_NO_SUCH_SUBSUBFIELD
   }

   set ret [db_get_subfield $tid $field_num $subfield_num thesubfield]

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

   set ssfm [format "%c" $DBENG_SSFM]
   set usubsubfield_size [ll_wordlen $thesubfield $subsubfield_num $ssfm]
   logman "$mname:normal exit"
   return $DBENG_OK
}

proc db_write {tid} {
   # Write a new record or rewrite and existing record depending on
   # the table record counter and the current record status (if any).
   # The record contents must already be loaded and if a record
   # exists, the file pointer must be at the record. Returns
   # a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_NO_RECORD
   global DBENG_TABLE_LOCKED
   set mname "db_write"

   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 {[dbeng_is_active_rec $tid] == $DBENG_NO_RECORD} {
      db_io_code_log $mname "no current rec" $DBENG_NO_RECORD
      return $DBENG_NO_RECORD
   }

   # 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 there is not a current record in memory write a new one
   if {!$dbeng_table($tid,record_number)} {
      logman "$mname:writing a new record"
      set ret [dbeng_write_new_recd $tid]
   } elseif {!$dbeng_table($tid,record_status)} {
      # if the current record status is 'deleted', write a new record
      logman "$mname:record already marked for deletion,writing a new rec"
      set ret [dbeng_write_new_recd $tid]
   } else {
      # re-write existing record
      logman "$mname:rewriting existing record"
      set ret [dbeng_rewrite_recd $tid]
   }

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

proc db_delete {tid} {
   # Mark the current record for deletion. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_NO_EXISTING_RECORD
   global DBENG_RECORD_CHANGED DBENG_TABLE_LOCKED
   global DBENG_RECORD_POSITION_CHANGED
   set mname "db_delete"

   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
   }

   # make sure there is an already existing record
   if {$dbeng_table($tid,orig_position) == -1 || \
       $dbeng_table($tid,record_number) == 0} {
      db_io_code_log $mname "no current record" $DBENG_NO_EXISTING_RECORD
      return $DBENG_NO_EXISTING_RECORD
   }
   
   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
   }

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

   # goto the start of the current record
   seek $dbeng_table($tid,handle) $dbeng_table($tid,orig_position)

   # verify that there is a valid record here
   set ret [dbeng_record_header $tid len rec_status]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "record header invalid,going to top" $ret
      db_top $tid
      return $DBENG_RECORD_POSITION_CHANGED
   }

   # go back to the start of the record
   seek $dbeng_table($tid,handle) $dbeng_table($tid,orig_position)
   
   # rewrite the first byte of the record
   puts -nonewline $dbeng_table($tid,handle) "D"

   set dbeng_table($tid,active_record_count) [expr \
       $dbeng_table($tid,active_record_count) - 1]
   incr dbeng_table($tid,deleted_record_count)
   set dbeng_table($tid,change_rec_flag) 0

   # pack if autopack threshold is exceeded
   if {$dbeng_table($tid,autopack) && \
       $dbeng_table($tid,deleted_record_count) >= \
       $dbeng_table($tid,autopack)} {
      logman "$mname:autopack threshold exceeded,autopacking"
      set ret [db_pack $tid]
   
      if {$ret != $DBENG_OK} {
         db_io_code_log $mname "error autopacking" $ret
         return $ret
      }
   } else {
      # 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" $ret
         return $ret
      }
   }

   # since file position is now unknown, goto top of table
   db_top $tid
   logman "$mname:normal exit"
   return $DBENG_OK
}
  
proc db_get_nfields {tid nfields} {
   # Get the number of fields in the current record. The number of fields
   # is returned in 'nfields' upon success. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_FM
   upvar $nfields unfields
   set unfields 0
   set mname "db_get_nfields"

   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
   }

   set ret [dbeng_is_active_rec $tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "no current rec" $ret
      return $ret
   }

   set fm [format "%c" $DBENG_FM]
   set unfields [ll_words $dbeng_table($tid,rec) $fm]
   logman "$mname:normal exit"
   return $DBENG_OK
}

proc db_get_nsubfields {tid fieldno nsubfields} {
   # Get the number of subfields in the 'fieldno' field. The
   # number of subfields is returned in 'nsubfields' upon
   # success. Returns a 'dbeng' code.
   global DBENG_OK DBENG_NO_SUCH_TID DBENG_INVALID_FUNCTION DBENG_SFM
   upvar $nsubfields unsubfields
   set mname "db_get_nsubfields"

   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 $fieldno]} {
      db_io_code_log $mname "exit:non-numeric(fieldno)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$fieldno <= 0} {
      db_io_code_log $mname "out of range(fieldno)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   set unsubfields 0
   set ret [dbeng_is_active_rec $tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "no current rec" $ret
      return $ret
   }

   set thefield ""
   set ret [db_get_field $tid $fieldno thefield]

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

   set sfm [format "%c" $DBENG_SFM]
   set unsubfields [ll_words $thefield $sfm]
   logman "$mname:normal exit:nsubfields=$unsubfields"
   return $DBENG_OK
}

proc db_get_nsubsubfields {tid fieldno sfieldno nsubsubfields} {
   # Get the number of subsubfields in the 'sfieldno' subfield. The
   # number of subsubfields is returned in 'nsubsubfields' upon
   # success. Returns a 'dbeng' code.
   global DBENG_OK DBENG_NO_SUCH_TID DBENG_INVALID_FUNCTION DBENG_SSFM
   upvar $nsubsubfields unsubsubfields
   set mname "db_get_nsubsubfields"

   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 $fieldno]} {
      db_io_code_log $mname "exit:non-numeric(fieldno)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

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

   if {$fieldno <= 0} {
      db_io_code_log $mname "out of range(fieldno)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$sfieldno <= 0} {
      db_io_code_log $mname "out of range(sfieldno)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   set unsubsubfields 0
   set ret [dbeng_is_active_rec $tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "no current rec" $ret
      return $ret
   }

   set thesfield ""
   set ret [db_get_subfield $tid $fieldno $sfieldno thesubfield]

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

   set ssfm [format "%c" $DBENG_SSFM]
   set unsubsubfields [ll_words $thesubfield $ssfm]
   logman "$mname:normal exit:nsubsubfields=$unsubsubfields"
   return $DBENG_OK
}

proc db_get_field {tid field_num field_out} {
   # Obtain the 'field_num' field in the record specified by 'tid.'
   # Returns the field contents in 'field_out' upon success.
   # Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_FM
   global DBENG_INVALID_FUNCTION DBENG_NO_SUCH_FIELD
   upvar $field_out ufield_out
   set ufield_out ""
   set mname "db_get_field"

   #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 {![num $field_num]} {
      db_io_code_log $mname "non-numeric(field_num)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$field_num <= 0} {
      db_io_code_log $mname "out of range(field_num)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   set ret [dbeng_is_active_rec $tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "no current rec" $ret
      return $ret
   }

   set fm [format "%c" $DBENG_FM]
   set nwords [ll_words $dbeng_table($tid,rec) $fm]

   # if field is out of range, error
   if {$field_num > $nwords} {
      logman "$mname:field $field_num is out of range"
      return $DBENG_NO_SUCH_FIELD
   }

   ll_word $dbeng_table($tid,rec) field $field_num $fm
   set ufield_out $field
   #logman "$mname:normal exit"
   return $DBENG_OK
}

proc db_get_subfield {tid field_num subfield_num subfield_out} {
   # Obtain the 'subfield_num' subfield in the field specified by 'field_num.'
   # Returns the subfield contents in 'subfield_out' upon success.
   # Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_SFM
   global DBENG_INVALID_FUNCTION DBENG_NO_SUCH_SUBFIELD
   upvar $subfield_out usubfield_out
   set usubfield_out ""
   set mname "db_get_subfield"

   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 $field_num]} {
      db_io_code_log $mname "non-numeric(field_num)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

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

   if {$field_num <= 0} {
      db_io_code_log $mname "out of range(field_num)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$subfield_num <= 0} {
      db_io_code_log $mname "out of range(subfield_num)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   set ret [dbeng_is_active_rec $tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "no current rec" $ret
      return $ret
   }

   set ret [db_get_nsubfields $tid $field_num nsubfields]

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

   if {$subfield_num > $nsubfields} {
      db_io_code_log $mname "exit:out of range(subfield_num)" \
                     $DBENG_NO_SUCH_SUBFIELD
      return $DBENG_NO_SUCH_SUBFIELD
   }

   set ret [db_get_field $tid $field_num thefield]

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

   set sfm [format "%c" $DBENG_SFM]
   ll_word $thefield s_out $subfield_num $sfm
   set usubfield_out $s_out
   logman "$mname:normal exit"
   return $DBENG_OK
}

proc db_get_subsubfield {tid field_num subfield_num subsubfield_num \
                         subsubfield_out} {
   # Obtain the 'subsubfield_num' subsubfield in the subfield specified by 
   # 'subfield_num.' Returns the subsubfield contents in 'subsubfield_out' 
   # upon success. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_SSFM
   global DBENG_INVALID_FUNCTION DBENG_NO_SUCH_SUBSUBFIELD
   upvar $subsubfield_out usubsubfield_out
   set usubsubfield_out ""
   set mname "db_get_subsubfield"

   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 $field_num]} {
      db_io_code_log $mname "non-numeric(field_num)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

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

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

   if {$field_num <= 0} {
      db_io_code_log $mname "out of range(field_num)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$subfield_num <= 0} {
      db_io_code_log $mname "out of range(subfield_num)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$subsubfield_num <= 0} {
      db_io_code_log $mname "out of range(subsubfield_num)" \
                     $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   set ret [dbeng_is_active_rec $tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "no current rec" $ret
      return $ret
   }

   set ret [db_get_nsubsubfields $tid $field_num $subfield_num nsubsubfields]

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

   if {$subsubfield_num > $nsubsubfields} {
      db_io_code_log $mname "exit:out of range(subsubfield_num)" \
                     $DBENG_NO_SUCH_SUBSUBFIELD
      return $DBENG_NO_SUCH_SUBSUBFIELD
   }

   set ret [db_get_subfield $tid $field_num $subfield_num thesubfield]

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

   set ssfm [format "%c" $DBENG_SSFM]
   ll_word $thesubfield s_out $subsubfield_num $ssfm
   set usubsubfield_out $s_out
   logman "$mname:normal exit"
   return $DBENG_OK
}

proc db_put_field {tid field_num field_data} {
   # Store new data in a field. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_FM
   global DBENG_INVALID_FUNCTION DBENG_PUT_ERROR
   set mname "db_put_field"

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

   set ret [dbeng_put_which_field $tid $field_num new_field_num]

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

   logman [format "%s:enter:tid=%d,d=%s,l=%d,f=%d,nf=%d" $mname $tid \
           $field_data [string length $field_data] $field_num $new_field_num]

   # existing record can be empty
   set fm [format "%c" $DBENG_FM]
   
   if {![ll_wordput $dbeng_table($tid,rec) new_rec $field_data \
        $new_field_num $fm]} {
      db_io_code_log $mname "bad rc(ll_wordput)" $DBENG_PUT_ERROR
      return $DBENG_PUT_ERROR
   }

   set dbeng_table($tid,rec) $new_rec
   set dbeng_table($tid,change_rec_flag) 1
   logman "$mname:normal exit"
   return $DBENG_OK
}

proc db_put_subfield {tid field_num subfield_num new_data} {
   # Store new data in a subfield. Returns a 'dbeng' code.
   global DBENG_OK DBENG_NO_SUCH_TID DBENG_SFM
   global DBENG_NO_SUCH_FIELD DBENG_PUT_ERROR DBENG_NO_RECORD
   set mname "db_put_subfield"

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

   set ret [dbeng_put_which_subfield $tid $field_num $subfield_num \
            new_fnum new_sfnum]

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

   logman [format "%s:enter:tid=%d,d=%s,l=%d,f=%d,sf=%d,nf=%d,nsf=%d" $mname \
           $tid $new_data [string length $new_data] $field_num $subfield_num \
           $new_fnum $new_sfnum]

   # existing field can be empty
   set ret [db_get_field $tid $new_fnum old_field]

   if {$ret != $DBENG_OK} {
      if {$ret == $DBENG_NO_SUCH_FIELD || $ret == $DBENG_NO_RECORD} {
         set old_field ""
      } else {
         db_io_code_log $mname "bad rc from db_get_field" $ret
         return $ret
      }
   }

   set sfm [format "%c" $DBENG_SFM]
   
   if {![ll_wordput $old_field new_field $new_data $new_sfnum $sfm]} {
      db_io_code_log $mname "bad rc(ll_wordput)" $DBENG_PUT_ERROR
      return $DBENG_PUT_ERROR
   }

   # replace field
   set ret [db_put_field $tid $new_fnum $new_field]

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

   logman "$mname:normal exit"
   return $DBENG_OK
}

proc db_put_subsubfield {tid field_num subfield_num subsubfield_num new_data} {
   # Store new data in a subsubfield. Returns a 'dbeng' code.
   global DBENG_OK DBENG_NO_SUCH_TID DBENG_SSFM DBENG_NO_SUCH_FIELD
   global DBENG_NO_SUCH_SUBFIELD DBENG_PUT_ERROR DBENG_NO_RECORD
   set mname "db_put_subsubfield"

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

   set ret [dbeng_put_which_subsubfield $tid $field_num $subfield_num \
            $subsubfield_num new_fnum new_sfnum new_ssfnum]

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

   logman [format "%s:enter:tid=%d,d=%s,l=%d,f=%d,sf=%d,ssf=%d,nf=%d,nsf=%d,\
                   nssf=%d" $mname $tid $new_data [string length $new_data] \
                   $field_num $subfield_num $subsubfield_num $new_fnum \
                   $new_sfnum $new_ssfnum]

   # existing subfield can be empty
   set ret [db_get_subfield $tid $new_fnum $new_sfnum old_subfield]

   if {$ret != $DBENG_OK} {
      if {$ret == $DBENG_NO_SUCH_SUBFIELD || $ret == $DBENG_NO_SUCH_FIELD\
          || $ret == $DBENG_NO_RECORD} {
         set old_subfield ""
      } else {
         db_io_code_log $mname "bad rc from db_get_subfield" $ret
         return $ret
      }
   }

   set ssfm [format "%c" $DBENG_SSFM]
   
   if {![ll_wordput $old_subfield new_subfield $new_data $new_ssfnum $ssfm]} {
      db_io_code_log $mname "bad rc(ll_wordput)" $DBENG_PUT_ERROR
      return $DBENG_PUT_ERROR
   }

   # replace subfield
   set ret [db_put_subfield $tid $new_fnum $new_sfnum $new_subfield]

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

   logman "$mname:normal exit"
   return $DBENG_OK
}

proc db_find {tid cs_flag find_str field_num} {
   # Locate 'find_str' within record data. All fields within
   # each record will be searched. Find will begin at the current
   # record and continue until EOF or a record is found. Only
   # whole fields will match. String comparison is based on
   # 'cs_flag' for case sensitivity (1 is case insensitive,
   # 0 is case sensitive). Returns a 'dbeng' code. If the find
   # was successful, 'field_num' will be loaded with the field
   # number that matched.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_RECORD_CHANGED
   global DBENG_INVALID_FUNCTION DBENG_FM
   upvar $field_num ufield_num
   set mname "db_find"
   set ufield_num 0

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

   if {$cs_flag != 1 && $cs_flag != 0} {
      db_io_code_log $mname "exit:must be 0|1(cs_flag)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   logman "$mname:enter:tid=$tid,cs=$cs_flag,fs=$find_str,\
           l=[string length $find_str]"

   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
   }

   # get a record if none is present (do not count unsaved rec
   # in memory if one is present)
   if {$dbeng_table($tid,record_number) == 0} {
      db_top $tid
      set ret [db_next $tid]

      if {$ret != $DBENG_OK} {
         db_io_code_log $mname "exit:bad ret from first(db_next)" $ret
         return $ret
      }
   }

   set done 0
   set dbeng_table($tid,change_rec_flag) 0
   set fm [format "%c" $DBENG_FM]

   while {!$done} {
      set nwords [ll_words $dbeng_table($tid,rec) $fm]

      for {set i 1} {$i <= $nwords} {incr i} {
         set ret [db_get_field $tid $i field_data]

         if {$ret != $DBENG_OK} {
            db_io_code_log $mname "bad ret(get_field)" $ret
            return $ret
         }

         set cmp_result [dbeng_compare_field $field_data $find_str $cs_flag]

         if {!$cmp_result} {
            set ufield_num $i
            db_io_code_log $mname "match found,normal exit" $DBENG_OK
            return $DBENG_OK
         }
      }

      set ret [db_next $tid]

      if {$ret != $DBENG_OK} {
         set done 1
      }
   }

   db_io_code_log $mname "no match,normal exit" $ret
   return $ret
}
      
proc db_find_field {tid cs_flag find_str field_num} {
   # Locate 'find_str' within the 'field_num' field of a record.
   # Each record will be searched. Find will begin at the current
   # record and continue until EOF or a record is found. Only
   # whole fields will match. String comparison is based on
   # 'cs_flag' for case sensitivity (1 is case insensitive,
   # 0 is case sensitive). Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_RECORD_CHANGED
   global DBENG_INVALID_FUNCTION DBENG_FM
   set mname "db_find_field"

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

   if {$cs_flag != 1 && $cs_flag != 0} {
      db_io_code_log $mname "exit:must be 0|1(cs_flag)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

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

   if {$field_num <= 0} {
      db_io_code_log $mname "out of range(field_num)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   logman "$mname:enter:tid=$tid,cs=$cs_flag,fs=$find_str,\
           l=[string length $find_str],fn=$field_num"

   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
   }

   # get a record if none is present (do not count unsaved rec
   # in memory if one is present)
   if {$dbeng_table($tid,record_number) == 0} {
      logman "$mname:no current record,getting first"
      db_top $tid
      set ret [db_next $tid]

      if {$ret != $DBENG_OK} {
         db_io_code_log $mname "exit:bad ret from first(db_next)" $ret
         return $ret
      }
   }

   set done 0
   set dbeng_table($tid,change_rec_flag) 0
   set fm [format "%c" $DBENG_FM]

   while {!$done} {
      set nwords [ll_words $dbeng_table($tid,rec) $fm]

      if {$nwords >= $field_num} {
         set ret [db_get_field $tid $field_num field_data]

         if {$ret != $DBENG_OK} {
            db_io_code_log $mname "bad ret(get_field)" $ret
            return $ret
         }

         set cmp_result [dbeng_compare_field $field_data $find_str $cs_flag]

         if {!$cmp_result} {
            db_io_code_log $mname "match found,normal exit" $DBENG_OK
            return $DBENG_OK
         }
      }

      set ret [db_next $tid]

      if {$ret != $DBENG_OK} {
         set done 1
      }
   }

   db_io_code_log $mname "no match,normal exit" $ret
   return $ret
}

proc db_find_part {tid cs_flag find_str field_num} {
   # Locate 'find_str' within record data. All fields within
   # each record will be searched. Find will begin at the current
   # record and continue until EOF or a record is found. Any
   # part of a field will match. String comparison is based on
   # 'cs_flag' for case sensitivity (1 is case insensitive,
   # 0 is case sensitive). Returns a 'dbeng' code. If the find
   # was successful, 'field_num' will be loaded with the field
   # number that matched.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_RECORD_CHANGED
   global DBENG_INVALID_FUNCTION DBENG_FM
   upvar $field_num ufield_num
   set mname "db_find_part"
   set ufield_num 0

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

   if {$cs_flag != 1 && $cs_flag != 0} {
      db_io_code_log $mname "exit:must be 0|1(cs_flag)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   logman "$mname:enter:tid=$tid,cs=$cs_flag,fs=$find_str,\
           l=[string length $find_str]"

   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
   }

   # get a record if none is present (do not count unsaved rec
   # in memory if one is present)
   if {$dbeng_table($tid,record_number) == 0} {
      db_top $tid
      set ret [db_next $tid]

      if {$ret != $DBENG_OK} {
         db_io_code_log $mname "exit:bad ret from first(db_next)" $ret
         return $ret
      }
   }

   set done 0
   set dbeng_table($tid,change_rec_flag) 0
   set fm [format "%c" $DBENG_FM]

   while {!$done} {
      set nwords [ll_words $dbeng_table($tid,rec) $fm]

      for {set i 1} {$i <= $nwords} {incr i} {
         set ret [db_get_field $tid $i field_data]

         if {$ret != $DBENG_OK} {
            db_io_code_log $mname "bad ret(get_field)" $ret
            return $ret
         }

         set process 1

         # do not compare if length of field is less than length
         # of search string
         if {[string length $field_data] < [string length $find_str]} {
            set process 0
         }

         if {$process} {
            if {$cs_flag} {
               set tmp_data [string toupper $field_data]
               set tmp_str [string toupper $find_str]
            } else {
               set tmp_data $field_data
               set tmp_str $find_str
            }

            if {[string first $tmp_str $tmp_data] != -1} {
               set ufield_num $i
               db_io_code_log $mname "match found,normal exit" $DBENG_OK
               return $DBENG_OK
            }
         }
      }

      set ret [db_next $tid]

      if {$ret != $DBENG_OK} {
         set done 1
      }
   }

   db_io_code_log $mname "no match,normal exit" $ret
   return $ret
}

proc db_find_field_part {tid cs_flag find_str field_num} {
   # Locate 'find_str' within the 'field_num' field of a record.
   # Each record will be searched. Find will begin at the current
   # record and continue until EOF or a record is found. Any part
   # of the field will match. String comparison is based on
   # 'cs_flag' for case sensitivity (1 is case insensitive,
   # 0 is case sensitive). Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_RECORD_CHANGED
   global DBENG_INVALID_FUNCTION DBENG_FM
   set mname "db_find_field_part"

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

   if {$cs_flag != 1 && $cs_flag != 0} {
      db_io_code_log $mname "exit:must be 0|1(cs_flag)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

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

   if {$field_num <= 0} {
      db_io_code_log $mname "out of range(field_num)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   logman "$mname:enter:tid=$tid,cs=$cs_flag,fs=$find_str,\
           l=[string length $find_str],fn=$field_num"

   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
   }

   # get a record if none is present (do not count unsaved rec
   # in memory if one is present)
   if {$dbeng_table($tid,record_number) == 0} {
      logman "$mname:no current record,getting first"
      db_top $tid
      set ret [db_next $tid]

      if {$ret != $DBENG_OK} {
         db_io_code_log $mname "exit:bad ret from first(db_next)" $ret
         return $ret
      }
   }

   set done 0
   set dbeng_table($tid,change_rec_flag) 0
   set fm [format "%c" $DBENG_FM]

   while {!$done} {
      set process 1
      set nwords [ll_words $dbeng_table($tid,rec) $fm]

      if {$field_num > $nwords} {
         set process 0
      }

      if {$process} {
         set ret [db_get_field $tid $field_num field_data]

         if {$ret != $DBENG_OK} {
            db_io_code_log $mname "bad ret(get_field)" $ret
            return $ret
         }

         if {[string length $field_data] < [string length $find_str]} {
            set process 0
         }
      }

      if {$process} {
         if {$cs_flag} {
            set tmp_data [string toupper $field_data]
            set tmp_str [string toupper $find_str]
         } else {
            set tmp_data $field_data
            set tmp_str $find_str
         }

         if {[string first $tmp_str $tmp_data] != -1} {
            db_io_code_log $mname "match found,normal exit" $DBENG_OK
            return $DBENG_OK
         }
      }

      set ret [db_next $tid]

      if {$ret != $DBENG_OK} {
         set done 1
      }
   }

   db_io_code_log $mname "no match,normal exit" $ret
   return $ret
}

proc db_new_table {fname tid} {
   # Create a new table. If 'tid' is a positive
   # number, also open the table. Returns
   # 'DBENG_OK' upon success with the table
   # 'tid' loaded if open was requested.
   # Returns a 'dbeng' code.
   global DBENG_OK DBENG_INVALID_FILE_NAME DBENG_INVALID_FUNCTION
   upvar $tid utid
   set mname "db_new_table"
   
   if {$fname == ""} {
      db_io_code_log $mname "exit:empty(fname)" $DBENG_INVALID_FILE_NAME
      return $DBENG_INVALID_FILE_NAME
   }

   logman "$mname:enter:fname=$fname"
   set ttid $utid
   set ret [dbeng_ll_new_table $fname ttid 0]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "exit:bad rc from dbeng_ll_new_table" $ret
      set utid 0
      return $ret
   }

   set utid $ttid
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc db_delete_table {fname} {
   # Delete a 'dbeng' (Bbuuzzb) table by name. The catalog will be
   # used to obtain the physical file name if the catalog
   # flag is high. Both catalog and physical file will be
   # deleted. The table must not be in current use by any
   # other 'tid'. The table is assumed to be closed.
   # Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_INVALID_FUNCTION DBENG_TABLE_IN_USE
   set mname "db_delete_table"
   
   logman "$mname:enter"

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

   # verify table (and possibly catalog entry) by attempting
   # to open the table
   set ret [db_open $fname tid]

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

   # save physical file name
   set pname $dbeng_table($tid,name)

   # close the table
   set ret [db_close $tid]

   if {$ret != $DBENG_OK} {
      # do not return upon close error
      db_io_code_log $mname "bad rc from db_close" $ret
   }

   # make sure table is not in use by other tid's
   if {[dbeng_table_in_use $pname]} {
      db_io_code_log $mname "exit:unable to delete table" $DBENG_TABLE_IN_USE
      return $DBENG_TABLE_IN_USE
   }
   
   file delete $pname

   # if catalog flag is high, attempt to obtain and delete the
   # catalog entry (might fail if the physical file name was
   # supplied)
   db_config_get_catalog_flag catalog_flag

   if {$catalog_flag} {
      set ret [dbeng_catalog_delete $fname]

      if {$ret != $DBENG_OK} {
         # if catalog delete failed, do not return
         db_io_code_log $mname "bad rc from dbeng_catalog_delete" $ret
      }
   }

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

proc db_get_open_table_list {pat list_out} {
   # Get and return a list of all tables in use. The list
   # is returned in 'list_out' upon success. The parameter
   # 'pat' may contain an acceptable pattern to the tcl
   # 'string match' command. The returned list is delimited
   # by 'DBENG_LIST_DELIM'. Each entry in the list contains
   # the tid in use followed by the file path/name. The two
   # fields in the list are delimited by a comma. If 'pat'
   # is empty, all tables in use will be returned. Returns
   # a 'dbeng' code.
   global dbeng_table DBENG_OK
   global DBENG_LIST_DELIM DBENG_INTERNAL_ERROR
   upvar $list_out ulist_out
   set mname "db_get_open_table_list"

   logman "$mname:enter"

   if {$pat == ""} {
      set is_pat 0
   } else {
      set is_pat 1
   }

   if {$is_pat} {
      logman "$mname:pat=$pat"
   }
   
   set ulist_out ""
   set before ""
   set after ""
   set cnt 1

   # it is not an error if no tables in use (list is empty)
   if {![array exists dbeng_table]} {
      logman "$mname:exit(0):array empty"
      return $DBENG_OK
   }

   # get the number of the last tid in use
   set lastid [expr [dbeng_get_tid] - 1]
   logman "$mname:last tid in use is $lastid"

   # loop through the array
   for {set i 1} {$i <= $lastid} {incr i} {
      # use catch to trap any gaps
      if {![catch {set ret $dbeng_table($i,name)}]} {
         set process 1

	 if {$is_pat} {
	    if {![string match $pat $ret]} {
	       set process 0
	       logman "$mname:$ret is no match"
	    } else {
	       logman "$mname:$ret is a match"
	    }
	 }

	 if {$process} {
	    set wdata "$i,$dbeng_table($i,name)"

	    if {![ll_wordput $before after $wdata $cnt $DBENG_LIST_DELIM]} {
	       db_io_code_log $mname "error putting list item" \
	                      $DBENG_INTERNAL_ERROR
               return $DBENG_INTERNAL_ERROR
	    }

	    incr cnt
	    set before $after
	 }
      }
   }

   set ulist_out $after
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}   

proc db_exist {tname exist_flag} {
   # Determine whether a database table exists. Naming convention
   # is the same as for 'db_open'. The flag 'exist_flag' will be
   # loaded with the exist flag (1=table exists) upon success.
   # Returns a 'dbeng' code.
   global DBENG_OK DBENG_INVALID_FUNCTION
   upvar $exist_flag uexist_flag
   set mname "db_exist"

   logman "$mname:enter"
   set uexist_flag 0

   if {$tname == ""} {
      db_io_code_log $mname "empty(tname)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   set ret [db_open $tname tid]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "exit:table does not exist" $DBENG_OK
      return $DBENG_OK
   }

   db_close $tid
   set uexist_flag 1
   db_io_code_log $mname "exit:table does exist" $DBENG_OK
   return $DBENG_OK
}

proc db_clear_table {tname} {
   # Clear a table of all records by deleting the table and
   # re-creating it. The table must not already be in use.
   # Returns a 'dbeng' code.
   global dbeng_table MULTIUSER DBENG_OK DBENG_INVALID_FUNCTION
   global DBENG_TABLE_IN_USE
   set mname "db_clear_table"
   set systable_flag 0

   logman "$mname:enter"

   if {$tname == ""} {
      db_io_code_log $mname "empty(tname)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   # if {$MULTIUSER} {
   #    check for session table
   #    if {[db_config_is_session $tname]} {
   #       set systable_flag 1
   #    }
   # }

   # check for catalog
   if {!$systable_flag && [db_config_is_catalog $tname]} {
      set systable_flag 1
   }

   if {$systable_flag} {
      # if it is either the session table or the catalog,
      # the name is already the physical file name, just
      # copy it
      set fname $tname
   }

   # open the table to make sure we access it's physical file name
   if {!$systable_flag} {
      set ret [db_open $tname tid]

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

      set fname $dbeng_table($tid,name)
      db_close $tid
   }

   # if the table is in use by other tid's, refuse
   if {[dbeng_table_in_use $fname]} {
      db_io_code_log $mname "unable to clear table" $DBENG_TABLE_IN_USE
      return $DBENG_TABLE_IN_USE
   }
   
   file delete $fname

   if {![zcreate $fname]} {
      db_io_code_log $mname "error creating new empty table" \
                     $DBENG_INTERNAL_ERROR
      return $DBENG_INTERNAL_ERROR
   }
   
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc db_delete_field {tid fnum} {
   # Completly remove the 'fnum' field from the current record.
   # Note that all field numbers past the field being deleted
   # will change. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_INVALID_FUNCTION
   global DBENG_NO_SUCH_FIELD DBENG_INTERNAL_ERROR DBENG_FM DBENG_NO_RECORD
   set mname "db_delete_field"

   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 $fnum]} {
      db_io_code_log $mname "non-numeric(fnum)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$fnum <= 0} {
      db_io_code_log $mname "out of range(fnum)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {[dbeng_is_active_rec $tid] == $DBENG_NO_RECORD} {
      db_io_code_log $mname "no current rec" $DBENG_NO_RECORD
      return $DBENG_NO_RECORD
   }

   set fm [format "%c" $DBENG_FM]
   set num_fields [ll_words $dbeng_table($tid,rec) $fm]

   if {$fnum > $num_fields} {
      db_io_code_log $mname "not exist(fnum field)" $DBENG_NO_SUCH_FIELD
      return $DBENG_NO_SUCH_FIELD
   }

   if {![ll_worddel $dbeng_table($tid,rec) new_rec $fnum $fm]} {
      db_io_code_log $mname "bad rc(0) from ll_worddel" $DBENG_INTERNAL_ERROR
      return $DBENG_INTERNAL_ERROR
   }

   set dbeng_table($tid,rec) $new_rec
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc db_delete_subfield {tid fnum sfnum} {
   # Completly remove a subfield from the current record.
   # Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_INVALID_FUNCTION
   global DBENG_NO_SUCH_FIELD DBENG_INTERNAL_ERROR DBENG_FM DBENG_NO_RECORD
   global DBENG_SFM DBENG_NO_SUCH_SUBFIELD
   set mname "db_delete_subfield"

   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 $fnum]} {
      db_io_code_log $mname "non-numeric(fnum)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$fnum <= 0} {
      db_io_code_log $mname "out of range(fnum)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

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

   if {$sfnum <= 0} {
      db_io_code_log $mname "out of range(sfnum)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {[dbeng_is_active_rec $tid] == $DBENG_NO_RECORD} {
      db_io_code_log $mname "no current rec" $DBENG_NO_RECORD
      return $DBENG_NO_RECORD
   }

   set fm [format "%c" $DBENG_FM]
   set num_fields [ll_words $dbeng_table($tid,rec) $fm]

   if {$fnum > $num_fields} {
      db_io_code_log $mname "not exist(fnum field)" $DBENG_NO_SUCH_FIELD
      return $DBENG_NO_SUCH_FIELD
   }

   if {![ll_word $dbeng_table($tid,rec) tfield $fnum $fm]} {
      db_io_code_log $mname "bad rc(0) from ll_word" $DBENG_INTERNAL_ERROR
      return $DBENG_INTERNAL_ERROR
   }

   set sfm [format "%c" $DBENG_SFM]
   set num_subfields [ll_words $tfield $sfm]
   
   if {$sfnum > $num_subfields} {
      db_io_code_log $mname "not exist(sfnum subfield)" $DBENG_NO_SUCH_SUBFIELD
      return $DBENG_NO_SUCH_SUBFIELD
   }

   if {![ll_worddel $tfield nfield $sfnum $sfm]} {
      db_io_code_log $mname "bad rc(0) from ll_worddel" $DBENG_INTERNAL_ERROR
      return $DBENG_INTERNAL_ERROR
   }

   # put new field back into record
   set ret [db_put_field $tid $fnum $nfield]

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

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

proc db_delete_subsubfield {tid fnum sfnum ssfnum} {
   # Completly remove a subsubfield from the current record.
   # Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_INVALID_FUNCTION
   global DBENG_NO_SUCH_FIELD DBENG_INTERNAL_ERROR DBENG_FM DBENG_NO_RECORD
   global DBENG_SFM DBENG_NO_SUCH_SUBFIELD DBENG_SSFM DBENG_NO_SUCH_SUBSUBFIELD
   set mname "db_delete_subsubfield"

   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 $fnum]} {
      db_io_code_log $mname "non-numeric(fnum)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$fnum <= 0} {
      db_io_code_log $mname "out of range(fnum)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

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

   if {$sfnum <= 0} {
      db_io_code_log $mname "out of range(sfnum)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

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

   if {$ssfnum <= 0} {
      db_io_code_log $mname "out of range(ssfnum)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {[dbeng_is_active_rec $tid] == $DBENG_NO_RECORD} {
      db_io_code_log $mname "no current rec" $DBENG_NO_RECORD
      return $DBENG_NO_RECORD
   }

   set fm [format "%c" $DBENG_FM]
   set num_fields [ll_words $dbeng_table($tid,rec) $fm]

   if {$fnum > $num_fields} {
      db_io_code_log $mname "not exist(fnum field)" $DBENG_NO_SUCH_FIELD
      return $DBENG_NO_SUCH_FIELD
   }

   set ret [db_get_nsubfields $tid $fnum num_subfields]

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

   if {$sfnum > $num_subfields} {
      db_io_code_log $mname "not exist(sfnum subfield" $DBENG_NO_SUCH_SUBFIELD
      return $DBENG_NO_SUCH_SUBFIELD
   }

   # obtain the subfield where the subsubfield is contained
   set ret [db_get_subfield $tid $fnum $sfnum tsubfield]

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

   set ssfm [format "%c" $DBENG_SSFM]
   set num_subsubfields [ll_words $tsubfield $ssfm]

   if {$ssfnum > $num_subsubfields} {
      db_io_code_log $mname "not exist(ssfnum subsubfield)" \
                     $DBENG_NO_SUCH_SUBSUBFIELD
      return $DBENG_NO_SUCH_SUBSUBFIELD
   }

   if {![ll_worddel $tsubfield nsubfield $ssfnum $ssfm]} {
      db_io_code_log $mname "bad rc(0) from ll_worddel" $DBENG_INTERNAL_ERROR
      return $DBENG_INTERNAL_ERROR
   }

   # put new subfield back into record
   set ret [db_put_subfield $tid $fnum $sfnum $nsubfield]

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

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

proc dbeng_is_systable {tid flag} {
   # Obtain the current 'is_systable' value. Returns the value
   # of the flag in 'flag' upon success. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID
   upvar $flag uflag
   set mname "dbeng_is_systable"

   logman "$mname:enter"
   set uflag 0

   if {![dbeng_atid_lookup $tid]} {
      db_io_code_log $mname "exit:bad tid" $DBENG_NO_SUCH_TID
      return $DBENG_NO_SUCH_TID
   }
  
   set uflag $dbeng_table($tid,is_systable)
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc dbeng_tmp_systable {tid} {
   # Create a new system table with a unique file name.
   # Exits with the table open and the table tid placed
   # into 'tid'. Returns a 'dbeng' code.
   global DBENG_OK DBENG_INTERNAL_ERROR DBENG_CANNOT_CREATE_TABLE
   upvar $tid utid
   set mname "dbeng_tmp_systable"

   logman "$mname:enter"

   # get temporary path from config data
   set ret [db_config_get_tmp_path tmp_path]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "error getting tmp path" $DBENG_INTERNAL_ERROR
      return $DBENG_INTERNAL_ERROR
   }

   # generate a unique file name
   if {![unique $tmp_path rname]} {
      logman "$mname:cannot create tmp table($tmp_path/$rname)"
      return $DBENG_CANNOT_CREATE_TABLE
   }

   # build complete path and file name
   set table_name "$tmp_path/$rname"
   logman "$mname:tmp table is $table_name"

   # indicate to also open the table in 'dbeng_new_systable'
   set ttid 1

   # create new empty temporary system table
   set ret [dbeng_new_systable $table_name ttid]

   if {$ret != $DBENG_OK} {
      logman "$mname:new table($table_name) create error"
      return $ret
   }

   set utid $ttid
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc dbeng_new_systable {fname tid} {
   # Create a new system table. If the 'tid' is a positive
   # integer, also open the table. Returns the table 'tid'
   # upon success (if table open was requested). Returns
   # a 'dbeng' code.
   global DBENG_OK DBENG_INVALID_FILE_NAME
   upvar $tid utid
   set mname "dbeng_new_systable"

   if {$fname == ""} {
      db_io_code_log $mname "exit:empty(fname)" $DBENG_INVALID_FILE_NAME
      return $DBENG_INVALID_FILE_NAME
   }

   logman "$mname:enter:fname=$fname"
   set ttid $utid
   set ret [dbeng_ll_new_table $fname ttid 1]

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

   set utid $ttid
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc dbeng_put_which_field {tid field_num new_fnum} {
   # Determine which field to put data into. A positive integer
   # is assumed to indicate the absolute field number. A zero
   # indicates to append a new field to the record. Returns
   # the field number loaded into 'new_fnum' upon success.
   # Returns a 'dbeng' code.
   global DBENG_OK DBENG_NO_SUCH_TID DBENG_INVALID_FUNCTION DBENG_NO_RECORD
   upvar $new_fnum unew_fnum
   set mname "dbeng_put_which_field"

   logman "$mname:enter:fnum=$field_num"
   set unew_fnum 0

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

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

   if {$field_num < 0} {
      db_io_code_log $mname "out of range(field_num)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {$field_num > 0} {
      logman "$mname:normal exit:new_fnum=$field_num"
      set unew_fnum $field_num   
      return $DBENG_OK
   }

   set ret [db_get_nfields $tid nfields]

   if {$ret != $DBENG_OK} {
      if {$ret == $DBENG_NO_RECORD} {
         set nfields 0
      } else {
         db_io_code_log $mname "bad rc from db_get_nfields" $ret
         return $ret
      }
   }

   logman [format "%s:normal exit:new_fnum=%d" $mname [expr $nfields + 1]]
   set unew_fnum [expr $nfields + 1]
   return $DBENG_OK
}

proc dbeng_put_which_subfield {tid fnum sfnum new_fnum new_sfnum} {
   # Determine which field and subfield to put data into. A postitive
   # integer is assumed to be the absolute field/subfield number. A zero
   # indicates to append a new field/subfield to the record. Returns
   # the field number loaded into 'new_fnum' and the new subfield
   # number loaded into 'new_sfnum' upon success. Returns a 'dbeng' code.
   global DBENG_OK DBENG_NO_SUCH_TID DBENG_INVALID_FUNCTION DBENG_NO_RECORD
   global DBENG_NO_SUCH_FIELD
   upvar $new_fnum unew_fnum
   upvar $new_sfnum unew_sfnum
   set mname "dbeng_put_which_subfield"

   logman "$mname:enter:fnum=$fnum,sfnum=$sfnum"
   set unew_fnum 0
   set unew_sfnum 0

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

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

   if {$sfnum < 0} {
      db_io_code_log $mname "out of range(sfnum)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   set ret [dbeng_put_which_field $tid $fnum tmp_fnum]
   set unew_fnum $tmp_fnum

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

   # if the field number was zero, set subfield number and exit
   if {!$fnum} {
      if {!$sfnum} {
         set unew_sfnum 1
      } else {
         set unew_sfnum $sfnum
      }

      logman "$mname:exit(0):new_fnum=$unew_fnum,new_sfnum=$unew_sfnum"
      return $DBENG_OK
   }
   
   # if the field number was not zero and subfield was not zero,
   # set subfield and exit
   if {$sfnum} {
      set unew_sfnum $sfnum
      logman "$mname:exit(0):new_fnum=$unew_fnum,new_sfnum=$unew_sfnum"
      return $DBENG_OK
   }

   # field number was not zero and subfield was zero
   set ret [db_get_nsubfields $tid $tmp_fnum nsubfields]

   switch $ret \
      $DBENG_OK {set unew_sfnum [expr $nsubfields + 1]} \
      $DBENG_NO_SUCH_FIELD - \
      $DBENG_NO_RECORD {set unew_sfnum 1;set ret $DBENG_OK} \
      default {db_io_code_log $mname "bad rc from db_get_nsubfields" $ret; \
               set unew_fnum 0;set unew_sfnum 0}

   logman "$mname:exit(0):new_fnum=$unew_fnum,new_sfnum=$unew_sfnum"
   return $ret
}

proc dbeng_put_which_subsubfield {tid fnum sfnum ssfnum new_fnum new_sfnum \
                                  new_ssfnum} {
   # Determine which field, subfield and subsubfield to put data into. 
   # A postitive integer is assumed to be the absolute 
   # field/subfield/subsubfield number. A zero indicates to append a new 
   # field/subfield/subsubfield to the record. Returns
   # the field number loaded into 'new_fnum', the new subfield
   # number loaded into 'new_sfnum' and the new subsubfield number
   # loaded into 'new_ssfnum' upon success. Returns a 'dbeng' code.
   global DBENG_OK DBENG_NO_SUCH_TID DBENG_INVALID_FUNCTION DBENG_NO_RECORD
   global DBENG_NO_SUCH_FIELD DBENG_NO_SUCH_SUBFIELD
   upvar $new_fnum unew_fnum
   upvar $new_sfnum unew_sfnum
   upvar $new_ssfnum unew_ssfnum
   set mname "dbeng_put_which_subsubfield"

   logman "$mname:enter:fnum=$fnum,sfnum=$sfnum,ssfnum=$ssfnum"
   set unew_fnum 0
   set unew_sfnum 0
   set unew_ssfnum 0

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

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

   if {$ssfnum < 0} {
      db_io_code_log $mname "out of range(ssfnum)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   set ret [dbeng_put_which_subfield $tid $fnum $sfnum new_fnum new_sfnum]
   set unew_fnum $new_fnum
   set unew_sfnum $new_sfnum

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

   # subsubfield number was not zero
   if {$ssfnum} {
      set unew_ssfnum $ssfnum
      logman "$mname:exit(0):new_fnum=$unew_fnum,new_sfnum=$unew_sfnum,\
              new_ssfnum=$unew_ssfnum"
      return $DBENG_OK
   }
   
   # subsubfield number zero
   set ret [db_get_nsubsubfields $tid $new_fnum $new_sfnum nsubsubfields]

   switch $ret \
      $DBENG_OK {set unew_ssfnum [expr $nsubsubfields + 1]} \
      $DBENG_NO_SUCH_SUBFIELD - \
      $DBENG_NO_SUCH_FIELD - \
      $DBENG_NO_RECORD {set unew_ssfnum 1;set ret $DBENG_OK} \
      default {db_io_code_log $mname "bad rc from db_get_nsubsubfields" $ret; \
               set unew_fnum 0;set unew_sfnum 0;set unew_ssfnum 0}

   logman "$mname:exit(0):new_fnum=$unew_fnum,new_sfnum=$unew_sfnum,\
           new_ssfnum=$unew_ssfnum"
   return $ret
}

proc dbeng_ll_copy_table {src dest} {
   # Copy a table from source ('src' tid) to destination ('dest' tid).
   # Both tables are assumed to be open. No regard is given to
   # the existing contents of the destination table. Records are
   # copied in accordance with the current value of the source
   # table 'process_deleted' flag. Procedure exits with the tables
   # remaining open. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_EOF
   set mname "dbeng_ll_copy_table"

   logman "$mname:enter"

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

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

   logman [format "%s:src:tid=%d,name=%s:dest:tid=%d,name=%s" $mname \
           $src $dbeng_table($src,name) $dest $dbeng_table($dest,name)]

   # goto top of source table
   set ret [db_top $src]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "exit:error going to top(src)" $ret
      return $ret
   }

   set done 0

   # get first source record
   set ret [db_next $src]

   if {$ret != $DBENG_OK} {
      if {$ret == $DBENG_EOF} {
         set done 1
         db_io_code_log $mname "source table empty" $ret
      } else {
         db_io_code_log $mname "error getting first source rec" $ret
         return $ret
      }
   }

   # read/write loop
   while {!$done} {
      # write record
      set ret [dbeng_write_string_recd $dest $dbeng_table($src,rec)]

      if {$ret != $DBENG_OK} {
         db_io_code_log $mname "error writing record" $ret
         return $ret
      }

      # get next source record
      set ret [db_next $src]

      switch $ret \
         $DBENG_EOF {set done 1} \
         $DBENG_OK {set done 0} \
         default {dbeng_io_code_log $mname "error getting record" $ret; \
                  return $ret}
   }

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

proc dbeng_open_systable {fname tid} {
   # Open a system table. At the moment, a system table is one of:
   #
   #   - temporary table
   #   - session table
   #   - catalog
   #
   # This procedure behaves just like 'db_open' except that the
   # physical file is always left open. Returns a 'dbeng' code.
   global DBENG_INVALID_FILE_NAME DBENG_OK
   upvar $tid utid
   set mname "dbeng_open_systable"

   if {$fname == ""} {
      db_io_code_log $mname "exit:empty(fname)" $DBENG_INVALID_FILE_NAME
      return $DBENG_INVALID_FILE_NAME
   }

   logman "$mname:enter:fname=$fname"
   set ttid 0

   # open the table using 'dbeng_ll_open_table'
   set ret [dbeng_ll_open_table $fname ttid 1]

   if {$ret != $DBENG_OK} {
      db_io_code_log $mname "bad rc from dbeng_ll_open_table" $ret
      set utid 0
      return $ret
   }

   set utid $ttid
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc dbeng_ll_open_table {fname tid systable_flag} {
   # Open a table. Table ID is returned in 'tid' upon success.
   # If the system catalog flag is on, only logical table names 
   # listed in the system catalog will succeed unless the name 
   # is prefixed with the 'DBENG_CATALOG_FNAME_IND' character. 
   # Returns 'DBENG_OK' upon success, error code otherwise.
   # Note that if the code returned is 'DBENG_FILE_DATA_ERROR',
   # the 'tid' is still loaded and the file is left open.
   global dbeng_table DBENG_OK DBENG_INVALID_FILE_NAME DBENG_INVALID_FUNCTION
   global DBENGSRT_MAX_SORT_ALLOC DBENGSRT_MAX_OPEN_BIN
   global dbengcat_details DBENG_SYSTABLE_MAX_DELETED dbeng_table_count
   upvar $tid lk
   set lk 0
   set mname "dbeng_ll_open_table"

   logman "$mname:enter"

   if {$fname == ""} {
      db_io_code_log $mname "fname parameter error" $DBENG_INVALID_FILE_NAME
      return $DBENG_INVALID_FILE_NAME
   }

   if {$systable_flag != 1 && $systable_flag != 0} {
      db_io_code_log $mname "bad flag(systable_flag)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   set ret [dbeng_catalog_table_details $fname $systable_flag]

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

   set ttid [dbeng_get_tid]
   set dbeng_table($ttid,handle) 0
   set dbeng_table($ttid,name) $dbengcat_details(physical_name)
   set dbeng_table($ttid,rec) ""
   set dbeng_table($ttid,change_rec_flag) 0
   set dbeng_table($ttid,enforce_change_rec_flag) 0
   set dbeng_table($ttid,record_number) 0
   set dbeng_table($ttid,orig_position) -1
   set dbeng_table($ttid,current_position) 0
   set dbeng_table($ttid,process_deleted) 0
   set dbeng_table($ttid,is_table_locked) 0
   set dbeng_table($ttid,is_systable) $systable_flag
   set dbeng_table($ttid,sort_max_open_bin) $DBENGSRT_MAX_OPEN_BIN
   set dbeng_table($ttid,sort_max_mem) $DBENGSRT_MAX_SORT_ALLOC
   set dbeng_table($ttid,active_record_count) 0
   set dbeng_table($ttid,deleted_record_count) 0
   set dbeng_table($ttid,record_status) 0

   if {$systable_flag} {
      set dbeng_table($ttid,autopack) $DBENG_SYSTABLE_MAX_DELETED
   } else {
      set dbeng_table($ttid,autopack) $dbengcat_details(apack)
   }

   set ret [dbeng_ll_open $ttid]

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

   set ret [db_count $ttid active deleted]

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

   set dbeng_table($ttid,active_record_count) $active
   set dbeng_table($ttid,deleted_record_count) $deleted
   db_top $ttid
   incr dbeng_table_count
   set lk $ttid
   logman "$mname:normal exit(0)"
   return $DBENG_OK
}

proc dbeng_record_header {tid len status} {
   # Read and verify the record header which is assumed to start
   # at the current file position. Upon success, the record
   # length is returned in 'len' and the record status is
   # returned in 'status'. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_REC_HEAD_SIZE
   global DBENG_FM DBENG_EOF DBENG_FILE_DATA_ERROR
   upvar $len ulen
   upvar $status ustatus
   set ulen 0
   set ustatus 0
   set mname "dbeng_record_header"

   #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 rec_head [read $dbeng_table($tid,handle) $DBENG_REC_HEAD_SIZE]
   set fm [format "%c" $DBENG_FM]

   if {[string length $rec_head] < $DBENG_REC_HEAD_SIZE} {
      logman "$mname:exit:eof detected,tid=$tid"
      return $DBENG_EOF
   }

   # error if field mark not present
   if {[string index $rec_head end] != $fm} {
      logman [format "%s:no field mark at end of header:tid=%d,rh=%s,l=%d,\
              rc=%d" $mname $tid rec_head [string length $rec_head] \
              $DBENG_FILE_DATA_ERROR]
      return $DBENG_FILE_DATA_ERROR
   }

   # extract record length (bytes 1 to second last)
   set hlen [int_remove_lz [string range $rec_head 1 end-1]]

   if {![num $hlen]} {
      db_io_code_log $mname "error:header length is non-numeric" \
                     $DBENG_FILE_DATA_ERROR
      return $DBENG_FILE_DATA_ERROR
   }

   set ulen $hlen
   set ustatus [string index $rec_head 0]
   #db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc dbeng_write_new_recd {tid} {
   # Write a new record. Returns a 'dbeng' code. No regard is given to
   # an already existing record.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_NO_RECORD
   global DBENG_TABLE_LOCKED DBENG_FM DBENG_RM
   set mname "dbeng_write_new_recd"

   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 {[dbeng_is_active_rec $tid] == $DBENG_NO_RECORD} {
      db_io_code_log $mname "no current rec" $DBENG_NO_RECORD
      return $DBENG_NO_RECORD
   }

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

   # goto end of table
   seek $dbeng_table($tid,handle) 0 end

   # save channel position
   set dbeng_table($tid,orig_position) [tell $dbeng_table($tid,handle)]
   set len [string length $dbeng_table($tid,rec)]
   puts -nonewline $dbeng_table($tid,handle) [format "A%010d%c%s%c" [expr \
        $len + 1] $DBENG_FM $dbeng_table($tid,rec) $DBENG_RM]
   incr dbeng_table($tid,record_number)
   incr dbeng_table($tid,active_record_count)
   set dbeng_table($tid,change_rec_flag) 0

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

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

   # since file position is at end of file, goto top
   db_top $tid
   logman "$mname:normal exit"
   return $DBENG_OK
}
  
proc dbeng_write_string_recd {tid rec} {
   # Write a new record from the contents of 'rec'. Unlike
   # 'dbeng_write_new_recd', this procedure does not
   # force the record pointer to the top of the table
   # Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_INVALID_FUNCTION
   global DBENG_FM DBENG_RM
   set mname "dbeng_write_string_recd"

   # 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 {$rec == ""} {
      db_io_code_log $mname "exit:empty(rec)" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   # goto end of table
   seek $dbeng_table($tid,handle) 0 end

   # save channel position
   set dbeng_table($tid,orig_position) [tell $dbeng_table($tid,handle)]
   set len [string length $rec)]
   puts -nonewline $dbeng_table($tid,handle) [format "A%010d%c%s%c" $len \
        $DBENG_FM $rec $DBENG_RM]
   incr dbeng_table($tid,active_record_count)
   set dbeng_table($tid,change_rec_flag) 0
   set dbeng_table($tid,current_position) [tell $dbeng_table($tid,handle)]

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

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

   # logman "$mname:normal exit"
   return $DBENG_OK
}

proc dbeng_rewrite_recd {tid} {
   # Rewrite an existing record. The old record will be marked for
   # deletion and a new reocrd will be written. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_NO_EXISTING_RECORD
   global DBENG_TABLE_LOCKED
   set mname "dbeng_rewrite_recd"

   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
   }

   # make sure there is an already existing record
   if {$dbeng_table($tid,orig_position) == -1 || \
       $dbeng_table($tid,record_number) == 0} {
      db_io_code_log $mname "no current record" $DBENG_NO_EXISTING_RECORD
      return $DBENG_NO_EXISTING_RECORD
   }

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

   # save current record values (as 'tmp') as they are destroyed by the delete
   # record procedure
   set dbeng_table(tmp,name) "tmp"
   set dbeng_table(tmp,rec) $dbeng_table($tid,rec)
   set dbeng_table(tmp,record_number) $dbeng_table($tid,record_number)
   set dbeng_table(tmp,orig_position) $dbeng_table($tid,orig_position)
   set dbeng_table(tmp,current_position) $dbeng_table($tid,current_position)

   # force 'enforce_change_rec_flag' down as the delete proc checks this
   set dbeng_table(tmp,enforce_change_rec_flag) \
       $dbeng_table($tid,enforce_change_rec_flag)
   set dbeng_table($tid,enforce_change_rec_flag) 0
   set ret [db_delete $tid]

   if {$ret != $DBENG_OK} {
      db_io_code_string $mname "bad ret(db_delete)" $ret
      set dbeng_table($tid,enforce_change_rec_flag) \
          $dbeng_table(tmp,enforce_change_rec_flag)
      dbeng_unset_table tmp
      return $ret
   }

   # reload record values
   set dbeng_table($tid,rec) $dbeng_table(tmp,rec)
   set dbeng_table($tid,record_number) $dbeng_table(tmp,record_number)
   set dbeng_table($tid,orig_position) $dbeng_table(tmp,orig_position)
   set dbeng_table($tid,current_position) $dbeng_table(tmp,current_position)
   set ret [dbeng_write_new_recd $tid]
   set dbeng_table($tid,enforce_change_rec_flag) \
       $dbeng_table(tmp,enforce_change_rec_flag)
   dbeng_unset_table tmp
   db_io_code_log $mname "normal exit" $ret
   return $ret
}

proc dbeng_is_active_rec {tid} {
   # Check for active table record. Returns 'DBENG_NO_RECORD' if no
   # active table record is present, 'DBENG_OK' otherwise.
   global dbeng_table DBENG_OK DBENG_NO_RECORD

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

   if {$dbeng_table($tid,rec) == ""} {
      return $DBENG_NO_RECORD
   }

   return $DBENG_OK
}

proc dbeng_get_tid {} {
   # Obtain the next table ID. The next tid is based on the
   # number of tables currently in use.
   global dbeng_table_count
   set mname "dbeng_get_tid"
   set tid $dbeng_table_count
   set done 0

   # logman "$mname:enter"

   while {!$done} {
      incr tid

      # check the tid against all current tables
      if {![dbeng_atid_lookup $tid]} {
         set done 1
      }
   }

   # logman "$mname:exit:tid=$tid"
   return $tid
}

proc dbeng_set_record_count {tid} {
   # Check all tables in use and adjust the active and deleted
   # record count to the current table counts on any 'tid' that
   # resolves to the same table. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK
   set mname "dbeng_set_record_count"

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

   if {![array exists dbeng_table]} {
      logman "$mname:exit(0):array empty"
      return $DBENG_OK
   }

   # get the number of the last tid in use
   set lastid [expr [dbeng_get_tid] - 1]
   # logman "$mname:last tid in use is $lastid"

   # if table count is one, there is only one table in use
   if {$lastid == 1} {
      db_io_code_log $mname "exit:only one table in use" $DBENG_OK
      return $DBENG_OK
   }

   # loop through the array, excluding the current tid
   for {set i 1} {$i <= $lastid} {incr i} {
      if {$i != $tid} {
         # use catch to trap any gaps
         if {![catch {set ret $dbeng_table($i,name)}]} {
            if {$dbeng_table($tid,name) == $ret} {
               set dbeng_table($i,active_record_count) \
                   $dbeng_table($tid,active_record_count)
               set dbeng_table($i,deleted_record_count) \
                   $dbeng_table($tid,deleted_record_count)
            }
         } else {
            logman "$mname:no table in use for tid $i"
         }
      }
   }

   # logman "$mname:normal exit"
   return $DBENG_OK
}

proc dbeng_lock_table {tid} {
   # Lock a table. This procedure should only be called by the
   # procedure 'db_set_is_table_locked'. This procedure does
   # not check the status of the flag first. Every table with
   # the exact file name will be locked. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK
   set mname "dbeng_lock_table"

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

   if {![array exists dbeng_table]} {
      logman "$mname:exit(0):array empty"
      return $DBENG_OK
   }

   # get the number of the last tid in use
   set lastid [expr [dbeng_get_tid] - 1]
   logman "$mname:last tid in use is $lastid"

   # loop through the array
   for {set i 1} {$i <= $lastid} {incr i} {
      # use catch to trap any gaps
      if {![catch {set ret $dbeng_table($i,name)}]} {
         if {$dbeng_table($tid,name) == $ret} {
            set dbeng_table($i,is_table_locked) 1
         }
      } else {
         logman "$mname:no table in use for tid $i"
      }
   }

   logman "$mname:normal exit"
   return $DBENG_OK
}

proc dbeng_unlock_table {tid} {
   # Unlock a table. This procedure should only be called by the
   # procedure 'db_set_is_table_locked'. This procedure does
   # not check the status of the flag first. Every table with
   # the exact file name will be unlocked. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK
   set mname "dbeng_unlock_table"

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

   if {![array exists dbeng_table]} {
      logman "$mname:exit(0):array empty"
      return $DBENG_OK
   }

   # get the number of the last tid in use
   set lastid [expr [dbeng_get_tid] - 1]
   logman "$mname:last tid in use is $lastid"

   # loop through the array
   for {set i 1} {$i <= $lastid} {incr i} {
      # use catch to trap any gaps
      if {![catch {set ret $dbeng_table($i,name)}]} {
         if {$dbeng_table($tid,name) == $ret} {
            set dbeng_table($i,is_table_locked) 0
         }
      } else {
         logman "$mname:no table in use for tid $i"
      }
   }

   logman "$mname:normal exit"
   return $DBENG_OK
}

proc dbeng_table_in_use {fname} {
   # Determine whether a table is in use by its physical file name.
   # Returns 1 if the table is in use, 0 otherwise.
   global dbeng_table
   set mname "dbeng_table_in_use"

   logman "$mname:enter:fname=$fname"

   if {![array exists dbeng_table]} {
      logman "$mname:exit(0):array empty"
      return 0
   }

   # search for any array element containing the same file name
   set id [array startsearch dbeng_table]

   while {[array anymore dbeng_table $id]} {
      set element [array nextelement dbeng_table $id]

      if {$dbeng_table($element) == $fname} {
         array donesearch dbeng_table $id
         logman "$mname:exit(1):found entry"
         return 1
      }
   }

   # not found
   array donesearch dbeng_table $id
   logman "$mname:exit(0):not found"
   return 0
}

proc dbeng_atid_lookup {tid} {
   # Lookup a table in the 'dbeng_table' array by it's tid.
   # Returns 1 if the table is present, 0 otherwise.
   global dbeng_table
   set mname "dbeng_atid_lookup"

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

   if {$tid <= 0} {
      logman "$mname:exit(0):out of range(tid)"
      return 0
   }

   if {![array exists dbeng_table]} {
      logman "$mname:exit(0):array empty"
      return 0
   }

   # search for the name element with the same tid
   set targetid "$tid,name"
   set id [array startsearch dbeng_table]

   while {[array anymore dbeng_table $id]} {
      set element [array nextelement dbeng_table $id]

      if {$element == $targetid} {
         array donesearch dbeng_table $id
         #logman "$mname:exit(1):found entry"
         return 1
      }
   }

   # not found
   array donesearch dbeng_table $id
   #logman "$mname:exit(0):not found"
   return 0
}

proc dbeng_ll_new_table {table_name tid systable_flag} {
   # Create a new empty table. If 'tid' is a positive integer,
   # the table will be opened and the TID will be returned
   # in same. 'table_name' may be in two parts separated
   # by a comma which will indicate the logical table
   # name followed by the physical name, ie:
   #
   #    test.primary,/hd1/bbuuzzb/tables/test.buz
   #
   # Do not put spaces before or after the comma.
   # If the two part form is used, an entry in the system
   # catalog will be made (whether or not the catalog flag
   # is on). An entry with the same logical name must not
   # already exist. If the two part form is not used, a
   # physical file name is assumed (do not prefix
   # the physical file name with 'DBENG_CATALOG_FNAME_IND'
   # as in 'db_open'. Returns a 'dbeng' code.
   global DBENG_OK DBENG_INVALID_FUNCTION
   upvar $tid utid
   set mname "dbeng_ll_new_table"

   logman "$mname:enter"

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

   if {$utid == "" || ![num $utid]} {
      db_io_code_log $mname "exit:empty or non-numeric(tid)" \
                     $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   # derive proper name that will be given to 'new.table',
   # create the new empty file and catalog entry (if required)
   set ret [dbeng_catalog_new_table $table_name ntable $systable_flag]

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

   if {$utid > 0} {
      set ttid $utid
      set ret [dbeng_ll_open_table $ntable ttid $systable_flag]
      set utid $ttid
      db_io_code_log $mname "normal exit(with open)" $ret
      return $ret
   }

   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}
   
proc dbeng_ll_open {tid} {
   # Open the file associated with the table 'tid'.
   # File will only be open if the 'handle' is
   # zero. Returns 'DBENG_OK' upon success, an engine 
   # i/o code otherwise.
   global dbeng_table DBENG_INVALID_FUNCTION DBENG_UNABLE_TO_OPEN DBENG_OK
   global DBENG_NO_SUCH_TID
   set mname "dbeng_ll_open"

   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 {$dbeng_table($tid,handle) != 0} {
      db_io_code_log $mname "exit:file already open" $DBENG_INVALID_FUNCTION
      return $DBENG_INVALID_FUNCTION
   }

   if {[catch {open $dbeng_table($tid,name) r+} dbeng_table($tid,handle)]} {
      db_io_code_log $mname "exit:cannot open file" $DBENG_UNABLE_TO_OPEN
      logman "$mname:tcl error is:$dbeng_table($tid,handle)"
      return $DBENG_UNABLE_TO_OPEN
   }

   # configure channel to binary access only
   fconfigure $dbeng_table($tid,handle) -translation binary

   # reset file position
   if {$dbeng_table($tid,current_position) > 0} {
      seek $dbeng_table($tid,handle) $dbeng_table($tid,current_position)
   }

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

proc dbeng_ll_close {tid} {
   # Close the channel associated with the table 'tid' but don't
   # 'unset' the array elements. Returns a 'dbeng' code.
   global dbeng_table DBENG_OK DBENG_NO_SUCH_TID DBENG_NO_SUCH_FILE
   set mname "dbeng_ll_close"

   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 {$dbeng_table($tid,handle) == 0} {
      db_io_code_log $mname "exit:file not open" $DBENG_NO_SUCH_FILE
      return $DBENG_NO_SUCH_FILE
   }

   close $dbeng_table($tid,handle)
   set dbeng_table($tid,handle) 0
   db_io_code_log $mname "normal exit" $DBENG_OK
   return $DBENG_OK
}

proc dbeng_compare_field {field_data find_str cs_flag} {
   # Compare the field data to the find string according to the
   # case sensitivity flag (1=insensitive,0=sensitive). The
   # field data and/or the find string may be empty. Returns
   # the result of the comparison (0=equal).
   set len_fd [string length $field_data]
   set len_fs [string length $find_str]

   # if lengths are not the same, cannot possibly be the same
   if {$len_fd != $len_fs} {
      return -1
   }

   # if the field data is empty and the find string is empty
   if {!$len_fd && !$len_fs} {
      return 0
   }

   if {$cs_flag} {
      set result [string compare -nocase $field_data $find_str]
   } else {
      set result [string compare $field_data $find_str]
   }

   return $result
}

proc dbeng_unset_table {tid} {
   # Remove all 'dbeng_table' array elements for a single table
   # based on it's 'tid'.
   global dbeng_table
   set mname "dbeng_unset_table"

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

   if {![dbeng_atid_lookup $tid]} {
      logman [format "%s:exit:no such tid(%s)" $mname $tid]
      return
   }

   array unset dbeng_table $tid,handle
   array unset dbeng_table $tid,name
   array unset dbeng_table $tid,rec
   array unset dbeng_table $tid,change_rec_flag
   array unset dbeng_table $tid,enforce_change_rec_flag
   array unset dbeng_table $tid,record_number
   array unset dbeng_table $tid,orig_position
   array unset dbeng_table $tid,current_position
   array unset dbeng_table $tid,process_deleted
   array unset dbeng_table $tid,is_table_locked
   array unset dbeng_table $tid,is_systable
   array unset dbeng_table $tid,autopack
   array unset dbeng_table $tid,sort_max_open_bin
   array unset dbeng_table $tid,sort_max_mem
   array unset dbeng_table $tid,active_record_count
   array unset dbeng_table $tid,deleted_record_count
   array unset dbeng_table $tid,record_status
   logman "$mname:normal exit"
}
