## -----------------------------------------------------------------------
##   
##   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 81AAAAAAAAAAAAAAAA
	fl_send 815555555555555555
	fl_send 81AAAAAAAA80808080
	fl_send 81AAAAAAAAAAAAAAAA
	fl_send 815555555555555555
	fl_send [format "81%08X30303030" $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 size } {
    global fl_device_size

    set f [open $file {WRONLY CREAT TRUNC BINARY}]
    if { $size < 0 || $size > $fl_device_size } {
	set size $fl_device_size
    }

    # XXX: obviously wrong...
    set addr 0

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

# Erase a region
proc fl_erase_range {addr size} {
    set xptr $addr
    set left $size
    while { $left > 0 } {
	set secleft [fl_sector_size $xptr]
	fl_erase $xptr
	set left [expr ($secleft >= $left) ? 0 : ($left - $secleft)]
	incr xptr $secleft 
    }
}

# Write file
proc fl_write_file { file size } {
    set f [open $file {RDONLY BINARY}]
    set fsize [file size $file]

    if { $size < 0 || $fsize > $size } {
	set size $fsize
    }

    # XXX: obviously wrong...
    set addr 0

    # First, erase...
    fl_erase_range $addr $size

    # Then, program
    set left $size
    fl_send [format "C0%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 "Sending sync... "
    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
}

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

set fl_cmd  [lindex $argv 0]
set fl_file [lindex $argv 1]
if {$argc > 2} {
    set fl_size [lindex $argv 2]
} else {
    set fl_size -1
}

# 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
    }
}
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	{ fl_write_file $fl_file $fl_size }
    read	{ fl_read_file  $fl_file $fl_size }
    eraseall	{ fl_erase_range 0 $fl_device_size }
    default	{ error "Unknown de1flash command" }
}

device_unlock
close_device