OpenCores
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.61/tools/tcl/rutil
    from Rev 25 to Rev 26
    ↔ Reverse comparison
  •

Rev 25 → Rev 26

/util.tcl
0,0 → 1,243
# $Id: util.tcl 569 2014-07-13 14:36:32Z mueller $
#
# Copyright 2011-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-07-12 569 1.0.2 add sxt16 and sxt32
# 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"
}
#
# sxt16: 16 bit sign extend ------------------------------------------------
#
proc sxt16 {val} {
if {$val & 0x8000} { # bit 15 set ?
set val [expr $val | ~ 077777]; # --> set bits 15 and higher
}
return $val
}
 
#
# sxt32: 32 bit sign extend ------------------------------------------------
#
proc sxt32 {val} {
if {$val & 0x80000000} { # bit 31 set ?
set val [expr $val | ~ 017777777777]; # --> set bits 31 and higher
}
return $val
}
 
#
# ! export reg... procs to global scope ------------------------------------
#
 
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
/.cvsignore
0,0 → 1,243
pkgIndex.tcl
/.
. Property changes : Added: svn:ignore ## -0,0 +1,34 ## +*.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 +*_tsi.log +*_pad.log +*_bgn.log +*_svn.log +*_sum.log +*_[dsft]sim.log +pkgIndex.tcl

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.