## -----------------------------------------------------------------------
##   
##   Copyright 2011 H. Peter Anvin - All Rights Reserved
##
##   Permission is hereby granted, free of charge, to any person
##   obtaining a copy of this software and associated documentation
##   files (the "Software"), to deal in the Software without
##   restriction, including without limitation the rights to use,
##   copy, modify, merge, publish, distribute, sublicense, and/or
##   sell copies of the Software, and to permit persons to whom
##   the Software is furnished to do so, subject to the following
##   conditions:
##   
##   The above copyright notice and this permission notice shall
##   be included in all copies or substantial portions of the Software.
##   
##   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
##   EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
##   OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
##   NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
##   HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
##   WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
##   FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
##   OTHER DEALINGS IN THE SOFTWARE.
##
## -----------------------------------------------------------------------

# Virtual JTAG instance index
set fl_instance 0
# Current IR value
set fl_current_ir -1
# Known space in the write FIFO
set fl_free_space 0

# Device parameters which really should come from reading the CFI data
set fl_device_size 0x400000
proc fl_sector_size addr {
    expr ($addr < 65536) ? 8192 : 65536
}

proc select_ir new_ir {
    global fl_instance fl_current_ir
    if { $new_ir != $fl_current_ir } {
	device_virtual_ir_shift -instance_index $fl_instance \
	    -ir_value $new_ir -no_captured_ir_value
	set fl_current_ir $new_ir
    }
}

# Send a command (given as a 72-bit hex string)
proc fl_send cmd {
    global fl_instance fl_free_space

    while { $fl_free_space < 1 } {
	# Poll the free space register until nonzero
	select_ir 2
	scan [device_virtual_dr_shift -instance_index $fl_instance \
		  -length 8 -value_in_hex] "%x" fl_free_space
    }

    select_ir 3
    device_virtual_dr_shift -instance_index $fl_instance \
	-dr_value $cmd -length 72 -value_in_hex -no_captured_dr_value
    incr fl_free_space -1
}

# Receive a reply (returned as a 72-bit hex string)
proc fl_recv {} {
    global fl_instance

    set status 0

    select_ir 1
    while { ($status & 0x80) == 0 } {
	set v [device_virtual_dr_shift -instance_index $fl_instance \
		   -length 72 -value_in_hex]
	scan $v "%2x" status
    }
    return $v
}

# Receive bulk data (returned as a binary string)
proc fl_recv_bulk bytes {
    global fl_instance

    select_ir 1

    set qwords [expr ($bytes + 7) >> 3]
    set outdata ""

    while { $qwords } {
	set d [device_virtual_dr_shift -instance_index $fl_instance \
		   -length [expr $qwords * 72] -value_in_hex]
	
	# The LSW is the first transaction, so we need to process
	# the returned string backwards
	for { set n [expr $qwords - 1] } { $n >= 0 } { incr n -1 } {
	    set ix [expr $n * 18]
	    set di [string range $d $ix [expr $ix + 17]]
	    scan $di "%2x%2x%2x%2x%2x%2x%2x%2x%2x" st d7 d6 d5 d4 d3 d2 d1 d0
	    if { $st & 0x80 } {
		set bd [binary format cccccccc $d0 $d1 $d2 $d3 $d4 $d5 $d6 $d7]
		set nbytes 8
		if { $bytes < 8 } {
		    set bd [string range $bd 0 [expr $bytes - 1]]
		    set nbytes $bytes
		}
		append outdata $bd
		incr qwords -1
		set bytes [expr $bytes - $nbytes]
	    } else {
		# puts "Dropping non-data: $di"
	    }
	}
    }
    return $outdata
}

# Reset state machine
proc fl_reset {} {
    global fl_instance

    puts -nonewline "Issuing reset... "

    select_ir 5
    device_virtual_dr_shift -instance_index $fl_instance \
	-dr_value 1 -length 1 -no_captured_dr_value

    select_ir 4
    set rdy 0
    while { !$rdy } {
	set rdy [device_virtual_dr_shift -instance_index $fl_instance -length 1]
    }

    puts "done."
}

