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