1
2proc regcheck_abort {why} {
3	perror "Test aborted ($why)"
4	vmips_exit
5	exit 1
6}
7
8proc regcheck_set_xfail {targs} {
9	setup_xfail $targs
10}
11
12proc regcheck_set_options {optlist} {
13	global options
14	set options "$optlist"
15}
16
17proc regcheck_set_results {reglist} {
18	global results_ary
19	if [info exists results_ary] {
20		unset results_ary
21	}
22	array set results_ary $reglist
23	verbose "*** ALL RESULT NAMES: [array names results_ary]"
24    foreach name [array names results_ary] {
25		if [regexp "^(\[Rr\])(\[0-9\])$" $name dummy0 dummy1 rnum] {
26			verbose "*** FIXING UP ${dummy1}${rnum} to ${dummy1}0${rnum}"
27			set newname "${dummy1}0${rnum}"
28			set results_ary($newname) $results_ary($name)
29			unset results_ary($name)
30		} else {
31			set newname $name
32		}
33		verbose "*** RESULT $newname SHOULD BE $results_ary($newname)"
34	}
35}
36
37proc regcheck_parse_reg_dump {} {
38    global regs
39	global comp_output
40    # Get rid of any already-existing register dump parse results.
41    if [info exists regs] {
42        unset regs
43    }
44
45	set regdumpstart 0
46	set regdumpend 0
47	while {!$regdumpend && [string length $comp_output] > 0} {
48		#
49		# Get the first line from $comp_output into $line,
50		# and delete it from $comp_output.
51		#
52		set line [string range $comp_output 0 [string first "\n" $comp_output]]
53		set comp_output [string range $comp_output \
54							[expr 1 + [string first "\n" $comp_output]] \
55							[string length $comp_output]]
56		#
57		# Look for the beginning of the register dump.
58		#
59		if [regsub "^.*Reg Dump: \\\[" $line "" lineout] {
60			incr regdumpstart
61		} else {
62			set lineout $line
63		}
64		#
65		# Look for error messages.
66		#
67		if [regexp "^Error:.*" $line errmsg] {
68			warning $errmsg
69		}
70		#
71		# If we found the beginning of the register dump,
72		# then look for whitespace-separated tokens within it.
73		#
74		if {$regdumpstart} {
75			foreach token $lineout {
76				if {$token == "\]"} {
77					#
78					# If we found a right bracket, that marks the
79					# end of the register dump, and we can stop parsing.
80					#
81					set regdumpstart 0
82					set regdumpend 1
83				} elseif [regexp "(\[A-Za-z0-9\]+)=(\[A-Za-z0-9\]+)" \
84							$token subtoken reg val] {
85					#
86					# If we matched something that looks like an assignment
87					# statement, then we store the lhs and rhs in the regs
88					# array.
89					#
90					verbose "*** REGS($reg) <= $val"
91					set reg [string tolower $reg]
92					set regs($reg) [string tolower $val]
93				}
94			}
95		}
96	}
97}
98
99# Check the results of a regcheck test.
100proc regcheck_check_results {} {
101    global results_ary
102	global regs
103    set match_fail 0
104
105	# Look at each of the expected results in the `results_ary' array.
106	# Compare each one against the corresponding entry in the `regs'
107	# array.
108    foreach name [array names results_ary] {
109        set lname [string tolower $name]
110        verbose "*** Checking $lname"
111        set rval [string tolower $results_ary($name)]
112		if ![info exists regs($lname)] {
113			warning "Register $lname not found in reg dump!"
114            incr match_fail
115		} else {
116			if {$regs($lname) == $rval} {
117				verbose "*** Register $lname matches expected result"
118			} else {
119				verbose "*** Register $lname does not match expected result"
120				verbose "*** Got $regs($lname), expected $rval"
121				incr match_fail
122			}
123		}
124    }
125	return $match_fail
126}
127
128proc regcheck_run_one_test {testparams} {
129	# Set the default options.
130	global timeout
131	global options
132	clear_xfail
133	set timeout [vmips_default_timeout]
134	set options ""
135	set default_options "-o noinstdump -o nobootmsg -o haltbreak -o haltdumpcpu"
136	set testrom [vmips_get_romfile_name $testparams]
137	vmips_build_romfile $testrom
138
139	# Load testcase-specific parameters: including expected final,
140	# register values, loaded into `results_ary', and any special
141	# options required, loaded into `options'.
142	if [file exists $testparams] {
143		source $testparams
144	} else {
145		perror "Can't load params from $testparams"
146	}
147
148	# Incorporate any testcase-specific options.
149	set all_options "$default_options"
150	if [info exists options] {
151		set all_options "$options $all_options"
152	}
153
154	# Start the simulator.
155	set commandline "$all_options $testrom"
156	vmips_start $commandline
157
158	# Analyze the output, creating the `regs' array.
159	regcheck_parse_reg_dump
160
161	# Check against the expected results.
162	set nfails [regcheck_check_results]
163	if {$nfails > 0} {
164		fail $testparams
165	} else {
166		pass $testparams
167	}
168
169	# Stop the simulator.
170	vmips_exit
171}
172