URL
https://opencores.org/ocsvn/w11/w11/trunk
Subversion Repositories w11
Compare Revisions
- This comparison shows the changes necessary to convert path
/w11/tags/w11a_V0.6/tools/tcl
- from Rev 22 to Rev 24
- ↔ Reverse comparison
Rev 22 → Rev 24
/rw11/asm.tcl
0,0 → 1,103
# $Id: asm.tcl 552 2014-03-02 23:02:00Z mueller $ |
# |
# Copyright 2013-2014 by Walter F.J. Mueller <W.F.J.Mueller@gsi.de> |
# |
# This program is free software; you may redistribute and/or modify it under |
# the terms of the GNU General Public License as published by the Free |
# Software Foundation, either version 2, 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 complete details. |
# |
# Revision History: |
# Date Rev Version Comment |
# 2014-03-01 552 1.0.1 BUGFIX: asmwait checks now pc if stop: defined |
# 2013-04-26 510 1.0 Initial version (extracted from util.tcl) |
# |
|
package provide rw11 1.0 |
|
package require rlink |
package require rwxxtpp |
|
namespace eval rw11 { |
|
# |
# asmrun: run a program loaded with ldasm |
# |
proc asmrun {cpu symName opts} { |
upvar 1 $symName sym |
array set defs {r0 0 r1 0 r2 0 r3 0 r4 0 r5 0} |
array set defs $opts |
|
if {![info exists defs(pc)]} { |
if {[info exists sym(start)]} { |
set defs(pc) $sym(start) |
} else { |
error "neither opts(pc) nor sym(start) given" |
} |
} |
|
if {![info exists defs(sp)]} { |
if {[info exists sym(stack)]} { |
set defs(sp) $sym(stack) |
} elseif {[info exists sym(start)]} { |
set defs(sp) $sym(start) |
} else { |
error "neither opts(sp) nor sym(stack) or sym(start) given" |
} |
} |
|
$cpu cp -wr0 $defs(r0) \ |
-wr1 $defs(r1) \ |
-wr2 $defs(r2) \ |
-wr3 $defs(r3) \ |
-wr4 $defs(r4) \ |
-wr5 $defs(r5) |
|
$cpu cp -wsp $defs(sp) \ |
-stapc $defs(pc) |
|
return "" |
} |
|
# |
# asmwait: wait for completion of a program loaded with ldasm |
# |
proc asmwait {cpu symName {tout 10.}} { |
upvar 1 $symName sym |
set dt [$cpu wtcpu -reset $tout] |
if {$dt >= 0 && [info exists sym(stop)]} { |
$cpu cp -rpc -edata $sym(stop) |
} |
return $dt |
} |
|
# |
# asmtreg: test registers after running a program loaded with ldasm |
# |
proc asmtreg {cpu opts} { |
array set defs $opts |
set cpcmd "" |
foreach key [lsort [array names defs]] { |
append cpcmd " -r$key -edata $defs($key)" |
} |
eval $cpu cp $cpcmd |
return "" |
} |
|
# |
# asmtmem: test memory after running a program loaded with ldasm |
# |
proc asmtmem {cpu base list} { |
set nw [llength $list] |
if {$nw == 0} { |
error "asmtreg called with empty list" |
} |
$cpu cp -wal $base -brm $nw -edata $list |
return "" |
} |
|
} |
/rw11/defs.tcl
0,0 → 1,87
# $Id: defs.tcl 553 2014-03-17 06:40:08Z mueller $ |
# |
# Copyright 2014- by Walter F.J. Mueller <W.F.J.Mueller@gsi.de> |
# |
# This program is free software; you may redistribute and/or modify it under |
# the terms of the GNU General Public License as published by the Free |
# Software Foundation, either version 2, 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 complete details. |
# |
# Revision History: |
# Date Rev Version Comment |
# 2014-03-07 553 1.0 Initial version (extracted from util.tcl) |
# |
|
package provide rw11 1.0 |
|
package require rlink |
package require rwxxtpp |
|
namespace eval rw11 { |
# |
# setup cp interface register descriptions for w11a ----------------------- |
# |
regdsc CP_CNTL {func 3 0} |
regdsc CP_STAT {rust 7 4} {halt 3} {go 2} {merr 1} {err 0} |
regdsc CP_IBRB {base 12 7} {bw 1 2} |
regdsc CP_AH {ubm 7} {p22 6} {addr 5 6} |
# |
# setup w11a register descriptions ----------------------------------------- |
# |
# PSW - processor status word -------------------------------------- |
set A_PSW 0177776 |
regdsc PSW {cmode 15 2} {pmode 13 2} {rset 11} {pri 7 3} {tflag 3} {cc 3 4} |
# |
# SSR0 - MMU Segment Status Register #0 ---------------------------- |
set A_SSR0 0177572 |
regdsc SSR0 {abo_nonres 15} {abo_len 14} {abo_rd 13} \ |
{trap_mmu 12} {ena_trap 9} {inst_compl 7} \ |
{mode 6 2} {dspace 4} {num 3 3} {ena 0} |
# |
# SSR1 - MMU Segment Status Register #1 ---------------------------- |
set A_SSR1 0177574 |
regdsc SSR1 {delta1 15 5} {rnum1 10 3} {delta0 7 5} {rnum0 2 3} |
# |
# SSR2 - MMU Segment Status Register #2 ---------------------------- |
set A_SSR2 0177576 |
# |
# SSR3 - MMU Segment Status Register #3 ---------------------------- |
set A_SSR3 0172516 |
regdsc SSR3 {ena_ubm 5} {ena_22bit 4} {d_km 2} {d_sm 1} {d_um 0} |
# |
# SAR/SDR - MMU Address/Segment Descriptor Register ---------------- |
set A_SDR_KM 0172300 |
set A_SAR_KM 0172340 |
set A_SDR_SM 0172200 |
set A_SAR_SM 0172240 |
set A_SDR_UM 0177600 |
set A_SAR_UM 0177640 |
regdsc SDR {slf 14 7} {aia 7} {aiw 6} {ed 3} {acf 2 3} |
# |
# PIRQ - Program Interrupt Requests ------------------------------- |
set A_PIRQ 0177772 |
regdsc PIRQ {pir 15 7} {piah 7 3} {pial 3 3} |
# |
# CPUERR - CPU Error Register ------------------------------------- |
set A_CPUERR 0177766 |
regdsc CPUERR {illhlt 7} {adderr 6} {nxm 5} {iobto 4} {ysv 3} {rsv 2} |
# |
# other w11a definitions --------------------------------------------------- |
# Interrupt vectors ----------------------------------------------- |
# |
set V_004 0000004 |
set V_010 0000010 |
set V_BPT 0000014 |
set V_IOT 0000020 |
set V_PWR 0000024 |
set V_EMT 0000030 |
set V_TRAP 0000034 |
set V_PIRQ 0000240 |
set V_FPU 0000244 |
set V_MMU 0000250 |
|
} |
/rw11/util.tcl
0,0 → 1,166
# $Id: util.tcl 553 2014-03-17 06:40:08Z mueller $ |
# |
# Copyright 2013- by Walter F.J. Mueller <W.F.J.Mueller@gsi.de> |
# |
# This program is free software; you may redistribute and/or modify it under |
# the terms of the GNU General Public License as published by the Free |
# Software Foundation, either version 2, 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 complete details. |
# |
# Revision History: |
# Date Rev Version Comment |
# 2014-03-07 553 1.1.3 move definitions to defs.tcl |
# 2013-05-09 517 1.1.2 add setup_(tt|lp|pp|ostr) device setup procs |
# 2013-04-26 510 1.1.1 split, asm* and tbench* into separate files |
# 2013-04-01 501 1.1 add regdsc's and asm* procs |
# 2013-02-02 380 1.0 Initial version |
# |
|
package provide rw11 1.0 |
|
package require rlink |
package require rwxxtpp |
|
namespace eval rw11 { |
# |
# setup_cpu: create w11 cpu system |
# |
proc setup_cpu {} { |
rlc config -basestat 2 -baseaddr 8 -basedata 8 |
rw11 rlw rls w11a 1 |
cpu0 cp -reset; # reset CPU |
return "" |
} |
|
# |
# setup_sys: create full system |
# |
proc setup_sys {} { |
if {[info commands rlw] eq ""} { |
setup_cpu |
} |
cpu0 add dl11 |
cpu0 add dl11 -base 0176500 -lam 2 |
cpu0 add rk11 |
cpu0 add lp11 |
cpu0 add pc11 |
rlw start |
return "" |
} |
|
# |
# setup_tt: setup terminals |
# |
proc setup_tt {{cpu "cpu0"} {optlist {}}} { |
# process and check options |
array set optref { ndl 2 dlrlim 0 ndz 0 to7bit 0 app 0 nbck 1} |
rutil::optlist2arr opt optref $optlist |
|
# check option values |
if {$opt(ndl) < 1 || $opt(ndl) > 2} { |
error "ndl option must be 1 or 2" |
} |
if {$opt(ndz) != 0} { |
error "ndz option must be 0 (till dz11 support is added)" |
} |
|
# setup attach url options |
set urlopt "?crlf" |
if {$opt(app) != 0} { |
append urlopt ";app" |
} |
if {$opt(nbck) != 0} { |
append urlopt ";bck=$opt(nbck)" |
} |
|
# setup list if DL11 controllers |
set dllist {} |
lappend dllist "tta" "8000" |
if {$opt(ndl) == 2} { |
lappend dllist "ttb" "8001" |
} |
|
# handle DL11 controllers |
foreach {cntl port} $dllist { |
set unit "${cntl}0" |
${cpu}${unit} att "tcp:?port=${port}" |
${cpu}${unit} set log "tirri_${unit}.log${urlopt}" |
if {$opt(dlrlim) != 0} { |
${cpu}${cntl} set rxrlim 7 |
} |
if {$opt(to7bit) != 0} { |
${cpu}${unit} set to7bit 1 |
} |
} |
return "" |
} |
|
# |
# setup_ostr: setup Ostream device (currently lp or pp) |
# |
proc setup_ostr {cpu unit optlist} { |
# process and check options |
array set optref { app 0 nbck 1} |
rutil::optlist2arr opt optref $optlist |
|
# setup attach url options |
set urloptlist {} |
if {$opt(app) != 0} { |
append urloptlist "app" |
} |
if {$opt(nbck) != 0} { |
append urloptlist "bck=$opt(nbck)" |
} |
set urlopt "" |
if {[llength $urloptlist] > 0} { |
append urlopt "?" |
append urlopt [join $urloptlist ";"] |
} |
|
# handle unit |
${cpu}${unit} att "tirri_${unit}.dat${urlopt}" |
return "" |
} |
|
# |
# setup_lp: setup printer |
# |
proc setup_lp {{cpu "cpu0"} {optlist {}}} { |
# process and check options |
array set optref { nlp 1 app 0 nbck 1} |
rutil::optlist2arr opt optref $optlist |
if {$opt(nlp) != 0} { |
setup_ostr $cpu "lpa0" [list app $opt(app) nbck $opt(nbck)] |
} |
} |
# |
# setup_pp: setup paper puncher |
# |
proc setup_pp {{cpu "cpu0"} {optlist {}}} { |
# process and check options |
array set optref { npc 1 app 0 nbck 1} |
rutil::optlist2arr opt optref $optlist |
if {$opt(npc) != 0} { |
setup_ostr $cpu "pp" [list app $opt(app) nbck $opt(nbck)] |
} |
} |
|
# |
# run_pdpcp: execute pdpcp type command file |
# |
proc run_pdpcp {fname {cpu "cpu0"}} { |
rlc errcnt -clear |
set code [exec ticonv_pdpcp $cpu $fname] |
eval $code |
set errcnt [rlc errcnt] |
if { $errcnt } { |
puts [format "run_pdpcp: FAIL after %d errors" $errcnt] |
} |
return $errcnt |
} |
|
} |
/rw11/cpumon.tcl
0,0 → 1,95
# $Id: cpumon.tcl 512 2013-04-28 07:44:02Z mueller $ |
# |
# Copyright 2013- by Walter F.J. Mueller <W.F.J.Mueller@gsi.de> |
# |
# This program is free software; you may redistribute and/or modify it under |
# the terms of the GNU General Public License as published by the Free |
# Software Foundation, either version 2, 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 complete details. |
# |
# Revision History: |
# Date Rev Version Comment |
# 2013-04-26 510 1.0 Initial version |
# |
|
package provide rw11 1.0 |
|
package require rlink |
package require rwxxtpp |
|
namespace eval rw11 { |
|
# |
# cpumon: special command environment while cpu is running |
# |
|
variable cpumon_active 0 |
variable cpumon_prompt ">" |
variable cpumon_attnhdl_added 0 |
variable cpumon_eofchar_save {puts {}} |
|
proc cpumon {{prompt "cpumon> "} } { |
variable cpumon_active |
variable cpumon_prompt |
variable cpumon_attnhdl_added |
variable cpumon_eofchar_save |
global tirri_interactive |
|
# quit if cpumon already active |
if {$cpumon_active} { |
error "cpumon already active" |
} |
|
# check that attn handler is installed |
if {!$cpumon_attnhdl_added} { |
rls attn -add 0x0001 { rw11::cpumon_attncpu } |
set cpumon_attnhdl_added 1 |
} |
|
# redefine ti_rri prompt and eof handling |
if { $tirri_interactive } { |
# setup new prompt (save old one...) |
set cpumon_prompt $prompt |
rename ::tclreadline::prompt1 ::rw11::cpumon_prompt1_save |
namespace eval ::tclreadline { |
proc prompt1 {} { |
return $rw11::cpumon_prompt |
} |
} |
# disable ^D (and save old setting) |
set cpumon_eofchar_save [::tclreadline::readline eofchar] |
::tclreadline::readline eofchar \ |
{puts {^D disabled, use tirri_exit if you really want to bail-out}} |
} |
|
set cpumon_active 1 |
return "" |
} |
|
# |
# cpumon_attncpu: cpu attn handler |
# |
proc cpumon_attncpu {} { |
variable cpumon_active |
variable cpumon_eofchar_save |
global tirri_interactive |
|
if {$cpumon_active} { |
puts "CPU down attention" |
puts [cpu0 show -r0ps] |
# restore ti_rri prompt and eof handling |
if { $tirri_interactive } { |
rename ::tclreadline::prompt1 {} |
rename ::rw11::cpumon_prompt1_save ::tclreadline::prompt1 |
::tclreadline::readline eofchar $cpumon_eofchar_save |
} |
set cpumon_active 0 |
} |
return "" |
} |
|
} |
/rw11/cpucons.tcl
0,0 → 1,84
# $Id: cpucons.tcl 512 2013-04-28 07:44:02Z mueller $ |
# |
# Copyright 2013- by Walter F.J. Mueller <W.F.J.Mueller@gsi.de> |
# |
# This program is free software; you may redistribute and/or modify it under |
# the terms of the GNU General Public License as published by the Free |
# Software Foundation, either version 2, 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 complete details. |
# |
# Revision History: |
# Date Rev Version Comment |
# 2013-04-26 510 1.0 Initial version |
# |
|
package provide rw11 1.0 |
|
package require rlink |
package require rwxxtpp |
|
namespace eval rw11 { |
|
# |
# cpumon: special command environment while cpu is running |
# |
|
variable cpucons_done 0 |
|
# |
# cpucons: setup special console shortcut commands |
# |
proc cpucons {} { |
variable cpucons_done |
|
# quit if cpucons already done |
if {$cpucons_done} { |
return "" |
} |
|
namespace eval :: { |
|
# |
# '.' show current PC and PS |
# |
proc "." {} { |
return [cpu0 show -pcps] |
} |
|
# |
# '?' show current PC and PS and R0-R6 |
# |
proc "?" {} { |
return [cpu0 show -r0ps] |
} |
|
# |
# '(' type some chars (no cr at end) |
# |
proc "(" {args} { |
set str [join $args " "] |
cpu0tta0 type $str |
return "" |
} |
|
# |
# '<' type some chars (with cr at end) |
# |
proc "<" {args} { |
set str [join $args " "] |
append str "\n" |
cpu0tta0 type $str |
return "" |
} |
|
} |
|
set cpucons_done 1 |
return "" |
} |
|
} |
/rw11/tbench.tcl
0,0 → 1,72
# $Id: tbench.tcl 510 2013-04-26 16:14:57Z mueller $ |
# |
# Copyright 2013- by Walter F.J. Mueller <W.F.J.Mueller@gsi.de> |
# |
# This program is free software; you may redistribute and/or modify it under |
# the terms of the GNU General Public License as published by the Free |
# Software Foundation, either version 2, 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 complete details. |
# |
# Revision History: |
# Date Rev Version Comment |
# 2013-04-26 510 1.0 Initial version (extracted from util.tcl) |
# |
|
package provide rw11 1.0 |
|
package require rlink |
package require rwxxtpp |
|
namespace eval rw11 { |
|
# |
# tbench: driver for tbench scripts |
# |
proc tbench {fname} { |
rlc exec -init 0xff [regbld rlink::INIT anena] |
set errcnt [tbench_list $fname] |
return $errcnt |
} |
|
# |
# tbench_file: execute list of tbench steps |
# |
proc tbench_list {lname} { |
set errcnt 0 |
if {[string match "@*" $lname]} { |
set fname [string range $lname 1 end] |
set fh [open "$::env(RETROBASE)/tools/tbench/$fname"] |
while {[gets $fh line] >= 0} { |
if {[string match "#*" $line]} { |
if {[string match "##*" $line]} { puts $line } |
} elseif {[string match "@*" $line]} { |
incr errcnt [tbench_list $line] |
} else { |
incr errcnt [tbench_step $line] |
} |
} |
close $fh |
} else { |
incr errcnt [tbench_step $lname] |
} |
puts [format "%s: %s" $lname [rutil::errcnt2txt $errcnt]] |
return $errcnt |
} |
|
# |
# tbench_step: execute single tbench step |
# |
proc tbench_step {fname} { |
rlc errcnt -clear |
set cpu cpu0 |
source "$::env(RETROBASE)/tools/tbench/$fname" |
set errcnt [rlc errcnt] |
puts [format "%s: %s" $fname [rutil::errcnt2txt $errcnt]] |
return $errcnt |
} |
|
} |
/rw11/.cvsignore
0,0 → 1,72
pkgIndex.tcl |
rw11
Property changes :
Added: svn:ignore
## -0,0 +1,33 ##
+*.dep_ghdl
+*.dep_isim
+*.dep_xst
+work-obj93.cf
+*.vcd
+*.ghw
+*.sav
+*.tmp
+*.exe
+ise
+xflow.his
+*.ngc
+*.ncd
+*.pcf
+*.bit
+*.msk
+isim
+isim.log
+isim.wdb
+fuse.log
+*_[sft]sim.vhd
+*_tsim.sdf
+*_xst.log
+*_tra.log
+*_twr.log
+*_map.log
+*_par.log
+*_pad.log
+*_bgn.log
+*_svn.log
+*_sum.log
+*_[dsft]sim.log
+pkgIndex.tcl
Index: rutil/util.tcl
===================================================================
--- rutil/util.tcl (nonexistent)
+++ rutil/util.tcl (revision 24)
@@ -0,0 +1,219 @@
+# $Id: util.tcl 517 2013-05-09 21:34:45Z mueller $
+#
+# Copyright 2011-2013 by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2013-05-09 517 1.0.1 add optlist2arr
+# 2011-03-27 374 1.0 Initial version
+# 2011-03-19 372 0.1 First draft
+#
+
+package provide rutil 1.0
+
+package require rutiltpp
+
+namespace eval rutil {
+ #
+ # optlist2arr: process options arguments given as key value list
+ #
+ proc optlist2arr {outarrname refarrname optlist} {
+ upvar $outarrname outarr
+ upvar $refarrname refarr
+ array set outarr [array get refarr]
+ foreach {key value} $optlist {
+ if {[info exists outarr($key)]} {
+ set outarr($key) $value
+ } else {
+ error "key $key not valid in optlist"
+ }
+ }
+ return ""
+ }
+
+ #
+ # regdsc: setup a register descriptor
+ #
+ proc regdsc {name args} {
+ upvar $name rdsc
+ set fbegmax -1
+ set mskftot 0
+
+ foreach arg $args {
+ set nopt [llength $arg]
+ if {$nopt < 2} {
+ error "wrong number of elements in field dsc \"$arg\""
+ }
+ set fnam [lindex $arg 0]
+ set fbeg [lindex $arg 1]
+ set flen [lindex $arg 2]
+ if {$nopt < 3} { set flen 1 }
+ set popt [lindex $arg 3]
+ if {$nopt < 4} { set popt "b" }
+
+ if {( $flen - 1 ) > $fbeg} {
+ error "error in field dsc \"$arg\": length > start position"
+ }
+
+ set mskb [expr {( 1 << $flen ) - 1}]
+ set mskf [expr {$mskb << ( $fbeg - ( $flen - 1 ) )}]
+ set rdsc($fnam) [list $fbeg $flen $mskb $mskf $popt]
+
+ if {$fbegmax < $fbeg} {set fbegmax $fbeg}
+ set mskftot [expr {$mskftot | $mskf}]
+ }
+
+ set rdsc(-n) [lsort -decreasing -command regdsc_sort \
+ [array names rdsc -regexp {^[^-]}] ]
+
+ set rdsc(-w) [expr {$fbegmax + 1}]
+ set rdsc(-m) $mskftot
+
+ return ""
+ }
+
+ #
+ # regdsc_print: print register descriptor
+ #
+ proc regdsc_print {name} {
+ upvar $name rdsc
+ set rval ""
+ if {! [info exists rdsc]} {
+ error "can't access \"$name\": variable doesn't exist"
+ }
+
+ set rsize $rdsc(-w)
+
+ append rval " field bits bitmask"
+
+ foreach fnam $rdsc(-n) {
+ set fdsc $rdsc($fnam)
+ set fbeg [lindex $fdsc 0]
+ set flen [lindex $fdsc 1]
+ set fmskf [lindex $fdsc 3]
+ set line " "
+ append line [format "%8s" $fnam]
+ if {$flen > 1} {
+ append line [format " %2d:%2d" $fbeg [expr {$fbeg - $flen + 1}]]
+ } else {
+ append line [format " %2d" $fbeg]
+ }
+ append line " "
+ append line [pbvi "b${rsize}" $fmskf]
+ append rval "\n$line"
+ }
+ return $rval
+ }
+
+ proc regdsc_sort {a b} {
+ upvar rdsc urdsc
+ return [expr {[lindex $urdsc($a) 0] - [lindex $urdsc($b) 0] }]
+ }
+
+ #
+ # regbld: build a register value from a list of fields
+ #
+ proc regbld {name args} {
+ upvar $name rdsc
+ set rval 0
+ foreach arg $args {
+ if {[llength $arg] < 1 || [llength $arg] > 2} {
+ error "error in field specifier \"$arg\": must be 'name [val]'"
+ }
+ set fnam [lindex $arg 0]
+ if {! [info exists rdsc($fnam)] } {
+ error "error in field specifier \"$arg\": field unknown"
+ }
+ set fbeg [lindex $rdsc($fnam) 0]
+ set flen [lindex $rdsc($fnam) 1]
+
+ if {[llength $arg] == 1} {
+ if {$flen > 1} {
+ error "error in field specifier \"$arg\": no value and flen>1"
+ }
+ set mskf [lindex $rdsc($fnam) 3]
+ set rval [expr {$rval | $mskf}]
+
+ } else {
+ set fval [lindex $arg 1]
+ set mskb [lindex $rdsc($fnam) 2]
+ if {$fval >= 0} {
+ if {$fval > $mskb} {
+ error "error in field specifier \"$arg\": value > $mskb"
+ }
+ } else {
+ if {$fval < [expr {- $mskb}]} {
+ error "error in field specifier \"$arg\": value < [expr -$mskb]"
+ }
+ set fval [expr {$fval & $mskb}]
+ }
+ set rval [expr {$rval | $fval << ( $fbeg - ( $flen - 1 ) )}]
+ }
+
+ }
+ return $rval
+ }
+
+ #
+ # regget: extract field from a register value
+ #
+ proc regget {name val} {
+ upvar $name fdsc
+ set fbeg [lindex $fdsc 0]
+ set flen [lindex $fdsc 1]
+ set mskb [lindex $fdsc 2]
+ return [expr {( $val >> ( $fbeg - ( $flen - 1 ) ) ) & $mskb}]
+ }
+
+ #
+ # regtxt: convert register value to a text string
+ #
+ proc regtxt {name val} {
+ upvar $name rdsc
+ set rval ""
+
+ foreach fnam $rdsc(-n) {
+ set popt [lindex $rdsc($fnam) 4]
+ set fval [regget rdsc($fnam) $val]
+ if {$popt ne "-"} {
+ if {$rval ne ""} {append rval " "}
+ append rval "${fnam}:"
+ if {$popt eq "b"} {
+ set flen [lindex $rdsc($fnam) 1]
+ append rval [pbvi b${flen} $fval]
+ } else {
+ append rval [format "%${popt}" $fval]
+ }
+ }
+ }
+ return $rval
+ }
+ #
+ # errcnt2txt: returns "PASS" if 0 and "FAIL" otherwise
+ #
+ proc errcnt2txt {errcnt} {
+ if {$errcnt} {return "FAIL"}
+ return "PASS"
+ }
+
+ namespace export regdsc
+ namespace export regdsc_print
+ namespace export regbld
+ namespace export regget
+ namespace export regtxt
+}
+
+namespace import rutil::regdsc
+namespace import rutil::regdsc_print
+namespace import rutil::regbld
+namespace import rutil::regget
+namespace import rutil::regtxt
Index: rutil/.cvsignore
===================================================================
--- rutil/.cvsignore (nonexistent)
+++ rutil/.cvsignore (revision 24)
@@ -0,0 +1 @@
+pkgIndex.tcl
Index: rutil
===================================================================
--- rutil (nonexistent)
+++ rutil (revision 24)
rutil
Property changes :
Added: svn:ignore
## -0,0 +1,33 ##
+*.dep_ghdl
+*.dep_isim
+*.dep_xst
+work-obj93.cf
+*.vcd
+*.ghw
+*.sav
+*.tmp
+*.exe
+ise
+xflow.his
+*.ngc
+*.ncd
+*.pcf
+*.bit
+*.msk
+isim
+isim.log
+isim.wdb
+fuse.log
+*_[sft]sim.vhd
+*_tsim.sdf
+*_xst.log
+*_tra.log
+*_twr.log
+*_map.log
+*_par.log
+*_pad.log
+*_bgn.log
+*_svn.log
+*_sum.log
+*_[dsft]sim.log
+pkgIndex.tcl
Index: rbemon/test_regs.tcl
===================================================================
--- rbemon/test_regs.tcl (nonexistent)
+++ rbemon/test_regs.tcl (revision 24)
@@ -0,0 +1,98 @@
+# $Id: test_regs.tcl 516 2013-05-05 21:24:52Z mueller $
+#
+# Copyright 2011-2013 by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2011-12-18 440 1.0.1 increase npoll in "CNTL.clr->0" test
+# 2011-04-02 375 1.0 Initial version
+#
+
+package provide rbemon 1.0
+
+package require rutiltpp
+package require rutil
+package require rlink
+
+namespace eval rbemon {
+ #
+ # Basic tests with rbd_eyemon registers
+ #
+ proc test_regs {} {
+ set esdval 0x00
+ set esdmsk [regbld rlink::STAT {stat -1}]
+ #
+ set errcnt 0
+ rlc errcnt -clear
+ #
+ rlc log "rbemon::test_regs - start"
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 1a: write/read cntl"
+ # ensure that last value 0x0 -> go=0
+ foreach val [list [regbld rbemon::CNTL ena01] [regbld rbemon::CNTL ena10] \
+ [regbld rbemon::CNTL go] 0x0 ] {
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg em.cntl $val \
+ -rreg em.cntl -edata $val
+ }
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 1b: write/read rdiv"
+ foreach val [list [regbld rbemon::RDIV {rdiv -1}] 0x0 ] {
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg em.rdiv $val \
+ -rreg em.rdiv -edata $val
+ }
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 1c: write/read addr"
+ set amax [regget rbemon::ADDR(addr) -1]
+ foreach addr [list 0x1 $amax 0x0] {
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg em.addr $addr \
+ -rreg em.addr -edata $addr
+ }
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 2: verify addr increments on data reads"
+ foreach addr [list 0x0 0x011 [expr {$amax - 1}]] {
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg em.addr $addr \
+ -rreg em.data \
+ -rreg em.addr -edata [expr {( $addr + 1 ) & $amax}] \
+ -rreg em.data \
+ -rreg em.addr -edata [expr {( $addr + 2 ) & $amax}]
+ }
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 3: verify rberr on DATA write and DATE read if in go state"
+ rlc exec \
+ -wreg em.data 0x0000 -estat [regbld rlink::STAT rberr] $esdmsk \
+ -wreg em.cntl [regbld rbemon::CNTL go] -estat $esdval $esdmsk \
+ -rreg em.data -estat [regbld rlink::STAT rberr] $esdmsk
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 4: verify that CNTL.clr returns to 0"
+ set npoll 48
+ set edat {}
+ set emsk {}
+ for {set i 0} {$i < $npoll} {incr i} { lappend edat 0x0000 }
+ for {set i 1} {$i < $npoll} {incr i} { lappend emsk 0xffff }
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg em.cntl [regbld rbemon::CNTL clr] \
+ -rblk em.cntl $npoll -edata $edat $emsk
+ #
+ incr errcnt [rlc errcnt -clear]
+ return $errcnt
+ }
+}
Index: rbemon/test_rbtest_sim.tcl
===================================================================
--- rbemon/test_rbtest_sim.tcl (nonexistent)
+++ rbemon/test_rbtest_sim.tcl (revision 24)
@@ -0,0 +1,101 @@
+# $Id: test_rbtest_sim.tcl 516 2013-05-05 21:24:52Z mueller $
+#
+# Copyright 2011-2013 by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2011-04-17 376 1.0 Initial version
+#
+
+package provide rbemon 1.0
+
+package require rbtest
+
+namespace eval rbemon {
+ #
+ # some simple tests against rbd_tester registers in sim mode
+ #
+ proc test_rbtest_sim {} {
+ set esdval 0x00
+ set esdmsk [regbld rlink::STAT {stat -1}]
+ #
+ set errcnt 0
+ rlc errcnt -clear
+ #
+ rlc log "rbemon::test_rbtest_sim - start"
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 1: write to te.data, verify that transitions seen"
+ set bsize 25
+ #
+ rlc exec -wreg em.rdiv 0 -estat $esdval $esdmsk
+ rlc log " - data - 01 10 va00 va01 va02 va03 va04 va05 va06 va07 va08 va09"
+ #
+ # Note: avoid chars which will be escpaped, like 10000000, for this test
+ #
+ foreach {pat ena01 ena10 exp} \
+ [list [bvi b 00000000] 1 1 [list 0 0 0 0 0 0 0 0 1 0]\
+ [bvi b 00000001] 1 1 [list 1 1 0 0 0 0 0 0 1 0]\
+ [bvi b 00000010] 1 1 [list 0 1 1 0 0 0 0 0 1 0]\
+ [bvi b 00000100] 1 1 [list 0 0 1 1 0 0 0 0 1 0]\
+ [bvi b 00001000] 1 1 [list 0 0 0 1 1 0 0 0 1 0]\
+ [bvi b 00010000] 1 1 [list 0 0 0 0 1 1 0 0 1 0]\
+ [bvi b 00100000] 1 1 [list 0 0 0 0 0 1 1 0 1 0]\
+ [bvi b 01000000] 1 1 [list 0 0 0 0 0 0 1 1 1 0]\
+ [bvi b 11111111] 1 1 [list 1 0 0 0 0 0 0 0 0 0]\
+ [bvi b 11111110] 1 1 [list 0 1 0 0 0 0 0 0 0 0]\
+ [bvi b 01010101] 1 1 [list 1 1 1 1 1 1 1 1 1 0]\
+ [bvi b 00110011] 1 1 [list 1 0 1 0 1 0 1 0 1 0]\
+ [bvi b 00000001] 0 1 [list 0 1 0 0 0 0 0 0 0 0]\
+ [bvi b 00000001] 1 0 [list 1 0 0 0 0 0 0 0 1 0]\
+ [bvi b 01010101] 0 1 [list 0 1 0 1 0 1 0 1 0 0]\
+ [bvi b 01010101] 1 0 [list 1 0 1 0 1 0 1 0 1 0]\
+ ] {
+ set bdata {}
+ for {set i 0} {$i < $bsize} {incr i} {
+ lappend bdata [expr {( $pat << 8 ) | $pat}]
+ }
+
+ rbemon::clear
+ rbemon::start $ena01 $ena10
+ rlc exec -wblk te.data $bdata -estat $esdval $esdmsk
+ rbemon::stop
+
+ set edata [rbemon::read 10]
+
+ set oline " "
+ set pafa "OK"
+ append oline [pbvi b8 $pat]
+ append oline [format " %d %d" $ena01 $ena10]
+ for {set i 0} {$i < 10} {incr i} {
+ set ebin [lindex $edata $i]
+ set eexp [lindex $exp $i]
+ append oline [format " %3d" $ebin]
+ if {($eexp != 0 && $ebin < 2 * $bsize) ||
+ ($eexp == 0 && $ebin >= 2 * $bsize)} {
+ append oline "#"
+ set pafa "FAIL"
+ incr errcnt
+ } else {
+ append oline "!"
+ }
+ }
+ append oline " "
+ append oline $pafa
+ rlc log $oline
+ }
+ #
+ #-------------------------------------------------------------------------
+ incr errcnt [rlc errcnt -clear]
+ return $errcnt
+ }
+}
Index: rbemon/util.tcl
===================================================================
--- rbemon/util.tcl (nonexistent)
+++ rbemon/util.tcl (revision 24)
@@ -0,0 +1,106 @@
+# $Id: util.tcl 516 2013-05-05 21:24:52Z mueller $
+#
+# Copyright 2011-2013 by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2011-04-17 376 1.0.1 add proc read
+# 2011-04-02 375 1.0 Initial version
+#
+
+package provide rbemon 1.0
+
+package require rutil
+package require rlink
+
+namespace eval rbemon {
+ #
+ # setup register descriptions for rbd_eyemon
+ #
+ regdsc CNTL {ena01 3} {ena10 2} {clr 1} {go 0}
+ regdsc RDIV {rdiv 7 8}
+ regdsc ADDR {addr 9 10 "-"} {laddr 9 8} {waddr 0}
+ #
+ # setup: amap definitions for rbd_eyemon
+ #
+ proc setup {base} {
+ rlc amap -insert em.cntl [expr {$base + 0x00}]
+ rlc amap -insert em.rdiv [expr {$base + 0x01}]
+ rlc amap -insert em.addr [expr {$base + 0x02}]
+ rlc amap -insert em.data [expr {$base + 0x03}]
+ }
+ #
+ # init: reset rbd_eyemon (stop monitor, clear rdiv and addr)
+ #
+ proc init {} {
+ rlc exec \
+ -wreg em.cntl 0x0000 \
+ -wreg em.rdiv 0x0000
+ }
+ #
+ # clear: clear eyemon data
+ #
+ proc clear {} {
+ set clrbit [regbld rbemon::CNTL clr]
+ rlc exec -rreg em.cntl cur_cntl
+ rlc exec -wreg em.cntl [expr {$cur_cntl | $clrbit}]
+ set clrrun $clrbit
+ set npoll 0
+ while {$clrrun != 0} {
+ rlc exec -rreg em.cntl cur_cntl
+ set clrrun [expr {$cur_cntl & $clrbit}]
+ incr npoll 1
+ if {$npoll > 10} {
+ error "-E: rbemon::clear failed, CNTL.clr didn't go back to 0"
+ }
+ }
+ return ""
+ }
+ #
+ # start: start the eyemon
+ #
+ proc start {{ena01 0} {ena10 0}} {
+ if {$ena01 == 0 && $ena10 == 0} {
+ set ena01 1
+ set ena10 1
+ }
+ rlc exec -wreg em.cntl [regbld rbemon::CNTL go \
+ [list ena01 $ena01] [list ena10 $ena10] ]
+ }
+ #
+ # stop: stop the eyemon
+ #
+ proc stop {} {
+ rlc exec -wreg em.cntl 0x0000
+ }
+ #
+ # read: read eyemon data
+ #
+ proc read {{nval 512}} {
+ set addr 0
+ set rval {}
+ while {$nval > 0} {
+ set nblk [expr {$nval << 1}]
+ if {$nblk > 256} {set nblk 256}
+ rlc exec \
+ -wreg em.addr $addr \
+ -rblk em.data $nblk rawdat
+ foreach {dl dh} $rawdat {
+ lappend rval [expr {( $dh << 16 ) | $dl}]
+ }
+ incr addr $nblk
+ set nval [expr {$nval - ( $nblk >> 1 ) }]
+ }
+ return $rval
+ }
+
+}
Index: rbemon/.cvsignore
===================================================================
--- rbemon/.cvsignore (nonexistent)
+++ rbemon/.cvsignore (revision 24)
@@ -0,0 +1 @@
+pkgIndex.tcl
Index: rbemon
===================================================================
--- rbemon (nonexistent)
+++ rbemon (revision 24)
rbemon
Property changes :
Added: svn:ignore
## -0,0 +1,33 ##
+*.dep_ghdl
+*.dep_isim
+*.dep_xst
+work-obj93.cf
+*.vcd
+*.ghw
+*.sav
+*.tmp
+*.exe
+ise
+xflow.his
+*.ngc
+*.ncd
+*.pcf
+*.bit
+*.msk
+isim
+isim.log
+isim.wdb
+fuse.log
+*_[sft]sim.vhd
+*_tsim.sdf
+*_xst.log
+*_tra.log
+*_twr.log
+*_map.log
+*_par.log
+*_pad.log
+*_bgn.log
+*_svn.log
+*_sum.log
+*_[dsft]sim.log
+pkgIndex.tcl
Index: rbtest/test_fifo.tcl
===================================================================
--- rbtest/test_fifo.tcl (nonexistent)
+++ rbtest/test_fifo.tcl (revision 24)
@@ -0,0 +1,179 @@
+# $Id: test_fifo.tcl 516 2013-05-05 21:24:52Z mueller $
+#
+# Copyright 2011-2013 by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2011-03-27 374 1.0 Initial version
+# 2011-03-13 369 0.1 First draft
+#
+
+package provide rbtest 1.0
+
+package require rutiltpp
+package require rutil
+package require rlink
+
+namespace eval rbtest {
+ #
+ # Basic tests with cntl and fifo registers.
+ #
+ proc test_fifo {} {
+ set esdval 0x00
+ set esdmsk [regbld rlink::STAT {stat -1}]
+ #
+ set errcnt 0
+ rlc errcnt -clear
+ #
+ rlc log "rbtest::test_fifo - init: clear cntl, data, and fifo"
+ # Note: fifo clear via init is tested later, used here 'speculatively'
+ rlc exec -init te.cntl [regbld rbtest::INIT fifo data cntl]
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 1: fifo write/read with wreg/rreg"
+ # single word
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.fifo 0x0000 \
+ -rreg te.fifo -estat 0x0000
+ # three words
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.fifo 0xdead \
+ -wreg te.fifo 0xbeaf \
+ -wreg te.fifo 0x1234 \
+ -rreg te.fifo -edata 0xdead \
+ -rreg te.fifo -edata 0xbeaf \
+ -rreg te.fifo -edata 0x1234
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 2: fifo write/read with wblk/rblk"
+ # two words
+ set blk {0x1111 0x2222}
+ rlc exec -estatdef $esdval $esdmsk \
+ -wblk te.fifo $blk \
+ -rblk te.fifo [llength $blk] -edata $blk
+ # six words
+ set blk {0x3333 0x4444 0x5555 0x6666 0x7777 0x8888}
+ rlc exec -estatdef $esdval $esdmsk \
+ -wblk te.fifo $blk \
+ -rblk te.fifo [llength $blk] -edata $blk
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 3a: fifo read error (write 3, read 4)"
+ set blk {0xdead 0xbeaf 0x1234}
+ rlc exec -estatdef $esdval $esdmsk \
+ -wblk te.fifo $blk \
+ -rblk te.fifo 4 -edata $blk -estat [regbld rlink::STAT rberr] $esdmsk
+ #
+ #
+ rlc log " test 3b: fifo write error (write 17, read 16)"
+ set blk {}
+ for { set i 0 } { $i < 17 } { incr i } {
+ lappend blk [expr {$i | ( $i << 8 ) }]
+ }
+ rlc exec -estatdef $esdval $esdmsk \
+ -wblk te.fifo $blk -estat [regbld rlink::STAT rberr] $esdmsk \
+ -rblk te.fifo 16 -edata [lrange $blk 0 15]
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 4a: verify that init 100 clears fifo ant not cntl&data"
+ # check fifo empty; write a value; clear fifo via init; check fifo empty
+ # check that cntl and data not affected
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.cntl [regbld rbtest::CNTL {stat 0x7}] \
+ -wreg te.data 0x1234 \
+ -rreg te.fifo -estat [regbld rlink::STAT rberr] $esdmsk \
+ -wreg te.fifo 0x4321 \
+ -init te.cntl [regbld rbtest::INIT fifo] \
+ -rreg te.fifo -estat [regbld rlink::STAT rberr] $esdmsk \
+ -rreg te.cntl -edata [regbld rbtest::CNTL {stat 0x7}] \
+ -rreg te.data -edata 0x1234
+ #
+ #
+ rlc log " test 4b: verify fifo clear via nofifo flag in cntl"
+ # write a value; set and clear nofifo flag in cntl; ckeck fifo empty
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.fifo 0x4321 \
+ -wreg te.cntl [regbld rbtest::CNTL nofifo] \
+ -wreg te.cntl 0x0000 \
+ -rreg te.fifo -estat [regbld rlink::STAT rberr] $esdmsk
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 5: verify that nofifo causes a rbnak on fifo access"
+ # write fifo; set nofifo in cntl; write/read fifo(->rbnak);
+ # clr nofifo in cntl; read fifo(->rberr)
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.fifo 0x12ab \
+ -wreg te.cntl [regbld rbtest::CNTL nofifo] \
+ -wreg te.fifo 0x12cd -estat [regbld rlink::STAT rbnak] $esdmsk \
+ -rreg te.fifo -estat [regbld rlink::STAT rbnak] $esdmsk \
+ -wreg te.cntl 0x0000 \
+ -rreg te.fifo -estat [regbld rlink::STAT rberr] $esdmsk
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 6: test that te.attn returns # of cycles for te.fifo w&r"
+ foreach nbusy {0x03 0x07 0x0f 0x1f 0x00} {
+ set valc [regbld rbtest::CNTL [list nbusy $nbusy]]
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.cntl $valc \
+ -wreg te.fifo [expr {$nbusy | ( $nbusy << 8 ) }] \
+ -rreg te.attn -edata [expr {$nbusy + 1 }] \
+ -rreg te.fifo -edata [expr {$nbusy | ( $nbusy << 8 ) }] \
+ -rreg te.attn -edata [expr {$nbusy + 1 }]
+ }
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 7: verify escaping (all 256 byte codes transported)"
+ for {set i 0} {$i < 8} {incr i} {
+ set blk {}
+ for {set j 0} {$j < 16} {incr j} {
+ set bcode [expr {32 * $i + 2 * $j}]
+ lappend blk [expr {( $bcode << 8 ) | ( $bcode + 1 )}]
+ }
+ rlc exec -estatdef $esdval $esdmsk \
+ -wblk te.fifo $blk \
+ -rblk te.fifo [llength $blk] -edata $blk
+ }
+ #
+ # -------------------------------------------------------------------------
+ rlc log " test 8: verify stat command after te.data wblk & rblk"
+ set blk {0x1234 0x2345}
+ set rlist [rlc exec -rlist -estatdef $esdval $esdmsk \
+ -wblk te.fifo $blk \
+ -stat ]
+ #puts $rlist
+ #rlist like: {wblk 99 23 0} {stat 4 39 0 99 65279}
+ set xreg_ccode [lindex $rlist 0 1]
+ set stat_ccode [lindex $rlist 1 4]
+ if {$xreg_ccode != $stat_ccode} {
+ rlc log " ---- stat ccmd mismatch, d=[pbvi o8 $xreg_ccode]! D=[pbvi o8 $stat_ccode] FAIL"
+ incr errcnt
+ }
+ set rlist [rlc exec -rlist -estatdef $esdval $esdmsk \
+ -rblk te.fifo [llength $blk] -edata $blk \
+ -stat -edata 0x2345]
+ #puts $rlist
+ #{rblk 97 23 0 {4660 9029}} {stat 12 39 0 97 9029}
+ set xreg_ccode [lindex $rlist 0 1]
+ set stat_ccode [lindex $rlist 1 4]
+ if {$xreg_ccode != $stat_ccode} {
+ rlc log " ---- stat ccmd mismatch, d=[pbvi o8 $xreg_ccode]! D=[pbvi o8 $stat_ccode] FAIL"
+ incr errcnt
+ }
+ #
+ #-------------------------------------------------------------------------
+ rlc log "rbtest::test_fifo - cleanup: clear cntl, data, and fifo"
+ rlc exec -init te.cntl [regbld rbtest::INIT fifo data cntl]
+ #
+ incr errcnt [rlc errcnt -clear]
+ return $errcnt
+ }
+}
Index: rbtest/test_attn.tcl
===================================================================
--- rbtest/test_attn.tcl (nonexistent)
+++ rbtest/test_attn.tcl (revision 24)
@@ -0,0 +1,87 @@
+# $Id: test_attn.tcl 516 2013-05-05 21:24:52Z mueller $
+#
+# Copyright 2011-2013 by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2011-03-27 374 1.0 Initial version
+# 2011-03-20 372 0.1 First Draft
+#
+
+package provide rbtest 1.0
+
+package require rutiltpp
+package require rutil
+package require rlink
+
+namespace eval rbtest {
+ #
+ # Test with stat connectivity of the cntl register.
+ #
+ proc test_attn {{attnmsk 0x0}} {
+ # quit if nothing to do...
+ if {$attnmsk == 0} {return 0}
+ #
+ set esdval 0x00
+ set esdmsk [regbld rlink::STAT {stat -1} attn]
+ #
+ set apats {}
+ for {set i 0} {$i < 16} {incr i} {
+ set apat [expr {1 << $i}]
+ if {[expr {$apat & $attnmsk}]} {lappend apats $apat}
+ }
+ #
+ set errcnt 0
+ rlc errcnt -clear
+ #
+ rlc log "rbtest::test_attn - init: clear regs and attn flags"
+ rlc exec -init te.cntl [regbld rbtest::INIT cntl data fifo]
+ rlc exec -attn
+
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 1: verify connection of attn bits"
+ foreach apat $apats {
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.attn $apat \
+ -rreg te.attn -estat [regbld rlink::STAT attn] \
+ -attn -edata $apat \
+ -rreg te.attn -estat 0x0
+ }
+
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 2: verify that attn flags accumulate"
+ foreach apat $apats {
+ rlc exec -wreg te.attn $apat -estat $esdval $esdmsk
+ }
+ rlc exec -attn -edata $attnmsk -estat $esdval $esdmsk
+
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 3: verify that comma is send"
+ set apat [lindex $apats 0]
+ rlc exec -init 0xff [regbld rlink::INIT anena] -estat $esdval $esdmsk
+ rlc exec -wreg te.attn $apat -estat $esdval $esdmsk
+ rlc wtlam 1.
+ rlc exec -attn -edata $apat -estat $esdval $esdmsk
+
+ #
+ #-------------------------------------------------------------------------
+ rlc log "rbtest::test_attn - cleanup: clear regs and attn flags"
+ rlc exec -init te.cntl [regbld rbtest::INIT cntl data fifo]
+ rlc exec -attn
+ #
+ incr errcnt [rlc errcnt -clear]
+ return $errcnt
+ }
+}
Index: rbtest/test_data.tcl
===================================================================
--- rbtest/test_data.tcl (nonexistent)
+++ rbtest/test_data.tcl (revision 24)
@@ -0,0 +1,162 @@
+# $Id: test_data.tcl 516 2013-05-05 21:24:52Z mueller $
+#
+# Copyright 2011-2013 by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2011-03-27 374 1.0 Initial version
+# 2011-03-13 369 0.1 First Draft
+#
+
+package provide rbtest 1.0
+
+package require rutiltpp
+package require rutil
+package require rlink
+
+namespace eval rbtest {
+ #
+ # Basic tests with cntl and data registers.
+ # All tests depend only on rbd_tester logic alone and not on how the
+ # rbd_tester is embedded in the design (e.g. stat and attn connections)
+ #
+ proc test_data {} {
+ set esdval 0x00
+ set esdmsk [regbld rlink::STAT {stat -1}]
+ #
+ set errcnt 0
+ rlc errcnt -clear
+ #
+ rlc log "rbtest::test_data - init: clear cntl, data, and fifo"
+ # Note: fifo clear via init is tested later, used here 'speculatively'
+ rlc exec -init te.cntl [regbld rbtest::INIT fifo data cntl]
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 1a: cntl, data are write- and read-able"
+ foreach {addr valw valr} [list te.cntl 0xffff 0xf3ff \
+ te.cntl 0x0000 0x0000 \
+ te.data 0xffff 0xffff \
+ te.data 0x0000 0x0000 ] {
+ rlc exec -wreg $addr $valw -estat $esdval $esdmsk
+ rlc exec -rreg $addr -edata $valr -estat $esdval $esdmsk
+ }
+ #
+ #
+ rlc log " test 1b: as test 1a, now use clists and check cntl/data distinct"
+ foreach {valc vald} [list 0x0000 0x0000 [regbld rbtest::CNTL nofifo] 0xffff] {
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.cntl $valc \
+ -wreg te.data $vald \
+ -rreg te.cntl -edata $valc \
+ -rreg te.data -edata $vald
+ }
+ #
+ #
+ rlc log " test 1c: as test 1, now cntl.stat field is used"
+ foreach stat {0x1 0x3 0x7 0x0} {
+ set valc [regbld rbtest::CNTL [list stat $stat]]
+ set vald [expr {$stat | ( $stat << 8 ) }]
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.cntl $valc \
+ -wreg te.data $vald \
+ -rreg te.cntl -edata $valc \
+ -rreg te.data -edata $vald
+ }
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 2: cntl.nbusy is write- and readable (last nbusy=0 again)"
+ foreach nbusy {0x00f 0x0ff 0x3ff 0x000} {
+ set valc [regbld rbtest::CNTL [list nbusy $nbusy]]
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.cntl $valc \
+ -rreg te.cntl -edata $valc
+ }
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 3: verify that large nbusy causes timeout"
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.data 0xdead \
+ -rreg te.data -edata 0xdead \
+ -wreg te.cntl [regbld rbtest::CNTL {nbusy 0x3ff}] \
+ -wreg te.data 0xbeaf -estat [regbld rlink::STAT rbnak] $esdmsk \
+ -rreg te.data -estat [regbld rlink::STAT rbnak] $esdmsk \
+ -wreg te.cntl 0x0000 \
+ -rreg te.data -edata 0xdead -edata 0xdead
+ #
+ # -------------------------------------------------------------------------
+ rlc log " test 4a: verify that init 001 clears cntl and not data"
+ set valc [regbld rbtest::CNTL nofifo {stat 0x3}]
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.cntl $valc \
+ -wreg te.data 0x1234 \
+ -init te.cntl [regbld rbtest::INIT cntl] \
+ -rreg te.cntl -edata 0x0 \
+ -wreg te.data 0x1234
+ rlc log " test 4b: verify that init 010 clears data and not cntl"
+ set valc [regbld rbtest::CNTL {stat 0x7}]
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.cntl $valc \
+ -wreg te.data 0x4321 \
+ -init te.cntl [regbld rbtest::INIT data] \
+ -rreg te.cntl -edata $valc \
+ -wreg te.data 0x0
+ rlc log " test 4c: verify that init 011 clears data and cntl"
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.cntl [regbld rbtest::CNTL nofifo {stat 0x7} {nbusy 2}] \
+ -wreg te.data 0xabcd \
+ -init te.cntl [regbld rbtest::INIT data cntl] \
+ -rreg te.cntl -edata 0x0 \
+ -wreg te.data 0x0
+ #
+ # -------------------------------------------------------------------------
+ rlc log " test 5: test that te.attn returns # of cycles for te.data w&r"
+ foreach nbusy {0x03 0x07 0x0f 0x1f 0x00} {
+ set valc [regbld rbtest::CNTL [list nbusy $nbusy]]
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.cntl $valc \
+ -wreg te.data [expr {$nbusy | ( $nbusy << 8 ) }] \
+ -rreg te.attn -edata [expr {$nbusy + 1 }] \
+ -rreg te.data -edata [expr {$nbusy | ( $nbusy << 8 ) }] \
+ -rreg te.attn -edata [expr {$nbusy + 1 }]
+ }
+ #
+ # -------------------------------------------------------------------------
+ rlc log " test 6: verify stat command after te.data wreg & rreg"
+ set rlist [rlc exec -rlist -estatdef $esdval $esdmsk \
+ -wreg te.data 0x1234 \
+ -stat ]
+ #rlist like: {wreg 90 23 0} {stat 4 39 0 90 1}
+ set xreg_ccode [lindex $rlist 0 1]
+ set stat_ccode [lindex $rlist 1 4]
+ if {$xreg_ccode != $stat_ccode} {
+ rlc log " ---- stat ccmd mismatch, d=[pbvi o8 $xreg_ccode]! D=[pbvi o8 $stat_ccode] FAIL"
+ incr errcnt
+ }
+ set rlist [rlc exec -rlist -estatdef $esdval $esdmsk \
+ -rreg te.data -edata 0x1234 \
+ -stat -edata 0x1234]
+ #rlist like: {rreg 72 23 0 4660} {stat 12 39 0 72 4660}
+ set xreg_ccode [lindex $rlist 0 1]
+ set stat_ccode [lindex $rlist 1 4]
+ if {$xreg_ccode != $stat_ccode} {
+ rlc log " ---- stat ccmd mismatch, d=[pbvi o8 $xreg_ccode]! D=[pbvi o8 $stat_ccode] FAIL"
+ incr errcnt
+ }
+ #
+ #-------------------------------------------------------------------------
+ rlc log "rbtest::test_data - cleanup: clear cntl and data"
+ rlc exec -init te.cntl [regbld rbtest::INIT data cntl]
+ #
+ incr errcnt [rlc errcnt -clear]
+ return $errcnt
+ }
+}
Index: rbtest/test_stat.tcl
===================================================================
--- rbtest/test_stat.tcl (nonexistent)
+++ rbtest/test_stat.tcl (revision 24)
@@ -0,0 +1,61 @@
+# $Id: test_stat.tcl 516 2013-05-05 21:24:52Z mueller $
+#
+# Copyright 2011-2013 by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2011-03-27 374 1.0 Initial version
+# 2011-03-20 372 0.1 First Draft
+#
+
+package provide rbtest 1.0
+
+package require rutiltpp
+package require rutil
+package require rlink
+
+namespace eval rbtest {
+ #
+ # Test with stat connectivity of the cntl register.
+ #
+ proc test_stat {{statmsk 0x0}} {
+ # quit if nothing to do...
+ if {$statmsk == 0} {return 0}
+
+ #
+ set errcnt 0
+ rlc errcnt -clear
+ #
+ rlc log "rbtest::test_stat - init: clear cntl"
+ rlc exec -init te.cntl [regbld rbtest::INIT cntl]
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 1: verify connection of cntl stat bits to stat return"
+ for {set i 0} {$i < 3} {incr i} {
+ set spat [expr {1 << $i}]
+ if {[expr {$spat & $statmsk}]} {
+ set cntl [regbld rbtest::CNTL [list stat $spat]]
+ rlc exec \
+ -wreg te.cntl $cntl \
+ -rreg te.cntl -edata $cntl \
+ -estat [regbld rlink::STAT [list stat $spat]]
+ }
+ }
+ #
+ #-------------------------------------------------------------------------
+ rlc log "rbtest::test_stat - cleanup: clear cntl"
+ rlc exec -init te.cntl [regbld rbtest::INIT cntl]
+ #
+ incr errcnt [rlc errcnt -clear]
+ return $errcnt
+ }
+}
Index: rbtest/util.tcl
===================================================================
--- rbtest/util.tcl (nonexistent)
+++ rbtest/util.tcl (revision 24)
@@ -0,0 +1,165 @@
+# $Id: util.tcl 516 2013-05-05 21:24:52Z mueller $
+#
+# Copyright 2011-2013 by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2011-03-27 374 1.0 Initial version
+# 2011-03-13 369 0.1 Frist draft
+#
+
+package provide rbtest 1.0
+
+package require rutiltpp
+package require rutil
+package require rlink
+
+namespace eval rbtest {
+ #
+ # setup register descriptions for rbd_tester
+ #
+ regdsc CNTL {nofifo 15} {stat 14 3} {nbusy 9 10}
+ regdsc INIT {fifo 2} {data 1} {cntl 0}
+ #
+ # setup: amap definitions for rbd_tester
+ #
+ proc setup {{base 0x00f0}} {
+ rlc amap -insert te.cntl [expr {$base + 0x00}]
+ rlc amap -insert te.data [expr {$base + 0x01}]
+ rlc amap -insert te.fifo [expr {$base + 0x02}]
+ rlc amap -insert te.attn [expr {$base + 0x03}]
+ }
+ #
+ # init: reset rbd_tester (clear via init)
+ #
+ proc init {} {
+ rlc exec -init te.cntl [regbld rbtest::INIT fifo data cntl]
+ }
+ #
+ # nbusymax: returns maximal nbusy value not causing timeout
+ #
+ proc nbusymax {} {
+ set esdmsk [regbld rlink::STAT {stat -1} attn]
+ rlc exec -estatdef 0 $esdmsk \
+ -rreg te.cntl sav_cntl \
+ -wreg te.cntl [regbld rbtest::CNTL {nbusy -1}] \
+ -rreg te.data -estat [regbld rlink::STAT rbnak] $esdmsk \
+ -rreg te.attn ncyc
+ rlc exec -estatdef 0 $esdmsk \
+ -wreg te.cntl $sav_cntl
+ return [expr {$ncyc - 1}]
+ }
+ #
+ # probe: determine rbd_tester environment (max nbusy, stat and attn wiring)
+ #
+ proc probe {} {
+ set esdval 0x00
+ set esdmsk [regbld rlink::STAT {stat -1}]
+ set esdmsknak [regbld rlink::STAT {stat -1} rbnak]
+ set esdmskatt [regbld rlink::STAT {stat -1} attn]
+ set rbusy {}
+ set rstat {}
+ set rattn {}
+ #
+ # probe max nbusy for write and read
+ #
+ set wrerr {}
+ set rderr {}
+ for {set i 3} { $i < 8 } {incr i} {
+ set nbusy0 [expr {( 1 << $i )}]
+ for {set j -1} { $j <= 1 } {incr j} {
+ set nbusy [expr {$nbusy0 + $j}]
+ set valc [regbld rbtest::CNTL [list nbusy $nbusy]]
+ rlc exec \
+ -wreg te.cntl $valc -estat $esdval $esdmsk\
+ -wreg te.data 0x0000 statwr -estat $esdval $esdmsknak \
+ -rreg te.data dummy statrd -estat $esdval $esdmsknak
+ if {[llength $wrerr] == 0 && [regget rlink::STAT(rbnak) $statwr] != 0} {
+ lappend wrerr $i $j $nbusy
+ }
+ if {[llength $rderr] == 0 && [regget rlink::STAT(rbnak) $statrd] != 0} {
+ lappend rderr $i $j $nbusy
+ }
+ }
+ }
+ rlc exec -init te.cntl [regbld rbtest::INIT fifo data cntl]
+ lappend rbusy $wrerr $rderr
+ #
+ # probe stat wiring
+ #
+ for {set i 0} { $i < 3 } {incr i} {
+ set valc [regbld rbtest::CNTL [list stat [expr {1 << $i}]]]
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.cntl $valc \
+ -rreg te.data dummy statrd
+ lappend rstat [list $i [regget rlink::STAT(stat) $statrd]]
+ }
+ rlc exec -init te.cntl [regbld rbtest::INIT fifo data cntl]
+ #
+ # probe attn wiring
+ #
+ rlc exec -attn
+ for {set i 0} { $i < 16 } {incr i} {
+ rlc exec -estatdef $esdval $esdmskatt \
+ -wreg te.attn [expr {1 << $i}] \
+ -attn attnpat
+ lappend rattn [list $i $attnpat]
+ }
+ rlc exec -attn
+ #
+ return [list $rbusy $rstat $rattn]
+ }
+ #
+ # probe_print: print probe results
+ #
+ proc probe_print {{plist {}}} {
+ set rval {}
+
+ if {[llength $plist] == 0} {
+ set plist [probe]
+ }
+
+ set rbusy [lindex $plist 0]
+ set rstat [lindex $plist 1]
+ set rattn [lindex $plist 2]
+ #
+ append rval \
+ "nbusy: write max [lindex $rbusy 0 2] --> WIDTH=[lindex $rbusy 0 0]"
+ append rval \
+ "\nnbusy: read max [lindex $rbusy 1 2] --> WIDTH=[lindex $rbusy 1 0]"
+ #
+ for {set i 0} { $i < 3 } {incr i} {
+ set rcvpat [lindex $rstat $i 1]
+ set rcvind [print_bitind $rcvpat]
+ append rval [format "\nstat: te.cntl line %2d --> design %2d %s" \
+ $i $rcvind [pbvi b3 $rcvpat]]
+ }
+ #
+ for {set i 0} { $i < 16 } {incr i} {
+ set rcvpat [lindex $rattn $i 1]
+ set rcvind [print_bitind $rcvpat]
+ append rval [format "\nattn: te.attn line %2d --> design %2d %s" \
+ $i $rcvind [pbvi b16 $rcvpat]]
+ }
+ return $rval
+ }
+
+ #
+ # print_bitind: helper for probe_print:
+ #
+ proc print_bitind {pat} {
+ for {set i 0} { $i < 16 } {incr i} {
+ if {[expr {$pat & [expr {1 << $i}] }] } { return $i}
+ }
+ return -1
+ }
+}
Index: rbtest/test_all.tcl
===================================================================
--- rbtest/test_all.tcl (nonexistent)
+++ rbtest/test_all.tcl (revision 24)
@@ -0,0 +1,35 @@
+# $Id: test_all.tcl 375 2011-04-02 07:56:47Z mueller $
+#
+# Copyright 2011- by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2011-03-27 374 1.0 Initial version
+# 2011-03-13 369 0.1 First draft
+#
+
+package provide rbtest 1.0
+
+namespace eval rbtest {
+ #
+ # Driver for all rbtest tests
+ #
+ proc test_all {{statmsk 0x0} {attnmsk 0x0}} {
+ #
+ set errcnt 0
+ incr errcnt [rbtest::test_data]
+ incr errcnt [rbtest::test_fifo]
+ incr errcnt [rbtest::test_stat $statmsk]
+ incr errcnt [rbtest::test_attn $attnmsk]
+ return $errcnt
+ }
+}
Index: rbtest/.cvsignore
===================================================================
--- rbtest/.cvsignore (nonexistent)
+++ rbtest/.cvsignore (revision 24)
@@ -0,0 +1 @@
+pkgIndex.tcl
Index: rbtest
===================================================================
--- rbtest (nonexistent)
+++ rbtest (revision 24)
rbtest
Property changes :
Added: svn:ignore
## -0,0 +1,33 ##
+*.dep_ghdl
+*.dep_isim
+*.dep_xst
+work-obj93.cf
+*.vcd
+*.ghw
+*.sav
+*.tmp
+*.exe
+ise
+xflow.his
+*.ngc
+*.ncd
+*.pcf
+*.bit
+*.msk
+isim
+isim.log
+isim.wdb
+fuse.log
+*_[sft]sim.vhd
+*_tsim.sdf
+*_xst.log
+*_tra.log
+*_twr.log
+*_map.log
+*_par.log
+*_pad.log
+*_bgn.log
+*_svn.log
+*_sum.log
+*_[dsft]sim.log
+pkgIndex.tcl
Index: rbbram/perf.tcl
===================================================================
--- rbbram/perf.tcl (nonexistent)
+++ rbbram/perf.tcl (revision 24)
@@ -0,0 +1,162 @@
+# $Id: perf.tcl 516 2013-05-05 21:24:52Z mueller $
+#
+# Copyright 2011-2013 by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2013-01-04 469 1.0.2 perf_blk: add optional 2nd arg: trace
+# 2012-12-27 465 1.0.1 adopt format, cover small ms and large kb
+# 2011-04-17 376 1.0 Initial version
+#
+
+package provide rbbram 1.0
+
+namespace eval rbbram {
+ #
+ # perf_blk: determine wblk/rblk write performance
+ #
+ proc perf_blk {{tmax 1000} {trace 0}} {
+ if {$tmax < 1} { error "-E: perf_blk: tmax argument must be >= 1" }
+
+ set amax [regget rbbram::CNTL(addr) -1]
+ set rval \
+"nblk 1 wblk | 2 wblk | 4 wblk | 1 rblk | 2 rblk | 4 rblk "
+ append rval \
+"\n ms/r kB/s ms/r kB/s ms/r kB/s ms/r kB/s ms/r kB/s ms/r kB/s"
+
+ foreach nblk {1 2 4 8 16 32 64 128 256} {
+ set wbuf0 {}
+ set wbuf1 {}
+ set wbuf2 {}
+ set wbuf3 {}
+ for {set i 0} {$i < $nblk} {incr i} {
+ lappend wbuf0 $i
+ lappend wbuf1 [expr {0x1000 + $i}]
+ lappend wbuf2 [expr {0x2000 + $i}]
+ lappend wbuf3 [expr {0x3000 + $i}]
+ }
+
+ set pval {}
+
+ # single wblk
+ if {$trace} { puts "1 wblk for $nblk" }
+ set tbeg [clock clicks -milliseconds]
+ set addr 0x0000
+ for {set i 1} {1} {incr i} {
+ rlc exec \
+ -wreg br.cntl $addr \
+ -wblk br.data $wbuf0
+ set trun [expr {[clock clicks -milliseconds] - $tbeg}]
+ if {$trun > $tmax} { break }
+ set addr [expr {( $addr + $nblk ) & $amax}]
+ }
+ lappend pval 1 $i $trun
+
+ # double wblk
+ if {$trace} { puts "2 wblk for $nblk" }
+ set tbeg [clock clicks -milliseconds]
+ set addr 0x0000
+ for {set i 1} {1} {incr i} {
+ rlc exec \
+ -wreg br.cntl $addr \
+ -wblk br.data $wbuf0 \
+ -wblk br.data $wbuf1
+ set trun [expr {[clock clicks -milliseconds] - $tbeg}]
+ if {$trun > $tmax} { break }
+ set addr [expr {( $addr + 2 * $nblk ) & $amax}]
+ }
+ lappend pval 2 $i $trun
+
+ # quad wblk
+ if {$trace} { puts "4 wblk for $nblk" }
+ set tbeg [clock clicks -milliseconds]
+ set addr 0x0000
+ for {set i 1} {1} {incr i} {
+ rlc exec \
+ -wreg br.cntl $addr \
+ -wblk br.data $wbuf0 \
+ -wblk br.data $wbuf1 \
+ -wblk br.data $wbuf2 \
+ -wblk br.data $wbuf3
+ set trun [expr {[clock clicks -milliseconds] - $tbeg}]
+ if {$trun > $tmax} { break }
+ set addr [expr {( $addr + 4 * $nblk ) & $amax}]
+ }
+ lappend pval 4 $i $trun
+
+ # single rblk
+ if {$trace} { puts "1 rblk for $nblk" }
+ set tbeg [clock clicks -milliseconds]
+ set addr 0x0000
+ for {set i 1} {1} {incr i} {
+ rlc exec \
+ -wreg br.cntl $addr \
+ -rblk br.data $nblk rbuf0
+ set trun [expr {[clock clicks -milliseconds] - $tbeg}]
+ if {$trun > $tmax} { break }
+ set addr [expr {( $addr + $nblk ) & $amax}]
+ }
+ lappend pval 1 $i $trun
+
+ # double rblk
+ if {$trace} { puts "2 rblk for $nblk" }
+ set tbeg [clock clicks -milliseconds]
+ set addr 0x0000
+ for {set i 1} {1} {incr i} {
+ rlc exec \
+ -wreg br.cntl $addr \
+ -rblk br.data $nblk rbuf0 \
+ -rblk br.data $nblk rbuf1
+ set trun [expr {[clock clicks -milliseconds] - $tbeg}]
+ if {$trun > $tmax} { break }
+ set addr [expr {( $addr + 2 * $nblk ) & $amax}]
+ }
+ lappend pval 2 $i $trun
+
+ # quad rblk
+ if {$trace} { puts "4 rblk for $nblk" }
+ set tbeg [clock clicks -milliseconds]
+ set addr 0x0000
+ for {set i 1} {1} {incr i} {
+ rlc exec \
+ -wreg br.cntl $addr \
+ -rblk br.data $nblk rbuf0 \
+ -rblk br.data $nblk rbuf1 \
+ -rblk br.data $nblk rbuf2 \
+ -rblk br.data $nblk rbuf3
+ set trun [expr {[clock clicks -milliseconds] - $tbeg}]
+ if {$trun > $tmax} { break }
+ set addr [expr {( $addr + 4 * $nblk ) & $amax}]
+ }
+ lappend pval 4 $i $trun
+
+ set oline [format "\n%4d" $nblk]
+ foreach {nr i trun} $pval {
+ set ms [expr {double($trun) / double($nr*$i)}]
+ set kb [expr {double(2*$nr*$i*$nblk) / double($trun)}]
+ if { $ms < 9.94 } {
+ append oline [format " %5.2f" $ms]
+ } else {
+ append oline [format " %5.1f" $ms]
+ }
+ if { $kb > 999.9 } {
+ append oline [format " %5.0f" $kb]
+ } else {
+ append oline [format " %5.1f" $kb]
+ }
+ }
+
+ append rval $oline
+ }
+ return $rval
+ }
+}
Index: rbbram/util.tcl
===================================================================
--- rbbram/util.tcl (nonexistent)
+++ rbbram/util.tcl (revision 24)
@@ -0,0 +1,39 @@
+# $Id: util.tcl 516 2013-05-05 21:24:52Z mueller $
+#
+# Copyright 2011-2013 by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2011-03-19 372 1.0 Initial version
+#
+
+package provide rbbram 1.0
+
+namespace eval rbbram {
+ #
+ # setup register descriptions for rbd_bram
+ #
+ regdsc CNTL {nbusy 15 6} {addr 9 10}
+ #
+ # setup: amap definitions for rbd_bram
+ #
+ proc setup {{base 0x00f4}} {
+ rlc amap -insert br.cntl [expr {$base + 0x00}]
+ rlc amap -insert br.data [expr {$base + 0x01}]
+ }
+ #
+ # init: reset rbd_bram (clear cntl register)
+ #
+ proc init {} {
+ rlc exec -wreg br.cntl 0x0000
+ }
+}
Index: rbbram/.cvsignore
===================================================================
--- rbbram/.cvsignore (nonexistent)
+++ rbbram/.cvsignore (revision 24)
@@ -0,0 +1 @@
+pkgIndex.tcl
Index: rbbram
===================================================================
--- rbbram (nonexistent)
+++ rbbram (revision 24)
rbbram
Property changes :
Added: svn:ignore
## -0,0 +1,33 ##
+*.dep_ghdl
+*.dep_isim
+*.dep_xst
+work-obj93.cf
+*.vcd
+*.ghw
+*.sav
+*.tmp
+*.exe
+ise
+xflow.his
+*.ngc
+*.ncd
+*.pcf
+*.bit
+*.msk
+isim
+isim.log
+isim.wdb
+fuse.log
+*_[sft]sim.vhd
+*_tsim.sdf
+*_xst.log
+*_tra.log
+*_twr.log
+*_map.log
+*_par.log
+*_pad.log
+*_bgn.log
+*_svn.log
+*_sum.log
+*_[dsft]sim.log
+pkgIndex.tcl
Index: rbmoni/test_rbtest.tcl
===================================================================
--- rbmoni/test_rbtest.tcl (nonexistent)
+++ rbmoni/test_rbtest.tcl (revision 24)
@@ -0,0 +1,306 @@
+# $Id: test_rbtest.tcl 516 2013-05-05 21:24:52Z mueller $
+#
+# Copyright 2011-2013 by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2011-03-27 374 1.0 Initial version
+# 2011-03-13 369 0.1 First Draft
+#
+
+package provide rbmoni 1.0
+
+package require rutiltpp
+package require rutil
+package require rlink
+package require rbtest
+
+namespace eval rbmoni {
+ #
+ # Basic tests with rbtester registers
+ #
+ proc test_rbtest {{print 0}} {
+ set esdval 0x00
+ set esdmsk [regbld rlink::STAT {stat -1}]
+ #
+ set errcnt 0
+ rlc errcnt -clear
+ #
+ rlc log "rbmoni::test_rbtest - init"
+ rbmoni::init
+ rbtest::init
+ #
+ set atecntl [rlc amap te.cntl]
+ set atedata [rlc amap te.data]
+ set atefifo [rlc amap te.fifo]
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 1: exercise monitor data access via data/addr regs"
+
+ set vtecntl [regbld rbtest::CNTL {stat -1}]
+ set vtedata 0x1234
+
+ # setup te.cntl and te.data
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.cntl $vtecntl \
+ -wreg te.data $vtedata
+
+ # read te.cntl and te.data with rbmoni on; check that 2 lines aquired
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg rm.cntl [regbld rbmoni::CNTL go] \
+ -rreg te.cntl -edata $vtecntl \
+ -rreg te.data -edata $vtedata \
+ -wreg rm.cntl 0x0 \
+ -rreg rm.addr -edata [regbld rbmoni::ADDR {laddr 2}]
+
+ # build expect list: list of {eflag eaddr edata enbusy} sublists
+ raw_edata edat emsk \
+ [list [regbld rbmoni::FLAGS ack] $atecntl $vtecntl 0] \
+ [list [regbld rbmoni::FLAGS ack] $atedata $vtedata 0]
+
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 1a: read all in one rblk"
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg rm.addr 0x0000 \
+ -rblk rm.data 8 -edata $edat $emsk \
+ -rreg rm.addr -edata 0x8
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 1b: random address with rreg"
+ foreach addr {0x1 0x3 0x5 0x7 0x6 0x4 0x2 0x0} {
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg rm.addr $addr \
+ -rreg rm.data -edata [lindex $edat $addr] [lindex $emsk $addr] \
+ -rreg rm.addr -edata [expr {$addr + 1}]
+ }
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 1c: random address with rblk length 2"
+ foreach addr {0x1 0x3 0x5 0x6 0x4 0x2 0x0} {
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg rm.addr $addr \
+ -rblk rm.data 2 -edata [lrange $edat $addr [expr {$addr + 1}] ] \
+ [lrange $emsk $addr [expr {$addr + 1}] ] \
+ -rreg rm.addr -edata [expr {$addr + 2}]
+ }
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 2a: test rreg,wreg capture (ncyc=0); ack, we flags"
+ set vtedata 0x4321
+ # build expect list: list of {eflag eaddr edata enbusy} sublists
+ raw_edata edat emsk \
+ [list [regbld rbmoni::FLAGS ack we] $atedata $vtedata 0] \
+ [list [regbld rbmoni::FLAGS ack ] $atedata $vtedata 0]
+ #
+ rbmoni::start
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.data $vtedata \
+ -rreg te.data -edata $vtedata
+ rbmoni::stop
+ if {$print} {puts [print]}
+ raw_check $edat $emsk
+
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 2b: test rreg,wreg capture (ncyc=1,4); busy flag and nbusy"
+ set nbusy_1 [regbld rbtest::CNTL {nbusy 1}]
+ set nbusy_4 [regbld rbtest::CNTL {nbusy 4}]
+ set vtedata 0xbeaf
+ # build expect list: list of {eflag eaddr edata enbusy} sublists
+ raw_edata edat emsk \
+ [list [regbld rbmoni::FLAGS ack we] $atecntl $nbusy_1 0] \
+ [list [regbld rbmoni::FLAGS ack busy we] $atedata $vtedata 1] \
+ [list [regbld rbmoni::FLAGS ack we] $atecntl $nbusy_4 0] \
+ [list [regbld rbmoni::FLAGS ack busy ] $atedata $vtedata 4] \
+ [list [regbld rbmoni::FLAGS ack we] $atecntl 0 0]
+ #
+ rbmoni::start
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.cntl $nbusy_1 \
+ -wreg te.data $vtedata \
+ -wreg te.cntl $nbusy_4 \
+ -rreg te.data -edata $vtedata \
+ -wreg te.cntl 0
+ rbmoni::stop
+ if {$print} {puts [print]}
+ raw_check $edat $emsk
+
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 2c: test rreg,wreg capture (timeout); busy,tout flag"
+ set vtecntl [regbld rbtest::CNTL {nbusy -1}]
+ set vtedata 0xdead
+ set nmax [rbtest::nbusymax]
+ # build expect list: list of {eflag eaddr edata enbusy} sublists
+ raw_edata edat emsk \
+ [list [regbld rbmoni::FLAGS ack we] $atecntl $vtecntl 0] \
+ [list [regbld rbmoni::FLAGS ack busy tout we] $atedata $vtedata $nmax] \
+ [list [regbld rbmoni::FLAGS ack busy tout ] $atedata 0x5555 $nmax] \
+ [list [regbld rbmoni::FLAGS ack we] $atecntl 0 0]
+ #
+ rbmoni::start
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.cntl $vtecntl \
+ -wreg te.data $vtedata -estat [regbld rlink::STAT rbnak] \
+ -rreg te.data -edata 0x5555 -estat [regbld rlink::STAT rbnak] \
+ -wreg te.cntl 0
+ rbmoni::stop
+ if {$print} {puts [print]}
+ raw_check $edat $emsk
+
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 2d: test rreg,wreg capture (prompt nak); nak flag"
+ set vtecntl [regbld rbtest::CNTL nofifo]
+ set vtefifo 0xdead
+ # build expect list: list of {eflag eaddr edata enbusy} sublists
+ raw_edata edat emsk \
+ [list [regbld rbmoni::FLAGS ack we] $atecntl $vtecntl 0] \
+ [list [regbld rbmoni::FLAGS nak we] $atefifo $vtefifo 0] \
+ [list [regbld rbmoni::FLAGS nak ] $atefifo {} 0] \
+ [list [regbld rbmoni::FLAGS ack we] $atecntl 0 0]
+ #
+ rbmoni::start
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.cntl $vtecntl \
+ -wreg te.fifo $vtefifo -estat [regbld rlink::STAT rbnak] \
+ -rreg te.fifo -estat [regbld rlink::STAT rbnak] \
+ -wreg te.cntl 0
+ rbmoni::stop
+ if {$print} {puts [print]}
+ raw_check $edat $emsk
+
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 2e: test rreg,wreg capture (delayed nak); nak flag"
+ set vtecntl [regbld rbtest::CNTL nofifo {nbusy 7}]
+ set vtefifo 0xdead
+ # build expect list: list of {eflag eaddr edata enbusy} sublists
+ raw_edata edat emsk \
+ [list [regbld rbmoni::FLAGS ack we] $atecntl $vtecntl 0] \
+ [list [regbld rbmoni::FLAGS ack busy nak we] $atefifo $vtefifo 7] \
+ [list [regbld rbmoni::FLAGS ack busy nak ] $atefifo {} 7] \
+ [list [regbld rbmoni::FLAGS ack we] $atecntl 0 0]
+ #
+ rbmoni::start
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.cntl $vtecntl \
+ -wreg te.fifo $vtefifo -estat [regbld rlink::STAT rbnak] \
+ -rreg te.fifo -estat [regbld rlink::STAT rbnak] \
+ -wreg te.cntl 0
+ rbmoni::stop
+ if {$print} {puts [print]}
+ raw_check $edat $emsk
+
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 2f: test rreg,wreg capture (prompt rbus err); err flag"
+ set vtefifo 0x1357
+ # build expect list: list of {eflag eaddr edata enbusy} sublists
+ raw_edata edat emsk \
+ [list [regbld rbmoni::FLAGS ack we] $atefifo $vtefifo 0] \
+ [list [regbld rbmoni::FLAGS ack ] $atefifo $vtefifo 0] \
+ [list [regbld rbmoni::FLAGS ack err ] $atefifo {} 0]
+ #
+ rbmoni::start
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.fifo $vtefifo \
+ -rreg te.fifo -edata $vtefifo \
+ -rreg te.fifo -estat [regbld rlink::STAT rberr]
+ rbmoni::stop
+ if {$print} {puts [print]}
+ raw_check $edat $emsk
+
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 2g: test rreg,wreg capture (delayed rbus err); err flag"
+ set vtecntl [regbld rbtest::CNTL {nbusy 5}]
+ set vtefifo 0x1357
+ # build expect list: list of {eflag eaddr edata enbusy} sublists
+ raw_edata edat emsk \
+ [list [regbld rbmoni::FLAGS ack we] $atecntl $vtecntl 0] \
+ [list [regbld rbmoni::FLAGS ack busy we] $atefifo $vtefifo 5] \
+ [list [regbld rbmoni::FLAGS ack busy ] $atefifo $vtefifo 5] \
+ [list [regbld rbmoni::FLAGS ack busy err ] $atefifo {} 5] \
+ [list [regbld rbmoni::FLAGS ack we] $atecntl 0 0]
+ #
+ rbmoni::start
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.cntl $vtecntl \
+ -wreg te.fifo $vtefifo \
+ -rreg te.fifo -edata $vtefifo \
+ -rreg te.fifo -estat [regbld rlink::STAT rberr] \
+ -wreg te.cntl 0x0
+ rbmoni::stop
+ if {$print} {puts [print]}
+ raw_check $edat $emsk
+
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 3: test init capture; init flag"
+ set vtecntl [regbld rbtest::CNTL {nofifo}]
+ set vteinit [regbld rbtest::INIT {cntl}]
+ # build expect list: list of {eflag eaddr edata enbusy} sublists
+ raw_edata edat emsk \
+ [list [regbld rbmoni::FLAGS ack we ] $atecntl $vtecntl 0] \
+ [list [regbld rbmoni::FLAGS nak init we] $atecntl $vteinit 0] \
+ [list [regbld rbmoni::FLAGS ack ] $atecntl 0 0]
+ #
+ rbmoni::start
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg te.cntl $vtecntl \
+ -init te.cntl $vteinit \
+ -rreg te.cntl -edata 0
+ rbmoni::stop
+ if {$print} {puts [print]}
+ raw_check $edat $emsk
+
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 4: test rblk,wblk capture (ncyc=2 on read)"
+ set vteinit [regbld rbtest::INIT cntl fifo]
+ set nbusy_2 [regbld rbtest::CNTL {nbusy 2}]
+ set vtefifo {0xdead 0xbeaf 0x4711}
+ # build expect list: list of {eflag eaddr edata enbusy} sublists
+ raw_edata edat emsk \
+ [list [regbld rbmoni::FLAGS nak init we] $atecntl $vteinit 0] \
+ [list [regbld rbmoni::FLAGS ack we] $atefifo 0xdead 0] \
+ [list [regbld rbmoni::FLAGS ack we] $atefifo 0xbeaf 0] \
+ [list [regbld rbmoni::FLAGS ack we] $atefifo 0x4711 0] \
+ [list [regbld rbmoni::FLAGS ack we] $atecntl $nbusy_2 0] \
+ [list [regbld rbmoni::FLAGS ack busy ] $atefifo 0xdead 2] \
+ [list [regbld rbmoni::FLAGS ack busy ] $atefifo 0xbeaf 2] \
+ [list [regbld rbmoni::FLAGS ack busy ] $atefifo 0x4711 2] \
+ [list [regbld rbmoni::FLAGS nak init we] $atecntl $vteinit 0]
+ #
+ rbmoni::start
+ rlc exec -estatdef $esdval $esdmsk \
+ -init te.cntl $vteinit \
+ -wblk te.fifo $vtefifo \
+ -wreg te.cntl $nbusy_2 \
+ -rblk te.fifo [llength $vtefifo] -edata $vtefifo \
+ -init te.cntl $vteinit
+ rbmoni::stop
+ if {$print} {puts [print]}
+ raw_check $edat $emsk
+
+ #
+ #-------------------------------------------------------------------------
+ rlc log "rbmoni::test_rbtest - cleanup:"
+ rbtest::init
+ rbmoni::init
+ #
+ incr errcnt [rlc errcnt -clear]
+ return $errcnt
+ }
+}
Index: rbmoni/util.tcl
===================================================================
--- rbmoni/util.tcl (nonexistent)
+++ rbmoni/util.tcl (revision 24)
@@ -0,0 +1,205 @@
+# $Id: util.tcl 516 2013-05-05 21:24:52Z mueller $
+#
+# Copyright 2011-2013 by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2011-03-27 374 1.0 Initial version
+# 2011-03-13 369 0.1 First draft
+#
+
+package provide rbmoni 1.0
+
+package require rutil
+package require rlink
+
+namespace eval rbmoni {
+ #
+ # setup register descriptions for rbd_rbmon
+ #
+ regdsc CNTL {go 0}
+ regdsc ALIM {hilim 15 8} {lolim 7 8}
+ regdsc ADDR {wrap 15} {addr 10 11 "-"} {laddr 10 9} {waddr 1 2}
+ #
+ regdsc DAT3 {flags 15 8 "-"} {ack 15} {busy 14} {err 13} {nak 12} {tout 11} \
+ {init 9} {we 8} {addr 7 8}
+ regdsc DAT0 {ndlymsb 15 4} {nbusy 11 12}
+ #
+ # 'pseudo register', describes 1st word in return list element of rbmoni::read
+ # must have same bit sequence as DAT3(flags)
+ regdsc FLAGS {ack 7} {busy 6} {err 5} {nak 4} {tout 3} {init 1} {we 0}
+ #
+ # setup: amap definitions for rbd_rbmon
+ #
+ proc setup {{base 0x00fc}} {
+ rlc amap -insert rm.cntl [expr {$base + 0x00}]
+ rlc amap -insert rm.alim [expr {$base + 0x01}]
+ rlc amap -insert rm.addr [expr {$base + 0x02}]
+ rlc amap -insert rm.data [expr {$base + 0x03}]
+ }
+ #
+ # init: reset rbd_rbmon (stop, reset alim)
+ #
+ proc init {} {
+ rlc exec \
+ -wreg rm.cntl 0x0000 \
+ -wreg rm.alim [regbld rbmoni::ALIM {hilim 0xff} {lolim 0x00}] \
+ -wreg rm.addr 0x0000
+ }
+ #
+ # start: start the rbmon
+ #
+ proc start {} {
+ rlc exec -wreg rm.cntl [regbld rbmoni::CNTL go]
+ }
+ #
+ # stop: stop the rbmon
+ #
+ proc stop {} {
+ rlc exec -wreg rm.cntl 0x0000
+ }
+ #
+ # read: read nent last entries (by default all)
+ #
+ proc read {{nent -1}} {
+ set amax [regget rbmoni::ADDR(laddr) -1]
+ if {$nent == -1} { set nent $amax }
+
+ rlc exec -rreg rm.addr raddr
+
+ set laddr [regget rbmoni::ADDR(laddr) $raddr]
+ set nval $laddr
+ if {[regget rbmoni::ADDR(wrap) $raddr]} { set nval $amax }
+
+ if {$nent > $nval} {set nent $nval}
+ if {$nent == 0} { return {} }
+
+ set caddr [expr {( $laddr - $nent ) & $amax}]
+ rlc exec -wreg rm.addr [regbld rbmoni::ADDR [list laddr $caddr]]
+
+ set rval {}
+
+ while {$nent > 0} {
+ set nblk [expr {$nent << 2}]
+ if {$nblk > 256} {set nblk 256}
+ rlc exec -rblk rm.data $nblk rawdat
+
+ foreach {d0 d1 d2 d3} $rawdat {
+ set eflag [regget rbmoni::DAT3(flags) $d3]
+ set eaddr [regget rbmoni::DAT3(addr) $d3]
+ set edly [expr {( [regget rbmoni::DAT0(ndlymsb) $d0] << 16 ) | $d1 }]
+ set enbusy [regget rbmoni::DAT0(nbusy) $d0]
+ lappend rval [list $eflag $eaddr $d2 $edly $enbusy]
+ }
+
+ set nent [expr {$nent - ( $nblk >> 2 ) }]
+ }
+
+ rlc exec -wreg rm.addr $raddr
+
+ return $rval
+ }
+ #
+ # print: print rbmon data (optionally also read them)
+ #
+ proc print {{mondat -1}} {
+
+ if {[llength $mondat] == 1} {
+ set ele [lindex $mondat 0]
+ if {[llength $ele] == 1} {
+ set nent [lindex $ele 0]
+ set mondat [read $nent]
+ }
+ }
+
+ set rval {}
+
+ set eind [expr {1 - [llength $mondat] }]
+ append rval " ind addr data delay nbusy ac bs er na to in we"
+
+ foreach {ele} $mondat {
+ foreach {eflag eaddr edata edly enbusy} $ele { break }
+ set fack [regget rbmoni::FLAGS(ack) $eflag]
+ set fbsy [regget rbmoni::FLAGS(busy) $eflag]
+ set ferr [regget rbmoni::FLAGS(err) $eflag]
+ set fnak [regget rbmoni::FLAGS(nak) $eflag]
+ set fto [regget rbmoni::FLAGS(tout) $eflag]
+ set fini [regget rbmoni::FLAGS(init) $eflag]
+ set fwe [regget rbmoni::FLAGS(we) $eflag]
+ set ename ""
+ set comment ""
+ if {$ferr} {append comment " err=1!"}
+ if {$fini} {
+ append comment " init"
+ } else {
+ if {$fnak} {append comment " nak=1!"}
+ }
+ if {$fto} {append comment " tout=1!"}
+ if {[rlc amap -testaddr $eaddr]} {set ename [rlc amap -name $eaddr]}
+ append rval [format \
+ "\n%4d %-10s %4.4x %6d %4d %2.2x %d %d %d %d %d %d %d %s" \
+ $eind $ename $edata $edly $enbusy $eflag \
+ $fack $fbsy $ferr $fnak $fto $fini $fwe $comment]
+ incr eind
+ }
+
+ return $rval
+ }
+
+ #
+ # raw_edata: prepare edata lists for raw data reads in tests
+ # args is list of {eflag eaddr edata enbusy} sublists
+
+ proc raw_edata {edat emsk args} {
+ upvar $edat uedat
+ upvar $emsk uemsk
+ set uedat {}
+ set uemsk {}
+
+ set m0 [expr {0xffff & ~[regget rbmoni::DAT0(nbusy) -1] }]
+ set d1 0x0000
+ set m1 0xffff
+ set m3 0x0000
+
+ foreach line $args {
+ foreach {eflags eaddr edata enbusy} $line { break }
+ set d0 [regbld rbmoni::DAT0 [list nbusy $enbusy]]
+ if {$edata ne ""} {
+ set m2 0x0000
+ set d2 $edata
+ } else {
+ set m2 0xffff
+ set d2 0x0000
+ }
+ set d3 [regbld rbmoni::DAT3 [list flags $eflags] [list addr $eaddr]]
+
+ lappend uedat $d0 $d1 $d2 $d3
+ lappend uemsk $m0 $m1 $m2 $m3
+ }
+
+ return ""
+ }
+
+ #
+ # raw_check: check raw data against expect values prepared by raw_edata
+ #
+ proc raw_check {edat emsk} {
+
+ rlc exec -estatdef 0x0 [regbld rlink::STAT {stat -1}] \
+ -rreg rm.addr -edata [llength $edat] \
+ -wreg rm.addr 0 \
+ -rblk rm.data [llength $edat] -edata $edat $emsk \
+ -rreg rm.addr -edata [llength $edat]
+ return ""
+ }
+
+}
Index: rbmoni/test_regs.tcl
===================================================================
--- rbmoni/test_regs.tcl (nonexistent)
+++ rbmoni/test_regs.tcl (revision 24)
@@ -0,0 +1,89 @@
+# $Id: test_regs.tcl 375 2011-04-02 07:56:47Z mueller $
+#
+# Copyright 2011- by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2011-03-27 374 1.0 Initial version
+# 2011-03-13 369 0.1 First Draft
+#
+
+package provide rbmoni 1.0
+
+package require rutiltpp
+package require rutil
+package require rlink
+
+namespace eval rbmoni {
+ #
+ # Basic tests with rbtester registers
+ #
+ proc test_regs {} {
+ set esdval 0x00
+ set esdmsk [regbld rlink::STAT {stat -1}]
+ #
+ set errcnt 0
+ rlc errcnt -clear
+ #
+ rlc log "rbmoni::test_regs - start"
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 1: write/read cntl"
+ foreach val [list [regbld rbmoni::CNTL go] 0x0] {
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg rm.cntl $val \
+ -rreg rm.cntl -edata $val
+ }
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 2: write/read alim"
+ foreach val [list [regbld rbmoni::ALIM {hilim 0x00} {lolim 0x00}] \
+ [regbld rbmoni::ALIM {hilim 0xff} {lolim 0xff}] \
+ [regbld rbmoni::ALIM {hilim 0x00} {lolim 0xff}] \
+ [regbld rbmoni::ALIM {hilim 0xff} {lolim 0x00}]
+ ] {
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg rm.alim $val \
+ -rreg rm.alim -edata $val
+ }
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 3: write/read addr"
+ set amax [regget rbmoni::ADDR(laddr) -1]
+ foreach {laddr waddr} [list 0x0000 0 0x0000 3 $amax 0 $amax 3] {
+ set addr [regbld rbmoni::ADDR [list laddr $laddr] [list waddr $waddr]]
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg rm.addr $addr \
+ -rreg rm.addr -edata $addr
+ }
+ #
+ #-------------------------------------------------------------------------
+ rlc log " test 4: verify that cntl.go 0->1 clear addr"
+ rlc exec -estatdef $esdval $esdmsk \
+ -wreg rm.cntl 0x0 \
+ -rreg rm.cntl -edata 0x0 \
+ -wreg rm.addr [regbld rbmoni::ADDR [list laddr $amax]] \
+ -rreg rm.addr -edata [regbld rbmoni::ADDR [list laddr $amax]] \
+ -wreg rm.cntl [regbld rbmoni::CNTL go] \
+ -rreg rm.cntl -edata [regbld rbmoni::CNTL go] \
+ -rreg rm.addr -edata 0x00 \
+ -wreg rm.cntl 0x0 \
+ -rreg rm.cntl -edata 0x0
+ #
+ #-------------------------------------------------------------------------
+ rlc log "rbmoni::test_regs - cleanup"
+ rbmoni::init
+ #
+ incr errcnt [rlc errcnt -clear]
+ return $errcnt
+ }
+}
Index: rbmoni/.cvsignore
===================================================================
--- rbmoni/.cvsignore (nonexistent)
+++ rbmoni/.cvsignore (revision 24)
@@ -0,0 +1 @@
+pkgIndex.tcl
Index: rbmoni
===================================================================
--- rbmoni (nonexistent)
+++ rbmoni (revision 24)
rbmoni
Property changes :
Added: svn:ignore
## -0,0 +1,33 ##
+*.dep_ghdl
+*.dep_isim
+*.dep_xst
+work-obj93.cf
+*.vcd
+*.ghw
+*.sav
+*.tmp
+*.exe
+ise
+xflow.his
+*.ngc
+*.ncd
+*.pcf
+*.bit
+*.msk
+isim
+isim.log
+isim.wdb
+fuse.log
+*_[sft]sim.vhd
+*_tsim.sdf
+*_xst.log
+*_tra.log
+*_twr.log
+*_map.log
+*_par.log
+*_pad.log
+*_bgn.log
+*_svn.log
+*_sum.log
+*_[dsft]sim.log
+pkgIndex.tcl
Index: rbs3hio/util.tcl
===================================================================
--- rbs3hio/util.tcl (nonexistent)
+++ rbs3hio/util.tcl (revision 24)
@@ -0,0 +1,122 @@
+# $Id: util.tcl 516 2013-05-05 21:24:52Z mueller $
+#
+# Copyright 2011-2013 by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2011-08-14 406 1.0.2 adopt to common register layout
+# 2011-04-17 376 1.0.1 print: show also switch values; add proc disptest
+# 2011-03-27 374 1.0 Initial version
+# 2011-03-19 372 0.1 First draft
+#
+
+package provide rbs3hio 1.0
+
+package require rutil
+package require rutiltpp
+
+namespace eval rbs3hio {
+ #
+ # setup register descriptions for s3_humanio_rbus
+ #
+ regdsc CNTL {btn 12 4} {dspen 3} {dpen 2} {leden 1} {swien 0}
+ regdsc LED {dp 15 4} {led 7 8}
+
+ #
+ # setup: amap definitions for s3_humanio_rbus
+ #
+ proc setup {base} {
+ rlc amap -insert hi.cntl [expr {$base + 0x00}]
+ rlc amap -insert hi.swi [expr {$base + 0x01}]
+ rlc amap -insert hi.led [expr {$base + 0x02}]
+ rlc amap -insert hi.dsp [expr {$base + 0x03}]
+ }
+
+ #
+ # init: reset s3_humanio_rbus (clear all enables)
+ #
+ proc init {} {
+ rlc exec -wreg hi.cntl 0x0000
+ }
+
+ #
+ # print: show status
+ #
+ proc print {} {
+ set rval {}
+ rlc exec \
+ -rreg hi.cntl r_cntl \
+ -rreg hi.swi r_swi \
+ -rreg hi.led r_led \
+ -rreg hi.dsp r_dsp
+ set led [regget rbs3hio::LED(led) $r_led]
+ set dp [regget rbs3hio::LED(dp) $r_led]
+ append rval " cntl: [regtxt rbs3hio::CNTL $r_cntl]"
+ append rval "\n swi: [pbvi b8 $r_swi]"
+ append rval "\n led: [pbvi b8 $led]"
+ set dspval ""
+ for {set i 3} {$i >= 0} {incr i -1} {
+ set digval [expr {( $r_dsp >> ( 4 * $i ) ) & 0x0f}]
+ set digdp [expr {( $dp >> $i ) & 0x01}]
+ append dspval [format "%x" $digval]
+ if {$digdp} {append dspval "."} else {append dspval " "}
+ }
+ append rval "\n disp: [pbvi b16 $r_dsp] - [pbvi b4 $dp] -> \"$dspval\""
+ return $rval
+ }
+
+ #
+ # disptest: blink through the leds
+ #
+ proc disptest {} {
+ rlc exec -rreg hi.cntl r_cntl
+ set swien [regget rbs3hio::CNTL(swien) $r_cntl]
+ rlc exec -wreg hi.cntl [regbld rbs3hio::CNTL dspen dpen leden \
+ [list swien $swien] ]
+
+ foreach ledval {0x0f 0xf0 0xff} {
+ set dpval [expr {$ledval & 0x0f}]
+ set hiled [regbld rbs3hio::LED [list led $ledval] [list dp $dpval]]
+ rlc exec \
+ -wreg hi.led $hiled \
+ -wreg hi.dsp 0xffff
+ after 250
+ }
+
+ for {set i 0} {$i <= 0xf} {incr i} {
+ set ledval [expr {( $i << 4 ) | $i}]
+ set dspval [expr {( $ledval << 8 ) | $ledval}]
+ set hiled [regbld rbs3hio::LED [list led $ledval] [list dp $i]]
+ rlc exec \
+ -wreg hi.led $hiled \
+ -wreg hi.dsp $dspval
+ after 250
+ }
+
+ set ledval 0x01
+ for {set i 0} {$i < 32} {incr i} {
+ set dpval [expr {$ledval & 0x0f}]
+ set hiled [regbld rbs3hio::LED [list led $ledval] [list dp $dpval]]
+ rlc exec \
+ -wreg hi.led $hiled \
+ -wreg hi.dsp $i
+ after 50
+ set ledval [expr {$ledval << 1}]
+ if {$ledval & 0x100} {set ledval [expr {( $ledval & 0xff ) | 0x01}] }
+ }
+
+ rlc exec \
+ -wreg hi.cntl $r_cntl \
+ -wreg hi.led 0x0 \
+ -wreg hi.dsp 0x0
+ }
+}
Index: rbs3hio/.cvsignore
===================================================================
--- rbs3hio/.cvsignore (nonexistent)
+++ rbs3hio/.cvsignore (revision 24)
@@ -0,0 +1 @@
+pkgIndex.tcl
Index: rbs3hio
===================================================================
--- rbs3hio (nonexistent)
+++ rbs3hio (revision 24)
rbs3hio
Property changes :
Added: svn:ignore
## -0,0 +1,33 ##
+*.dep_ghdl
+*.dep_isim
+*.dep_xst
+work-obj93.cf
+*.vcd
+*.ghw
+*.sav
+*.tmp
+*.exe
+ise
+xflow.his
+*.ngc
+*.ncd
+*.pcf
+*.bit
+*.msk
+isim
+isim.log
+isim.wdb
+fuse.log
+*_[sft]sim.vhd
+*_tsim.sdf
+*_xst.log
+*_tra.log
+*_twr.log
+*_map.log
+*_par.log
+*_pad.log
+*_bgn.log
+*_svn.log
+*_sum.log
+*_[dsft]sim.log
+pkgIndex.tcl
Index: tst_rlink/perf.tcl
===================================================================
--- tst_rlink/perf.tcl (nonexistent)
+++ tst_rlink/perf.tcl (revision 24)
@@ -0,0 +1,56 @@
+# $Id: perf.tcl 516 2013-05-05 21:24:52Z mueller $
+#
+# Copyright 2011- by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2011-04-17 376 1.0 Initial version
+#
+
+package provide tst_rlink 1.0
+
+namespace eval tst_rlink {
+ #
+ # perf_wtlam: determine wtlam latency using timer.0
+ #
+ proc perf_wtlam {{tmax 1000}} {
+ if {$tmax < 1} { error "-E: perf_wtlam: tmax argument must be >= 1" }
+
+ set rval "delay latency"
+
+ rlc exec -init 0xff [regbld rlink::INIT anena]
+
+ for {set dly 250} {$dly <= 10000} {incr dly 250} {
+ rlc exec \
+ -wreg timer.0 0 \
+ -wreg timer.1 0
+ rlc exec -attn
+
+ set tbeg [clock clicks -milliseconds]
+ rlc exec -wreg timer.0 $dly
+ for {set i 1} {1} {incr i} {
+ rlc wtlam 1.
+ rlc exec \
+ -attn \
+ -wreg timer.0 $dly
+ set trun [expr {[clock clicks -milliseconds] - $tbeg}]
+ if {$trun > $tmax} { break }
+ }
+ set ms [expr {double($trun) / double($i)}]
+ append rval [format "\n%5d %6.2f" $dly $ms]
+ }
+
+ rlc exec -init 0xff [regbld rlink::INIT {anena 0}]
+
+ return $rval
+ }
+}
Index: tst_rlink/util.tcl
===================================================================
--- tst_rlink/util.tcl (nonexistent)
+++ tst_rlink/util.tcl (revision 24)
@@ -0,0 +1,86 @@
+# $Id: util.tcl 516 2013-05-05 21:24:52Z mueller $
+#
+# Copyright 2011- by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2011-04-17 376 1.0.1 add proc scan_baud
+# 2011-04-02 375 1.0 Initial version
+# 2011-03-19 372 0.1 First draft
+#
+
+package provide tst_rlink 1.0
+
+package require rlink
+package require rbtest
+package require rbmoni
+package require rbbram
+package require rbs3hio
+package require rbemon
+
+namespace eval tst_rlink {
+ #
+ # setup: amap definitions for tst_rlink
+ #
+ proc setup {} {
+ rlc amap -clear; # clear first to allow re-run
+ rbmoni::setup [bvi b 11111100]
+ rbemon::setup [bvi b 11111000]
+ rbbram::setup [bvi b 11110100]
+ rbtest::setup [bvi b 11110000]
+ rlc amap -insert timer.1 [bvi b 11100001]
+ rlc amap -insert timer.0 [bvi b 11100000]
+ rbs3hio::setup [bvi b 11000000]
+ }
+
+ #
+ # init: reset tst_rlink design to initial state
+ #
+ proc init {} {
+ rlink::init; # reset rlink
+ rbtest::init
+ rbbram::init
+ rbmoni::init
+ rbs3hio::init
+ rbemon::init
+ rlink::init; # re-reset rlink
+ }
+
+ #
+ # scan_baud: scan through baud rates, show uart clkdiv value
+ #
+ proc scan_baud {{bmax 500000}} {
+ if {! [rlink::isopen]} {error "-E: rlink port not open"}
+ set rlpath [rlc open]
+ regexp -- {^term:(.*)\?} $rlpath dummy rldev
+ if {$rldev eq ""} {error "-E: rlink not connected to a term: device"}
+
+ set rval " baud hi.dsp clkdiv sysclk"
+ set blist {9600 19200 38400 57600 115200 230400 460800
+ 500000 921600 1000000 2000000 3000000}
+
+ foreach baud $blist {
+ if {$baud > $bmax} { break }
+ rlc close
+ rlc open "term:$rldev?baud=${baud};break"
+ rlc exec -rreg hi.dsp hidsp
+ set mhz [expr {double($baud*$hidsp) / 1.e6}]
+ append rval [format "\n%7d 0x%4.4x %6d %6.2f" \
+ $baud $hidsp [expr {$hidsp + 1}] $mhz]
+ }
+
+ rlc close
+ if {! [regexp -- {;break} $rlpath]} {append rlpath ";break"}
+ rlc open "${rlpath}"
+ return $rval
+ }
+}
Index: tst_rlink/test_all.tcl
===================================================================
--- tst_rlink/test_all.tcl (nonexistent)
+++ tst_rlink/test_all.tcl (revision 24)
@@ -0,0 +1,57 @@
+# $Id: test_all.tcl 469 2013-01-05 12:29:44Z mueller $
+#
+# Copyright 2011- by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2013-01-04 469 1.0.2 move rbemon tests from test_all to test_all_emon
+# 2011-04-17 376 1.0.1 add rbemon::test_rbtest_sim (if in sum mode)
+# 2011-04-02 375 1.0 Initial version
+# 2011-03-26 373 0.1 First draft
+#
+
+package provide tst_rlink 1.0
+
+package require rbtest
+package require rbmoni
+
+namespace eval tst_rlink {
+ #
+ # Driver for all tst_rlink tests
+ #
+ proc test_all {} {
+ #
+ set errcnt 0
+ incr errcnt [rbtest::test_all 0x7 0xfffc]
+ incr errcnt [rbmoni::test_regs]
+ incr errcnt [rbmoni::test_rbtest]
+
+ puts "tst_rlink::test_all errcnt = $errcnt --> [rutil::errcnt2txt $errcnt]"
+
+ return $errcnt
+ }
+ #
+ # Driver for emon based tst_rlink tests
+ #
+ proc test_all_emon {} {
+ #
+ set errcnt 0
+ incr errcnt [rbemon::test_regs]
+ if {[rlink::issim]} {
+ incr errcnt [rbemon::test_rbtest_sim]
+ }
+
+ puts "tst_rlink::test_all_emon errcnt = $errcnt --> [rutil::errcnt2txt $errcnt]"
+
+ return $errcnt
+ }
+}
Index: tst_rlink/.cvsignore
===================================================================
--- tst_rlink/.cvsignore (nonexistent)
+++ tst_rlink/.cvsignore (revision 24)
@@ -0,0 +1 @@
+pkgIndex.tcl
Index: tst_rlink
===================================================================
--- tst_rlink (nonexistent)
+++ tst_rlink (revision 24)
tst_rlink
Property changes :
Added: svn:ignore
## -0,0 +1,33 ##
+*.dep_ghdl
+*.dep_isim
+*.dep_xst
+work-obj93.cf
+*.vcd
+*.ghw
+*.sav
+*.tmp
+*.exe
+ise
+xflow.his
+*.ngc
+*.ncd
+*.pcf
+*.bit
+*.msk
+isim
+isim.log
+isim.wdb
+fuse.log
+*_[sft]sim.vhd
+*_tsim.sdf
+*_xst.log
+*_tra.log
+*_twr.log
+*_map.log
+*_par.log
+*_pad.log
+*_bgn.log
+*_svn.log
+*_sum.log
+*_[dsft]sim.log
+pkgIndex.tcl
Index: setup_packages
===================================================================
--- setup_packages (nonexistent)
+++ setup_packages (revision 24)
@@ -0,0 +1,16 @@
+#! /usr/bin/env tclsh
+# $Id: setup_packages 510 2013-04-26 16:14:57Z mueller $
+#
+pkg_mkIndex -verbose ../lib libr*tpp.so
+#
+pkg_mkIndex -verbose rutil *.tcl
+pkg_mkIndex -verbose rlink *.tcl
+pkg_mkIndex -verbose rbtest *.tcl
+pkg_mkIndex -verbose rbmoni *.tcl
+pkg_mkIndex -verbose rbbram *.tcl
+pkg_mkIndex -verbose rbs3hio *.tcl
+pkg_mkIndex -verbose rbemon *.tcl
+#
+pkg_mkIndex -verbose rw11 *.tcl
+#
+pkg_mkIndex -verbose tst_rlink *.tcl
setup_packages
Property changes :
Added: svn:executable
## -0,0 +1 ##
+*
\ No newline at end of property
Index: rlink/util.tcl
===================================================================
--- rlink/util.tcl (nonexistent)
+++ rlink/util.tcl (revision 24)
@@ -0,0 +1,72 @@
+# $Id: util.tcl 403 2011-08-06 17:36:22Z mueller $
+#
+# Copyright 2011- by Walter F.J. Mueller
+#
+# This program is free software; you may redistribute and/or modify it under
+# the terms of the GNU General Public License as published by the Free
+# Software Foundation, either version 2, 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 complete details.
+#
+# Revision History:
+# Date Rev Version Comment
+# 2011-08-06 403 1.0.1 add SINT and SINIT defs for serport init
+# 2011-03-26 373 1.0 Initial version
+# 2011-03-19 372 0.1 First draft
+#
+
+package provide rlink 1.0
+
+package require rutil 1.0
+
+namespace eval rlink {
+ regdsc STAT {stat 7 3} {attn 4} {cerr 3} {derr 2} {rbnak 1} {rberr 0}
+ regdsc INIT {anena 15} {itoena 14} {itoval 7 8}
+ regdsc SINIT {fena 12} {fwidth 11 3} {fdelay 8 3} {rtsoff 5 3} {rtson 2 3}
+ #
+ # 'pseudo register', describes 3rd word in return list element for -rlist
+ regdsc FLAGS {vol 16} \
+ {chkdata 13} {chkstat 12} \
+ {errcrc 11} {errcmd 10} {errmiss 9} {errnak 8} \
+ {resend 7} {recov 6} {pktend 5} {pktbeg 4} \
+ {done 2} {send 1} {init 0}
+
+ variable IINT 0x00ff
+ variable SINT 0x00fe
+
+ #
+ # init: reset rlink: disable enables; clear attn register
+ #
+ proc init {} {
+ rlc exec \
+ -init $rlink::IINT 0x0000 \
+ -init $rlink::SINT [regbld rlink::SINIT {rtsoff 7} {rtson 6} ] \
+ -attn
+ return ""
+ }
+ #
+ # isopen: returns 1 if open and 0 if close
+ #
+ proc isopen {} {
+ if {[rlc open] eq ""} { return 0 }
+ return 1
+ }
+ #
+ # isfifo: returns 1 if open and fifo, 0 otherwise
+ #
+ proc isfifo {} {
+ set name [rlc open]
+ if {$name ne "" && [regexp -- {^fifo:} $name]} { return 1 }
+ return 0
+ }
+ #
+ # issim: returns 1 if open and in simulation mode, 0 otherwise
+ #
+ proc issim {} {
+ if {![info exists rlink::sim_mode]} { return 0}
+ return $rlink::sim_mode
+ }
+}
Index: rlink/.cvsignore
===================================================================
--- rlink/.cvsignore (nonexistent)
+++ rlink/.cvsignore (revision 24)
@@ -0,0 +1 @@
+pkgIndex.tcl
Index: rlink
===================================================================
--- rlink (nonexistent)
+++ rlink (revision 24)
rlink
Property changes :
Added: svn:ignore
## -0,0 +1,33 ##
+*.dep_ghdl
+*.dep_isim
+*.dep_xst
+work-obj93.cf
+*.vcd
+*.ghw
+*.sav
+*.tmp
+*.exe
+ise
+xflow.his
+*.ngc
+*.ncd
+*.pcf
+*.bit
+*.msk
+isim
+isim.log
+isim.wdb
+fuse.log
+*_[sft]sim.vhd
+*_tsim.sdf
+*_xst.log
+*_tra.log
+*_twr.log
+*_map.log
+*_par.log
+*_pad.log
+*_bgn.log
+*_svn.log
+*_sum.log
+*_[dsft]sim.log
+pkgIndex.tcl
Index: .tclshrc
===================================================================
--- .tclshrc (nonexistent)
+++ .tclshrc (revision 24)
@@ -0,0 +1,18 @@
+# -*- tcl -*-
+# $Id: .tclshrc 379 2011-04-22 20:56:19Z mueller $
+#
+if {[info exists env(RETROBASE)]} {
+ lappend auto_path [file join $env(RETROBASE) tools tcl]
+ lappend auto_path [file join $env(RETROBASE) tools lib]
+}
+#
+if {$tcl_interactive} {
+ package require tclreadline
+ namespace eval tclreadline {
+ proc prompt1 {} {
+ set version [info tclversion]
+ return "tclsh$version > "
+ }
+ }
+ ::tclreadline::Loop
+}
Index: .wishrc
===================================================================
--- .wishrc (nonexistent)
+++ .wishrc (revision 24)
@@ -0,0 +1,18 @@
+# -*- tcl -*-
+# $Id: .wishrc 379 2011-04-22 20:56:19Z mueller $
+#
+if {[info exists env(RETROBASE)]} {
+ lappend auto_path [file join $env(RETROBASE) tools tcl]
+ lappend auto_path [file join $env(RETROBASE) tools lib]
+}
+#
+if {$tcl_interactive} {
+ package require tclreadline
+ namespace eval tclreadline {
+ proc prompt1 {} {
+ set version [info tclversion]
+ return "tclsh$version > "
+ }
+ }
+ ::tclreadline::Loop
+}
Index: .
===================================================================
--- . (nonexistent)
+++ . (revision 24)
.
Property changes :
Added: svn:ignore
## -0,0 +1,32 ##
+*.dep_ghdl
+*.dep_isim
+*.dep_xst
+work-obj93.cf
+*.vcd
+*.ghw
+*.sav
+*.tmp
+*.exe
+ise
+xflow.his
+*.ngc
+*.ncd
+*.pcf
+*.bit
+*.msk
+isim
+isim.log
+isim.wdb
+fuse.log
+*_[sft]sim.vhd
+*_tsim.sdf
+*_xst.log
+*_tra.log
+*_twr.log
+*_map.log
+*_par.log
+*_pad.log
+*_bgn.log
+*_svn.log
+*_sum.log
+*_[dsft]sim.log