Work at SourceForge, help us to make it a better place! We have an immediate need for a Support Technician in our San Francisco or Denver office.

Close

#3943 Output File Size is incorrect

obsolete: 8.5.1
open
Vince Darley
5
2008-03-04
2008-03-04
Anonymous
No

$tcl_platform =
byteOrder littleEndian
machine intel
os Windows NT
osVersion 5.1
platform windows
pointerSize 4
threaded 1
user jon.harrison
wordSize 4

$tcl_version =
8.5
$tcl_patchLevel =
8.5.1

$tk_version =
8.5
$tk_patchLevel =
8.5.1

An application running under wish85 malfunctions, where it works correctly under wish84 (8.4.18).

The application streams one binary file to another skipping sections of data in the source file.

In 8.4.18 the final while loop in the proc below terminates correctly giving a correctly sized output file. In 8.5.1 the output file size always appears the same as the input file size.

The files in use are large, in the test case little under 4GB reported as 4005888000 by [file size] in 8.4.18. Unfortunately I am using the freeware TclPro1.4 for debug and it will not run my app at all with wish85 as the interpreter so cannot readily diagnose futher.

proc {nvm::strip_nvm} {} {
variable nvm_file_name
variable nvm_file

variable ab_file_name
variable ab_file

variable nvm_stripped_name
variable stripped_file

variable nvm_ouput_dir

variable truncate_fs

if {[catch {open $nvm_file_name {RDONLY}} nvm_file]} {
trans "Error: $nvm_file\n" error
return -1
}

fconfigure $nvm_file -encoding binary -translation binary -buffering full -buffersize 1572864

trans "Info:: Opened source file $nvm_file_name for stripping\n" info

if {[catch {open $nvm_stripped_name {TRUNC CREAT WRONLY}} stripped_file]} {
trans "Error: $stripped_file\n" error
return -1
}

fconfigure $stripped_file -encoding binary -translation binary -buffering full -buffersize 100000000

trans "Info:: Opened $nvm_file_name for output\n" info

if {$::truncate_fs == 1} {
#
# Find any big blocks of Fs at the end of the file
#
trans "Info:: Truncating 0xFF dead space at the end of the NVM File\n" info
set output_position [expr {[file size $nvm_file_name] - 1}]
seek $nvm_file $output_position
set byte [bin2val [read $nvm_file 1]]

while {[expr {$byte == 0xFF}]} {
set output_position [expr $output_position - 1000000]
seek $nvm_file $output_position
set byte [bin2val [read $nvm_file 1]]
}

set output_position [expr {$output_position + 5000}]
seek $nvm_file $output_position
set byte [bin2val [read $nvm_file 1]]
while {[expr {$byte != 0xFF}]} {
set output_position [expr {$output_position + 5000}]
seek $nvm_file $output_position
set byte [bin2val [read $nvm_file 1]]
}

#
# Output position is more or less the right place
# we can the get the right place by subtracting
# the remainder left as a multiple of complete flight blocks
#
set flight_block_bytes_remaining [expr {$output_position % 1572864}]
set output_position [expr {$output_position - (1572864 - $flight_block_bytes_remaining)}]
set output_position [expr {$output_position - 786432}]
} else {
set output_position [file size $nvm_file_name]
}

seek $nvm_file 0
seek $stripped_file 0

set file_position 0
set current_ptr 0
while {[expr {$current_ptr < $output_position}]} {
seek $nvm_file 16 current
set buffer_data [read $nvm_file 1572848]
puts -nonewline $stripped_file $buffer_data
flush $stripped_file
set current_ptr [tell $nvm_file]
}

close $nvm_file
close $stripped_file
}

Discussion

  • Don Porter
    Don Porter
    2008-03-11

    Logged In: YES
    user_id=80530
    Originator: NO

    Release candidate for Tcl 8.5.2 is at

    ftp://ftp.tcl.tk/pub/tcl/tcl8_5/

    Can you check whether this bug is still in it?