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/rw11
- from Rev 25 to Rev 26
- ↔ Reverse comparison
Rev 25 → Rev 26
/asm.tcl
0,0 → 1,113
# $Id: asm.tcl 575 2014-07-27 20:55:41Z 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-07-26 575 1.0.3 add asmwait_tout variable, use in asmwait |
# 2014-07-10 568 1.0.2 add errcnt return for asmtreg and asmtmem |
# 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 { |
|
variable asmwait_tout 10. |
|
# |
# 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 0.}} { |
upvar 1 $symName sym |
variable asmwait_tout |
if {$tout <= 0.} { # if not specified |
set tout $asmwait_tout; # use default value |
} |
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)" |
} |
set errbeg [rlc errcnt] |
eval $cpu cp $cpcmd |
return [expr [rlc errcnt] - $errbeg] |
} |
|
# |
# 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" |
} |
set errbeg [rlc errcnt] |
$cpu cp -wal $base -brm $nw -edata $list |
return [expr [rlc errcnt] - $errbeg] |
} |
|
} |
/util.tcl
0,0 → 1,170
# $Id: util.tcl 575 2014-07-27 20:55:41Z 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-07-26 575 1.2.2 run_pdpcp: add tout argument |
# 2014-06-27 565 1.2.1 temporarily hide RL11 |
# 2014-06-08 561 1.2 setup_sys: add RL11 |
# 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 rl11 |
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 {tout 10.} {cpu "cpu0"}} { |
rlc errcnt -clear |
set code [exec ticonv_pdpcp --tout=$tout $cpu $fname] |
eval $code |
set errcnt [rlc errcnt] |
if { $errcnt } { |
puts [format "run_pdpcp: FAIL after %d errors" $errcnt] |
} |
return $errcnt |
} |
|
} |
/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 |
|
} |
/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 "" |
} |
|
} |
/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 "" |
} |
|
} |
/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 |
} |
|
} |
/.cvsignore
0,0 → 1,72
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