# Sector erase
proc fl_erase addr {
    set secsize [fl_sector_size $addr]
    set secaddr [expr $addr & ~($secsize - 1)]

    puts -nonewline [format "Erasing sector at 0x%x(0x%x)... " $secaddr $secsize]

    # Blank check the sector before erasing
    fl_send [format "50%08X%08X" $secaddr $secsize]
    set zc [fl_recv]
    set ze [format "\[89ABCDEF\]5%08XFFFFFFFF" [expr $secaddr + $secsize]]

    if { ![string match $ze $zc] } {
	# puts "\nNot blank, expected $ze got $zc"

	fl_send 81AAAAAAAA000000AA
	fl_send 815555555500000055
	fl_send 81AAAAAAAA00000080
	fl_send 81AAAAAAAA000000AA
	fl_send 815555555500000055
	fl_send [format "81%08X00000030" $secaddr]

	set read_cmd [format "D0%08X%08X" $secaddr 8]

	set done 0
	while { !$done } {
	    fl_send $read_cmd
	    set v [fl_recv]
	    set done [string match {[89ABCDEF]DFFFFFFFFFFFFFFFF} $v]
	}
	puts "done."
    } else {
	puts "already blank."
    }
}

# Read file
proc fl_read_file { file addr size } {
    set f [open $file {WRONLY CREAT TRUNC BINARY}]

    puts -nonewline [format "Reading file %s@0x%x,0x%x... " $file $addr $size]

    # This is an arbitrary tunable, but at least for Quartus 11 is doesn't
    # seem to get any better with a larger block size...
    set max_block 4096

    # Read data
    set left $size
    fl_send [format "D0%08X%08X" $addr $size]
    while { $left > 0 } {
	set blk [expr ($left < $max_block) ? $left : $max_block]
	puts -nonewline $f [fl_recv_bulk $blk]
	set left [expr $left - $blk]
    }

    close $f
    puts "done."
}

# Write file (without erase)
proc fl_write_file { file addr size } {
    set f [open $file {RDONLY BINARY}]

    puts -nonewline [format "Writing file %s@0x%x,0x%x... " $file $addr $size]

    # Write data
    set left $size
    fl_send [format "D0%08X%08X" $addr 0]
    while { $left > 0 } {
	set blk [expr ($left < 8) ? $left : 8]
	set d [read $f $blk]
	append d [string repeat "\xff" [expr 8 - $blk]]
	binary scan $d H2H2H2H2H2H2H2H2 d0 d1 d2 d3 d4 d5 d6 d7
	fl_send [format "B%X%s%s%s%s%s%s%s%s" $blk $d7 $d6 $d5 $d4 $d3 $d2 $d1 $d0]
	set left [expr $left - $blk]
    }

    # Synchronize
    puts -nonewline "syncing... "
    fl_send 6000000000AEAEAEAE
    set v [fl_recv]
    if { [string match $v [format "\[89ABCDEF\]6%08XAEAEAEAE" [expr $addr + $size]]] } {
	puts "error!"
    } else {
	puts "done."
    }

    close $f
}

# Checksum (CRC32) a region
proc fl_crc32_file { file addr size } {
    fl_send [format "70%08X%08X" $addr $size]
    set v [fl_recv]
    scan $v "%1x%1x%8x%8x" ctr type end crc
    if { $type != 7 || $end != $addr + $size } {
	puts "$file: checksumming failure"
    } else {
	puts [format "%08x %s@0x%x,0x%x" $crc $file $addr $size]
    }
}

# Parse a list of filespecs
proc fl_parse_files { mode files } {
    global fl_device_size

    set last_address 0
    set file_list {}
    
    foreach file $files {
	regexp {^(.*?)(\@([0-9a-fA-FxX]+|)(,([0-9a-fA-FxX]+)|)|)$} $file \
	    junk0 filename junk1 address junk2 len
	if { [string equal $address ""] } {
	    set address $last_address
	}
	if { [string equal $len ""] } {
	    switch $mode {
		read
		{
		    set len [expr $fl_device_size - $address]
		}
		write
		{
		    if { [string equal $filename ""] } {
			set len [expr $fl_device_size - $address]
		    } else {
			set len [file size $filename]
		    }
		}
	    }
	}
	lappend file_list [list $filename $address $len]
    }

    return $file_list
}

