arch.exp

工具链BINUTIS-2.16的源代码

    -re {(?x)           # enable expanded regexp syntax
	 ^/\*           # open C comment at start of input
     \s* repeat         #   repeat does not have a bit pattern
     \s+ start\s+end    #   don't read fake operands as such (replaced below)
     \s+ ([^*]+?)       #   instruction operand
     \s* \*/            # close C comment
     \s* \{             # open brace of data initialiser
	 (?:[^\}]+\}){2}#   2 brace pairs (operands and nibbles)
     \s* ,              #   comma
     \s* arch_(\S+)_up  #   architecture name
     \s* \}             # close brace of data initialiser
        } {
	    set insns(insn,$insncount) "repeat 10 20 $expect_out(1,string)"
	    set insns(arch,$insncount) [string map {_ -} $expect_out(2,string)]
	    set insns(context,$insncount) $expect_out(0,string)
	    incr insncount
	    pass "Instruction '$expect_out(1,string)' read OK"
	    exp_continue
	}
    # Match all 16 bit opcodes
    -re {(?x)           # enable expanded regexp syntax
         ^/\*           # open C comment at start of input
     \s* \S+            #   1 binary word (for 16 bit opcodes)
     \s+ ([^*]+?)       #   instruction mnemonics (must not leave comment)
     \s* \*/            # close C comment
     \s* \{             # open brace of data initialiser
	 (?:[^\}]+\}){2}#   2 brace pairs (operands and nibbles)
     \s* ,              #   comma
     \s* arch_(\S+)_up  #   architecture name
     \s* \}             # close brace of data initialiser
	} {
	    set insns(insn,$insncount) $expect_out(1,string)
	    set insns(arch,$insncount) [string map {_ -} $expect_out(2,string)]
	    set insns(context,$insncount) $expect_out(0,string)
	    incr insncount
	    pass "Instruction '$expect_out(1,string)' read OK"
	    exp_continue
	}
    # Match all remaining possible instructions (error detection)
    -re {(?x)           # enable expanded regexp syntax
	 ^/\*           # open C comment at start of input
	 (?:[^*]*(?:\*[^/])?)+ # match contents of comment allowing *
	 \*/            # close C comment
     \s* \{             # open brace of data initialiser
	 (?:[^\}]+\}){2}#   2 brace pairs (operands and nibbles)
     \s* ,              #   comma
	 [^\}]*
	 arch           #   look for 'arch' anywhere before closing brace
	 [^\}]*
	 \}             # close brace of data initialiser
        } {
	    fail "Found something that looks like an instruction but cannot be decoded:\n\t$expect_out(0,string)"
	    exp_continue
	}
    # No match so move to next (possible) comment
    -re {^.+?((?=/\*)|(?=\#\s*define))} exp_continue
}
send_log "--------------------------------------------------------\n"

if {$archcount == 0} then {
    fail "Unable to read any architectures from sh-opc.h"
} else {
    pass "Read architecture data from sh-opc.h"
}
if {$insncount == 0} then {
    fail "Unable to read any instructions from sh-opc.h"
} else {
    pass "Read instruction data from sh-opc.h"
}

# Munge the insns such that they will assemble
# Each instruction in sh-opc.h has an example format
# with placeholders for the parameters. These placeholders
# need to be replaced with real registers and constants
# as appropriate in order to assemble correctly.
for {set i 0} {$i < $insncount} {incr i} {
    set out $insns(insn,$i)
    if {[regexp {AY_.{3,4}_N} $insns(context,$i)] == 1} then {
	regsub -nocase {<REG_N>} $out {r6} out
    } else {
	regsub -nocase {<REG_N>} $out {r4} out
    }
    regsub -nocase {<REG_M>} $out {r5} out
    if {[regexp {IMM0_20BY8} $insns(context,$i)] == 1} then {
	regsub -nocase {<imm>} $out {1024} out
    } else {
	regsub -nocase {<imm>} $out {4} out
    }
    regsub -nocase {<bdisp\d*>} $out {.+8} out
    regsub -nocase {<disp12>} $out {2048} out
    regsub -nocase {<disp\d*>} $out {8} out
    regsub -nocase {Rn_BANK} $out {r1_bank} out
    regsub -nocase {Rm_BANK} $out {r2_bank} out
    regsub -nocase {<F_REG_N>} $out {fr1} out
    regsub -nocase {<F_REG_M>} $out {fr2} out
    regsub -nocase {<D_REG_N>} $out {dr2} out
    regsub -nocase {<D_REG_M>} $out {dr4} out
    regsub -nocase {<V_REG_N>} $out {fv0} out
    regsub -nocase {<V_REG_M>} $out {fv4} out
    regsub -nocase {<DX_REG_N>} $out {xd2} out
    regsub -nocase {<DX_REG_M>} $out {xd4} out
    regsub -nocase (XMTRX_M4) $out {xmtrx} out
    regsub -nocase (<DSP_REG_X>) $out {x1} out
    regsub -nocase (<DSP_REG_Y>) $out {y0} out
    regsub -nocase (<DSP_REG_M>) $out {a1} out
    regsub -nocase (<DSP_REG_N>) $out {m0} out
    regsub -nocase (<REG_Axy>) $out {r1} out
    regsub -nocase (<REG_Ayx>) $out {r3} out
    regsub -nocase (<DSP_REG_XY>) $out {y1} out
    regsub -nocase (<DSP_REG_YX>) $out {y1} out
    regsub -nocase (<DSP_REG_AX>) $out {a0} out
    regsub -nocase (<DSP_REG_AY>) $out {a0} out
    regsub (Se) $out {x0} out
    regsub (Sf) $out {y0} out
    regsub (Dg) $out {m0} out
    # Put in a dct in order to differentiate between
    # conditional and non-conditional pabs and prnd
    # i.e. between sh-dsp and sh4al-dsp
    if {[regexp {PPIC} $insns(context,$i)] == 1} then {
	set out "dct $out"
    }
    set insns(insn,$i) $out
    set insns(context,$i) [string map {\n " " \r " "} $insns(context,$i)]
}

# Initialise the data structure for the inheritance
array set archtree {}
for {set a 0} {$a < $archcount} {incr a} {
    set archtree($arches($a)) {}
}

# For each architecture, extract its immediate parents
for {set a 0} {$a < $archcount} {incr a} {
    set s $arches($a,descendents)
    regsub -all {[\s|]+} $s { } s
    foreach word [split $s { }] {
	# Word should be one of arch-..., | (or), or arch-...-up
	# We only want the -up information
	# Note that the _ -> - translation was done above
	if {[regexp {^arch-(.*)-up$} $word match arch] == 1} then {
	    # $arch is the descendent of $arches($a),
	    # so $arches($a) is the parent of $arch
	    lappend archtree($arch) $arches($a)
	}
    }
}

# Propagate the inhertances through the list
# Iterate to ensure all inheritances are found (necessary?)
set changesmade 1
while {$changesmade == 1} {
    set changesmade 0
    foreach a [array names archtree] {
	foreach b [array names archtree] {
	    # If arch 'a' is a parent of arch 'b' then b inherits from a
	    if {[lsearch -exact $archtree($b) $a] != -1} then {
		# Only add each arch if it is not already present
		foreach arch $archtree($a) {
		    if {[lsearch -exact $archtree($b) $arch] == -1} then {
			lappend archtree($b) $arch
			set changesmade 1
		    }
		}
	    }
	}
    }
}

# Generate the assembler file for each architecture
# Also count up how many instructions should be valid for each architecture
array set insns_valid {}
for {set arch 0} {$arch < $archcount} {incr arch} {
    set insns_valid($arches($arch)) 0
    set fd [open $arches($arch).s w 0666]
    puts $fd "! Generated file. DO NOT EDIT.\n!"
    puts $fd "! This file was generated by gas/testsuite/gas/sh/arch/arch.exp ."
    puts $fd "! This file should contain every instruction valid on"
    puts $fd "! architecture $arches($arch) but no more."
    puts $fd "! If the tests are failing because the expected results"
    puts $fd "! have changed then run 'make check' and copy the new file"
    puts $fd "! from <objdir>/gas/testsuite/$arches($arch).s"
    puts $fd "! to   <srcdir>/gas/testsuite/gas/sh/arch/$arches($arch).s ."
    puts $fd "! Make sure there are no unexpected or missing instructions."
    puts $fd "\n\t.section .text"
    puts $fd "[string map {- _} $arches($arch)]:"
    puts $fd "! Instructions introduced into $arches($arch)"
    for {set i 0} {$i < $insncount} {incr i} {
	if [string equal $arches($arch) $insns(arch,$i)] then {
	    puts $fd [format "\t%-25s ;!%s" $insns(insn,$i) $insns(context,$i)]
	    incr insns_valid($arches($arch))
	}
    }
    puts $fd "\n! Instructions inherited from ancestors: [lsort -increasing $archtree($arches($arch))]"
    for {set i 0} {$i < $insncount} {incr i} {
	if {[string equal $arches($arch) $insns(arch,$i)] != 1 && [lsearch -exact $archtree($arches($arch)) $insns(arch,$i)] != -1} then {
	    puts $fd [format "\t%-25s ;!%s" $insns(insn,$i) $insns(context,$i)]
	    incr insns_valid($arches($arch))
	}
    }
    close $fd
}


###################################################################
# Compare the newly created sh*.s files with the existing
# ones in the testsuite

for {set arch 0} {$arch < $archcount} {incr arch} {
    send_log "diff $srcdir/$subdir/$arches($arch).s $arches($arch).s\n"
    catch "exec diff $srcdir/$subdir/$arches($arch).s $arches($arch).s" diff_output
    if {[string equal $diff_output ""] == 0} then {
	send_log $diff_output
	fail "Check $arches($arch) architecture has not changed"
    } else {
	pass "Check $arches($arch) architecture has not changed"
    }
}


###################################################################
# Generate an assembler file with every instruction
# Then use it to test how many failures there are for
# each architecture. If this does not match the predicted value
# then the assembler accepts too many instructions for a given
# architecture.


set fd [open "all_insns.s" w 0666]
for {set i 0} {$i < $insncount} {incr i} {
    puts $fd [format "\t%-25s ;!%s" $insns(insn,$i) $insns(context,$i)]
}
close $fd

# Assemble the all_insns.s file for each isa and count how many failures there are
foreach arch [array names insns_valid] {
    set errormessages 0
    set expected [expr $insncount - $insns_valid($arch)]

    # The -Z option ensures that all error messages are output,
    # even those from later phases of assembly (such as offset range errors)
    send_log "$AS -Z -isa=$arch all_insns.s -o /dev/null\n"
    spawn $AS -Z -isa=$arch all_insns.s -o /dev/null
    expect Error: {incr errormessages; exp_continue}

    if {$errormessages == $expected} then {
	pass "$expected insns should not assemble on $arch"
    } else {
	if {([istarget sh*-*-coff] || [istarget sh*-hms]) && [string match {*dsp} $arch]} {
	    xfail "$expected insns should not assemble on $arch ($errormessages did not)"
	} else {
	    fail "$expected insns should not assemble on $arch ($errormessages did not)"
	}
    }
}


} ;# istarget sh*-*-*