# Produce a list of erase blocks from a filespec list
proc fl_get_eraseblocks flist {
    set erase_list {}

    foreach fspec $flist {
	set addr [lindex $fspec 1]
	set len  [lindex $fspec 2]

	set end [expr $addr + $len]

	while { $addr < $end } {
	    set secsize [fl_sector_size $addr]
	    set secaddr [expr $addr & ~($secsize - 1)]

	    lappend erase_list $secaddr
	    set addr [expr $secaddr + $secsize]
	}
    }

    return [lsort -integer -unique $erase_list]
}

# Erase per filespec
proc fl_erase_files flist {
    foreach eb [fl_get_eraseblocks $flist] {
	fl_erase $eb
    }
}

# Read per filespec
proc fl_read_files flist {
    foreach fspec $flist {
	set file [lindex $fspec 0]
	set addr [lindex $fspec 1]
	set len  [lindex $fspec 2]

	if { ![string equal $file ""] } {
	    fl_read_file $file $addr $len
	}
    }
}

# Write per filespec
proc fl_write_files flist {
    foreach fspec $flist {
	set file [lindex $fspec 0]
	set addr [lindex $fspec 1]
	set len  [lindex $fspec 2]

	if { ![string equal $file ""] } {
	    fl_write_file $file $addr $len
	}
    }
}

# Checksum per filespec
proc fl_crc32_files flist {
    foreach fspec $flist {
	set file [lindex $fspec 0]
	set addr [lindex $fspec 1]
	set len  [lindex $fspec 2]

	fl_crc32_file $file $addr $len
    }
}

# ---------------------------------------------------------------------------
#  Start of main program
# ---------------------------------------------------------------------------

if {$argc < 1} {
    error "Usage: quartus_stp -t de1flash.tcl command [filespec...]"
}

set fl_cmd   [lindex $argv 0]
set fl_fspec [lrange $argv 1 end]

# List all available programming hardwares, and select the USBBlaster.
# (Note: this example assumes only one USBBlaster connected.)
#puts "Programming Hardwares:"
#foreach hardware_name [get_hardware_names] {
#    puts $hardware_name
#    if { [string match "USB-Blaster*" $hardware_name] } {
#	set usbblaster_name $hardware_name
#    }
#}

set hardwares [get_hardware_names]
set usbblaster_name [lindex $hardwares 0]

puts "\nUsing programming cable \{$usbblaster_name\}.\n";

# List all devices on the chain, and select the first device on the
# chain.
puts "\nDevices on the JTAG chain:"
foreach device_name [get_device_names -hardware_name $usbblaster_name] {
    puts $device_name
    if { [string match "@1*" $device_name] } {
	set test_device $device_name
    }
}
puts "\nSelecting device: \{$test_device\}.\n";

# Open device
open_device -hardware_name $usbblaster_name -device_name $test_device

device_lock -timeout 120000

fl_reset

switch $fl_cmd {
    write
    {
	set fspec [fl_parse_files write $fl_fspec]
	fl_erase_files $fspec
	fl_write_files $fspec
    }
    writeonly
    {
	set fspec [fl_parse_files write $fl_fspec]
	fl_write_files $fspec
    }
    erase
    {
	set fspec [fl_parse_files write $fl_fspec]
	fl_erase_files $fspec
    }
    read
    {
	set fspec [fl_parse_files read $fl_fspec]
	fl_read_files $fspec
    }
    crc32
    {
	set fspec [fl_parse_files write $fl_fspec]
	fl_crc32_files $fspec
    }
    eraseall
    {
	fl_erase_files [list [list "" 0 $fl_device_size]]
    }
    default
    {
	error "Unknown de1flash command"
    }
}

device_unlock
close_device