[deliverable/binutils-gdb.git] / gas / testsuite / gas / sh / arch / arch.exp

# Copyright (C) 2004-2015 Free Software Foundation, Inc.

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, 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 more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.  

# Please email any bugs, comments, and/or additions to this file to:
# binutils@sources.redhat.com

# This scripts tests all available SH architectures with all the assembler
# options related to the architecture. It ensures that those combinations
# which should not work do not work, and that those that should work
# produce the correct output architecture.
#
# It looks for files in the same directory as this file named sh*.s .
# Each file must contain all the instructions available within
# that architecture. The architecture name is inferred from the file name.
#
# The sh*.s files should NOT be hand edited. Whenever the script is run
# (e.g. with 'make check') it creates a set of new (usually identical) files
# in the <objdir>/gas/testsuite directory. These are compared against the
# old ones in the testsuite. When the expected results change (or new
# architectures are added) these new files can be used to replace the old
# ones with no modification required.
#
# The script generates the architecture/option permutations automatically,
# but it reads the expected results from the file arch_expected.txt (also
# found in the same directory as this script).
#
# The arch_expected.txt file should NOT be hand edited. Whenever the script
# is run (e.g. with 'make check') it creates a new (usually identical) file
# named arch_results.txt in the <objdir>/gas/testsuite directory. When the
# expected results change (or new architectures are added) this new file
# can be used to replace arch_expected.txt with no modification required.

if {[istarget sh*-*-*]} then {


# This procedure extracts the architecture name from the objdump output.
# If there is no architecture name (or objdump output changes significantly)
# then the behaviour is undefined, but it will most likely return junk.

proc get_sh_arch { ofile } {
    global comp_output

    objdump "-f $ofile"
    send_log $comp_output

    set comp_output [string replace $comp_output 0 \
	    [expr [string first "architecture:" $comp_output] + 13] ""]

    return [string range $comp_output 0 [expr [string first "," $comp_output] - 1]]
}


# This procedure runs two tests:
#   Test 1: Check the assembler can assemble the given file with
#           given options.
#   Test 2: Check that the resultant architecture is as expected.
# It also writes an entry to the arch_results.txt file.

proc test_arch { file opt arch resultfile } {
    global comp_output

    set name [file tail $file]
    set rootname [file rootname $name]

    if [string equal $opt "default-options"] then {
	gas_run $name "-o ${rootname}-#${opt}#.o" ""
    } else {
	gas_run $name "$opt -o ${rootname}-#${opt}#.o" ""
    }

    if [want_no_output "$rootname file should assemble with $opt"] then {
	set result [get_sh_arch "${rootname}-#${opt}#.o"]
	puts $resultfile [format "%-20s %-25s %s" $file $opt $result]

	if {$result == $arch} then {
	    pass "$rootname file with $opt should assemble to arch $arch"
	    file delete "${rootname}-#${opt}#.o"
	} else {
	    send_log $comp_output
	    fail "$rootname file with $opt should assemble to arch $arch"
	}
    } else {
	puts $resultfile [format "%-20s %-25s ERROR" $file $opt]
	untested "$rootname file with $opt should assemble to arch $arch"
    }

}


# This procedure tests that a file that is not suposed to assemble
# with a given option does, in fact, not assemble.
# It also writes an entry to the arch_results.txt file.

proc test_arch_error { file opt resultfile} {
    global comp_output

    set name [file tail $file]
    set rootname [file rootname $name]

    if [string equal $opt "default-options"] then {
	gas_run $name "-o ${rootname}-#${opt}#.o" ""
    } else {
	gas_run $name "$opt -o ${rootname}-#${opt}#.o" ""
    }

    if [string match "" $comp_output] then {
	fail "$rootname file with $opt should not assemble"
	puts $resultfile [format "%-20s %-25s [get_sh_arch ${rootname}-#${opt}#.o]" $file $opt]
    } else {
	pass "$rootname file with $opt should not assemble"
	puts $resultfile [format "%-20s %-25s ERROR" $file $opt]
    }
}   

# These tests are not suitable for sh-coff because
# coff does not store the architecture information.

if [istarget sh*-*-elf] then {
    global subdir srcdir

    # Find all the architectures and generate the
    # list of options we will test.

    set filelist [lsort -ascii [glob "$srcdir/$subdir/sh*.s"]]
    set optlist {"default-options" "-dsp" "-isa=any" "-isa=dsp" "-isa=fp"}
    foreach file $filelist {
	set arch [file rootname [file tail $file]]
	lappend optlist "-isa=$arch" "-isa=${arch}-up"
    }

    # Initialise the results file

    set outfile [open "arch_results.txt" w 0666]
    puts $outfile "# Generated file. DO NOT EDIT"
    puts $outfile "#"
    puts $outfile "# This file is generated by gas/testsuite/gas/sh/arch/arch.exp ."
    puts $outfile "# It contains the expected results of the tests."
    puts $outfile "# If the tests are failing because the expected results"
    puts $outfile "# have changed then run 'make check' and copy the new file"
    puts $outfile "# from <objdir>/gas/testsuite/arch_results.txt"
    puts $outfile "# to   <srcdir>/gas/testsuite/gas/sh/arch/arch_expected.txt ."
    puts $outfile "# Make sure the new expected results are ALL correct."
    puts $outfile "#"
    puts $outfile [format "# %-18s %-25s %s" "FILE" "OPTION" "OUTPUT"]
    puts $outfile [format "# %-18s %-25s %s" "----" "------" "------"]

    # Open the expected results file and skip the header

    set infile [open "$srcdir/$subdir/arch_expected.txt" r]
    while {[gets $infile line] >= 0 && [string match {\#*} $line]} {send_log "reading '$line'\n"}

    foreach file $filelist {
	foreach opt $optlist {
	    set name [file tail $file]
	    set rootname [file rootname $name]

	    # Decode the expected result from the file

	    scan $line "%s %s %s" exfile exopt exarch
	    send_log "exfile = '$exfile', exopt = '$exopt', exarch = '$exarch'\n"
	    send_log "  name = '$name',   opt = '$opt'\n"

	    if {[string equal $exfile $name] && [string equal $exopt $opt]} then {
		# The expected result file makes sense and
		# appears up-to-date (the file and options match)

		if {[string equal $exarch "ERROR"]} then {
		    test_arch_error $name $opt $outfile
		} else {
		    test_arch $name $opt $exarch $outfile
		}
	    } else {
		# The expected result file isn't right somehow
		# so just try any old test. This will cause
		# many failures, but will generate the results file.

		test_arch $name $opt $rootname $outfile
	    }

	    # Read the next line from the expected result file.
	    # This is at the end because the process of skipping
	    # the header reads the first real line

	    if [gets $infile line] then {
		send_log "reading '$line'\n"
	    }
	}
    }

    close $infile
    close $outfile
}

return

#########################################################################
# Generate one sh*.s file for each architecture defined in sh-opc.h
# This will contain all the instructions valid on that platform
#
# This code produces pass or fail reports for each instruction
# in order to ensure that problems are visible to the developer,
# rather than just warnings hidden in the log file.

# These variables will contains the architecture
# and instruction data extracted from sh-opc.h
array set arches {}
set archcount 0
array set insns {}
set insncount 0

# Pull the architecture inheritance macros out of sh-opc.h
# Pull all the insns out of the sh-opc.h file.
send_log "Reading sh-opc.h\n"
send_log "========================================================\n"
spawn -noecho cat "$srcdir/../../opcodes/sh-opc.h"   ;# -open doesn't seem to be reliable
expect {
    -re {#define\s+arch_([^ ]*)_up\s*\(([^)]*)\)} {
	set arches($archcount) [string map {_ -} $expect_out(1,string)]
	set arches($archcount,descendents) [string map {_ -} $expect_out(2,string)]
	incr archcount
	pass "Architecture arch_$expect_out(1,string) read OK"
	exp_continue
    }
    # Match all 32 bit opcodes
    -re {(?x)           # enable expanded regexp syntax
         ^/\*           # open C comment at start of input
         (?:\s*\S+){2}  #   2 binary words (for 32 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* \|             #   literal or
     \s* arch_op32      #   32 bit opcode indicator
     \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
	}
    # Special case: Match the repeat pseudo op
    -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"
    }
    # Make sure the proper alignments are ok.
    if [regexp {i8p4} $insns(context,$i)] {
      set out ".align 2\n\t$out"
    }

    # Write back the results.
    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*-*-*
Commit	Line	Data
b90efa5b	1	# Copyright (C) 2004-2015 Free Software Foundation, Inc.
5b9b7d81 JR	2
	3	# This program is free software; you can redistribute it and/or modify
	4	# it under the terms of the GNU General Public License as published by
ec2655a6	5	# the Free Software Foundation; either version 3 of the License, or
5b9b7d81 JR	6	# (at your option) any later version.
	7	#
	8	# This program is distributed in the hope that it will be useful,
	9	# but WITHOUT ANY WARRANTY; without even the implied warranty of
	10	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	11	# GNU General Public License for more details.
	12	#
	13	# You should have received a copy of the GNU General Public License
	14	# along with this program; if not, write to the Free Software
4b4da160	15	# Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1301, USA.
5b9b7d81 JR	16
5b9b7d81 JR	17	# Please email any bugs, comments, and/or additions to this file to:
e38bc3b5	18	# binutils@sources.redhat.com
5b9b7d81 JR	19
	20	# This scripts tests all available SH architectures with all the assembler
	21	# options related to the architecture. It ensures that those combinations
	22	# which should not work do not work, and that those that should work
	23	# produce the correct output architecture.
	24	#
	25	# It looks for files in the same directory as this file named sh*.s .
e38bc3b5	26	# Each file must contain all the instructions available within
5b9b7d81 JR	27	# that architecture. The architecture name is inferred from the file name.
5b9b7d81 JR	28	#
e38bc3b5 NC	29	# The sh*.s files should NOT be hand edited. Whenever the script is run
	30	# (e.g. with 'make check') it creates a set of new (usually identical) files
	31	# in the <objdir>/gas/testsuite directory. These are compared against the
	32	# old ones in the testsuite. When the expected results change (or new
	33	# architectures are added) these new files can be used to replace the old
	34	# ones with no modification required.
	35	#
5b9b7d81 JR	36	# The script generates the architecture/option permutations automatically,
	37	# but it reads the expected results from the file arch_expected.txt (also
	38	# found in the same directory as this script).
	39	#
	40	# The arch_expected.txt file should NOT be hand edited. Whenever the script
	41	# is run (e.g. with 'make check') it creates a new (usually identical) file
	42	# named arch_results.txt in the <objdir>/gas/testsuite directory. When the
	43	# expected results change (or new architectures are added) this new file
	44	# can be used to replace arch_expected.txt with no modification required.
	45
e38bc3b5 NC	46	if {[istarget sh--*]} then {
e38bc3b5 NC	47
5b9b7d81	48
e38bc3b5	49	# This procedure extracts the architecture name from the objdump output.
5b9b7d81 JR	50	# If there is no architecture name (or objdump output changes significantly)
	51	# then the behaviour is undefined, but it will most likely return junk.
	52
	53	proc get_sh_arch { ofile } {
	54	global comp_output
	55
	56	objdump "-f $ofile"
	57	send_log $comp_output
	58
	59	set comp_output [string replace $comp_output 0 \
	60	[expr [string first "architecture:" $comp_output] + 13] ""]
	61
	62	return [string range $comp_output 0 [expr [string first "," $comp_output] - 1]]
	63	}
	64
	65
	66	# This procedure runs two tests:
	67	# Test 1: Check the assembler can assemble the given file with
	68	# given options.
	69	# Test 2: Check that the resultant architecture is as expected.
	70	# It also writes an entry to the arch_results.txt file.
	71
	72	proc test_arch { file opt arch resultfile } {
	73	global comp_output
	74
	75	set name [file tail $file]
	76	set rootname [file rootname $name]
	77
	78	if [string equal $opt "default-options"] then {
	79	gas_run $name "-o ${rootname}-#${opt}#.o" ""
	80	} else {
	81	gas_run $name "$opt -o ${rootname}-#${opt}#.o" ""
	82	}
	83
	84	if [want_no_output "$rootname file should assemble with $opt"] then {
	85	set result [get_sh_arch "${rootname}-#${opt}#.o"]
	86	puts $resultfile [format "%-20s %-25s %s" $file $opt $result]
	87
	88	if {$result == $arch} then {
	89	pass "$rootname file with $opt should assemble to arch $arch"
	90	file delete "${rootname}-#${opt}#.o"
	91	} else {
	92	send_log $comp_output
	93	fail "$rootname file with $opt should assemble to arch $arch"
	94	}
	95	} else {
	96	puts $resultfile [format "%-20s %-25s ERROR" $file $opt]
	97	untested "$rootname file with $opt should assemble to arch $arch"
	98	}
	99
	100	}
	101
	102
	103	# This procedure tests that a file that is not suposed to assemble
	104	# with a given option does, in fact, not assemble.
	105	# It also writes an entry to the arch_results.txt file.
	106
	107	proc test_arch_error { file opt resultfile} {
	108	global comp_output
	109
	110	set name [file tail $file]
	111	set rootname [file rootname $name]
	112
	113	if [string equal $opt "default-options"] then {
114	gas_run $name "-o ${rootname}-#${opt}#.o" ""
115	} else {
116	gas_run $name "$opt -o ${rootname}-#${opt}#.o" ""
117	}
118
119	if [string match "" $comp_output] then {
120	fail "$rootname file with $opt should not assemble"
121	puts $resultfile [format "%-20s %-25s [get_sh_arch ${rootname}-#${opt}#.o]" $file $opt]
122	} else {
123	pass "$rootname file with $opt should not assemble"
124	puts $resultfile [format "%-20s %-25s ERROR" $file $opt]
125	}
126	}
127
128	# These tests are not suitable for sh-coff because
129	# coff does not store the architecture information.
130
131	if [istarget sh--elf] then {
132	global subdir srcdir
133
134	# Find all the architectures and generate the
135	# list of options we will test.
136
137	set filelist [lsort -ascii [glob "$srcdir/$subdir/sh*.s"]]
138	set optlist {"default-options" "-dsp" "-isa=any" "-isa=dsp" "-isa=fp"}
139	foreach file $filelist {
140	set arch [file rootname [file tail $file]]
141	lappend optlist "-isa=$arch" "-isa=${arch}-up"
142	}
143
144	# Initialise the results file
145
146	set outfile [open "arch_results.txt" w 0666]
147	puts $outfile "# Generated file. DO NOT EDIT"
148	puts $outfile "#"
149	puts $outfile "# This file is generated by gas/testsuite/gas/sh/arch/arch.exp ."
150	puts $outfile "# It contains the expected results of the tests."
151	puts $outfile "# If the tests are failing because the expected results"
152	puts $outfile "# have changed then run 'make check' and copy the new file"
153	puts $outfile "# from <objdir>/gas/testsuite/arch_results.txt"
154	puts $outfile "# to <srcdir>/gas/testsuite/gas/sh/arch/arch_expected.txt ."
155	puts $outfile "# Make sure the new expected results are ALL correct."
156	puts $outfile "#"
157	puts $outfile [format "# %-18s %-25s %s" "FILE" "OPTION" "OUTPUT"]
158	puts $outfile [format "# %-18s %-25s %s" "----" "------" "------"]
159
160	# Open the expected results file and skip the header
161
162	set infile [open "$srcdir/$subdir/arch_expected.txt" r]
163	while {[gets $infile line] >= 0 && [string match {\#*} $line]} {send_log "reading '$line'\n"}
164
165	foreach file $filelist {
166	foreach opt $optlist {
167	set name [file tail $file]
168	set rootname [file rootname $name]
169
170	# Decode the expected result from the file
171
172	scan $line "%s %s %s" exfile exopt exarch
173	send_log "exfile = '$exfile', exopt = '$exopt', exarch = '$exarch'\n"
174	send_log " name = '$name', opt = '$opt'\n"
175
176	if {[string equal $exfile $name] && [string equal $exopt $opt]} then {
177	# The expected result file makes sense and
178	# appears up-to-date (the file and options match)
179
180	if {[string equal $exarch "ERROR"]} then {
181	test_arch_error $name $opt $outfile
182	} else {
183	test_arch $name $opt $exarch $outfile
184	}
185	} else {
186	# The expected result file isn't right somehow
187	# so just try any old test. This will cause
e38bc3b5	188	# many failures, but will generate the results file.
5b9b7d81 JR	189
	190	test_arch $name $opt $rootname $outfile
	191	}
	192
	193	# Read the next line from the expected result file.
	194	# This is at the end because the process of skipping
	195	# the header reads the first real line
	196
	197	if [gets $infile line] then {
	198	send_log "reading '$line'\n"
	199	}
	200	}
	201	}
	202
	203	close $infile
	204	close $outfile
	205	}
e38bc3b5	206
4e4f7c87	207	return
e38bc3b5 NC	208
	209	#########################################################################
	210	# Generate one sh*.s file for each architecture defined in sh-opc.h
	211	# This will contain all the instructions valid on that platform
	212	#
	213	# This code produces pass or fail reports for each instruction
	214	# in order to ensure that problems are visible to the developer,
	215	# rather than just warnings hidden in the log file.
	216
	217	# These variables will contains the architecture
	218	# and instruction data extracted from sh-opc.h
	219	array set arches {}
	220	set archcount 0
	221	array set insns {}
	222	set insncount 0
	223
	224	# Pull the architecture inheritance macros out of sh-opc.h
	225	# Pull all the insns out of the sh-opc.h file.
	226	send_log "Reading sh-opc.h\n"
c4990c4b	227	send_log "========================================================\n"
e38bc3b5 NC	228	spawn -noecho cat "$srcdir/../../opcodes/sh-opc.h" ;# -open doesn't seem to be reliable
	229	expect {
	230	-re {#define\s+arch_([^ ])_up\s\(([^)]*)\)} {
	231	set arches($archcount) [string map {_ -} $expect_out(1,string)]
	232	set arches($archcount,descendents) [string map {_ -} $expect_out(2,string)]
	233	incr archcount
	234	pass "Architecture arch_$expect_out(1,string) read OK"
	235	exp_continue
	236	}
	237	# Match all 32 bit opcodes
	238	-re {(?x) # enable expanded regexp syntax
	239	^/\* # open C comment at start of input
	240	(?:\s*\S+){2} # 2 binary words (for 32 bit opcodes)
	241	\s+ ([^*]+?) # instruction mnemonics (must not leave comment)
	242	\s* \*/ # close C comment
	243	\s* \{ # open brace of data initialiser
	244	(?:[^\}]+\}){2}# 2 brace pairs (operands and nibbles)
	245	\s* , # comma
	246	\s* arch_(\S+)_up # architecture name
	247	\s* \\| # literal or
	248	\s* arch_op32 # 32 bit opcode indicator
	249	\s* \} # close brace of data initialiser
	250	} {
	251	set insns(insn,$insncount) $expect_out(1,string)
	252	set insns(arch,$insncount) [string map {_ -} $expect_out(2,string)]
	253	set insns(context,$insncount) $expect_out(0,string)
	254	incr insncount
	255	pass "Instruction '$expect_out(1,string)' read OK"
	256	exp_continue
	257	}
	258	# Special case: Match the repeat pseudo op
	259	-re {(?x) # enable expanded regexp syntax
	260	^/\* # open C comment at start of input
	261	\s* repeat # repeat does not have a bit pattern
	262	\s+ start\s+end # don't read fake operands as such (replaced below)
	263	\s+ ([^*]+?) # instruction operand
	264	\s* \*/ # close C comment
	265	\s* \{ # open brace of data initialiser
	266	(?:[^\}]+\}){2}# 2 brace pairs (operands and nibbles)
	267	\s* , # comma
	268	\s* arch_(\S+)_up # architecture name
	269	\s* \} # close brace of data initialiser
	270	} {
	271	set insns(insn,$insncount) "repeat 10 20 $expect_out(1,string)"
	272	set insns(arch,$insncount) [string map {_ -} $expect_out(2,string)]
	273	set insns(context,$insncount) $expect_out(0,string)
	274	incr insncount
	275	pass "Instruction '$expect_out(1,string)' read OK"
	276	exp_continue
	277	}
	278	# Match all 16 bit opcodes
	279	-re {(?x) # enable expanded regexp syntax
	280	^/\* # open C comment at start of input
	281	\s* \S+ # 1 binary word (for 16 bit opcodes)
	282	\s+ ([^*]+?) # instruction mnemonics (must not leave comment)
	283	\s* \*/ # close C comment
	284	\s* \{ # open brace of data initialiser
	285	(?:[^\}]+\}){2}# 2 brace pairs (operands and nibbles)
	286	\s* , # comma
	287	\s* arch_(\S+)_up # architecture name
	288	\s* \} # close brace of data initialiser
	289	} {
	290	set insns(insn,$insncount) $expect_out(1,string)
	291	set insns(arch,$insncount) [string map {_ -} $expect_out(2,string)]
292	set insns(context,$insncount) $expect_out(0,string)
293	incr insncount
294	pass "Instruction '$expect_out(1,string)' read OK"
295	exp_continue
296	}
297	# Match all remaining possible instructions (error detection)
298	-re {(?x) # enable expanded regexp syntax
299	^/\* # open C comment at start of input
300	(?:[^](?:\[^/])?)+ # match contents of comment allowing
301	\*/ # close C comment
302	\s* \{ # open brace of data initialiser
303	(?:[^\}]+\}){2}# 2 brace pairs (operands and nibbles)
304	\s* , # comma
305	[^\}]*
306	arch # look for 'arch' anywhere before closing brace
307	[^\}]*
308	\} # close brace of data initialiser
309	} {
310	fail "Found something that looks like an instruction but cannot be decoded:\n\t$expect_out(0,string)"
311	exp_continue
312	}
313	# No match so move to next (possible) comment
314	-re {^.+?((?=/\)\|(?=\#\sdefine))} exp_continue
315	}
316	send_log "--------------------------------------------------------\n"
317
318	if {$archcount == 0} then {
319	fail "Unable to read any architectures from sh-opc.h"
320	} else {
321	pass "Read architecture data from sh-opc.h"
322	}
323	if {$insncount == 0} then {
324	fail "Unable to read any instructions from sh-opc.h"
325	} else {
326	pass "Read instruction data from sh-opc.h"
327	}
328
329	# Munge the insns such that they will assemble
330	# Each instruction in sh-opc.h has an example format
331	# with placeholders for the parameters. These placeholders
332	# need to be replaced with real registers and constants
333	# as appropriate in order to assemble correctly.
334	for {set i 0} {$i < $insncount} {incr i} {
335	set out $insns(insn,$i)
336	if {[regexp {AY_.{3,4}_N} $insns(context,$i)] == 1} then {
337	regsub -nocase {<REG_N>} $out {r6} out
338	} else {
339	regsub -nocase {<REG_N>} $out {r4} out
340	}
341	regsub -nocase {<REG_M>} $out {r5} out
342	if {[regexp {IMM0_20BY8} $insns(context,$i)] == 1} then {
343	regsub -nocase {<imm>} $out {1024} out
344	} else {
345	regsub -nocase {<imm>} $out {4} out
346	}
347	regsub -nocase {<bdisp\d*>} $out {.+8} out
348	regsub -nocase {<disp12>} $out {2048} out
349	regsub -nocase {<disp\d*>} $out {8} out
350	regsub -nocase {Rn_BANK} $out {r1_bank} out
351	regsub -nocase {Rm_BANK} $out {r2_bank} out
352	regsub -nocase {<F_REG_N>} $out {fr1} out
353	regsub -nocase {<F_REG_M>} $out {fr2} out
354	regsub -nocase {<D_REG_N>} $out {dr2} out
355	regsub -nocase {<D_REG_M>} $out {dr4} out
356	regsub -nocase {<V_REG_N>} $out {fv0} out
357	regsub -nocase {<V_REG_M>} $out {fv4} out
358	regsub -nocase {<DX_REG_N>} $out {xd2} out
359	regsub -nocase {<DX_REG_M>} $out {xd4} out
360	regsub -nocase (XMTRX_M4) $out {xmtrx} out
361	regsub -nocase (<DSP_REG_X>) $out {x1} out
362	regsub -nocase (<DSP_REG_Y>) $out {y0} out
363	regsub -nocase (<DSP_REG_M>) $out {a1} out
364	regsub -nocase (<DSP_REG_N>) $out {m0} out
365	regsub -nocase (<REG_Axy>) $out {r1} out
366	regsub -nocase (<REG_Ayx>) $out {r3} out
367	regsub -nocase (<DSP_REG_XY>) $out {y1} out
368	regsub -nocase (<DSP_REG_YX>) $out {y1} out
369	regsub -nocase (<DSP_REG_AX>) $out {a0} out
370	regsub -nocase (<DSP_REG_AY>) $out {a0} out
371	regsub (Se) $out {x0} out
372	regsub (Sf) $out {y0} out
373	regsub (Dg) $out {m0} out
374	# Put in a dct in order to differentiate between
375	# conditional and non-conditional pabs and prnd
376	# i.e. between sh-dsp and sh4al-dsp
377	if {[regexp {PPIC} $insns(context,$i)] == 1} then {
378	set out "dct $out"
379	}
52b5ca5b AS	380	# Make sure the proper alignments are ok.
	381	if [regexp {i8p4} $insns(context,$i)] {
	382	set out ".align 2\n\t$out"
	383	}
	384
	385	# Write back the results.
e38bc3b5 NC	386	set insns(insn,$i) $out
	387	set insns(context,$i) [string map {\n " " \r " "} $insns(context,$i)]
	388	}
	389
	390	# Initialise the data structure for the inheritance
	391	array set archtree {}
	392	for {set a 0} {$a < $archcount} {incr a} {
	393	set archtree($arches($a)) {}
	394	}
	395
	396	# For each architecture, extract its immediate parents
	397	for {set a 0} {$a < $archcount} {incr a} {
	398	set s $arches($a,descendents)
	399	regsub -all {[\s\|]+} $s { } s
	400	foreach word [split $s { }] {
	401	# Word should be one of arch-..., \| (or), or arch-...-up
	402	# We only want the -up information
	403	# Note that the _ -> - translation was done above
	404	if {[regexp {^arch-(.*)-up$} $word match arch] == 1} then {
	405	# $arch is the descendent of $arches($a),
	406	# so $arches($a) is the parent of $arch
	407	lappend archtree($arch) $arches($a)
	408	}
	409	}
	410	}
	411
	412	# Propagate the inhertances through the list
	413	# Iterate to ensure all inheritances are found (necessary?)
	414	set changesmade 1
	415	while {$changesmade == 1} {
	416	set changesmade 0
	417	foreach a [array names archtree] {
	418	foreach b [array names archtree] {
	419	# If arch 'a' is a parent of arch 'b' then b inherits from a
	420	if {[lsearch -exact $archtree($b) $a] != -1} then {
	421	# Only add each arch if it is not already present
	422	foreach arch $archtree($a) {
	423	if {[lsearch -exact $archtree($b) $arch] == -1} then {
	424	lappend archtree($b) $arch
	425	set changesmade 1
	426	}
	427	}
	428	}
	429	}
	430	}
	431	}
	432
	433	# Generate the assembler file for each architecture
	434	# Also count up how many instructions should be valid for each architecture
	435	array set insns_valid {}
	436	for {set arch 0} {$arch < $archcount} {incr arch} {
	437	set insns_valid($arches($arch)) 0
	438	set fd [open $arches($arch).s w 0666]
	439	puts $fd "! Generated file. DO NOT EDIT.\n!"
	440	puts $fd "! This file was generated by gas/testsuite/gas/sh/arch/arch.exp ."
	441	puts $fd "! This file should contain every instruction valid on"
	442	puts $fd "! architecture $arches($arch) but no more."
	443	puts $fd "! If the tests are failing because the expected results"
	444	puts $fd "! have changed then run 'make check' and copy the new file"
	445	puts $fd "! from <objdir>/gas/testsuite/$arches($arch).s"
	446	puts $fd "! to <srcdir>/gas/testsuite/gas/sh/arch/$arches($arch).s ."
	447	puts $fd "! Make sure there are no unexpected or missing instructions."
	448	puts $fd "\n\t.section .text"
	449	puts $fd "[string map {- _} $arches($arch)]:"
450	puts $fd "! Instructions introduced into $arches($arch)"
451	for {set i 0} {$i < $insncount} {incr i} {
452	if [string equal $arches($arch) $insns(arch,$i)] then {
453	puts $fd [format "\t%-25s ;!%s" $insns(insn,$i) $insns(context,$i)]
454	incr insns_valid($arches($arch))
455	}
456	}
457	puts $fd "\n! Instructions inherited from ancestors: [lsort -increasing $archtree($arches($arch))]"
458	for {set i 0} {$i < $insncount} {incr i} {
459	if {[string equal $arches($arch) $insns(arch,$i)] != 1 && [lsearch -exact $archtree($arches($arch)) $insns(arch,$i)] != -1} then {
460	puts $fd [format "\t%-25s ;!%s" $insns(insn,$i) $insns(context,$i)]
461	incr insns_valid($arches($arch))
462	}
463	}
464	close $fd
465	}
466
467
468	###################################################################
469	# Compare the newly created sh*.s files with the existing
470	# ones in the testsuite
471
472	for {set arch 0} {$arch < $archcount} {incr arch} {
473	send_log "diff $srcdir/$subdir/$arches($arch).s $arches($arch).s\n"
474	catch "exec diff $srcdir/$subdir/$arches($arch).s $arches($arch).s" diff_output
475	if {[string equal $diff_output ""] == 0} then {
476	send_log $diff_output
477	fail "Check $arches($arch) architecture has not changed"
478	} else {
479	pass "Check $arches($arch) architecture has not changed"
480	}
481	}
482
483
484	###################################################################
485	# Generate an assembler file with every instruction
486	# Then use it to test how many failures there are for
487	# each architecture. If this does not match the predicted value
488	# then the assembler accepts too many instructions for a given
489	# architecture.
490
491
492	set fd [open "all_insns.s" w 0666]
493	for {set i 0} {$i < $insncount} {incr i} {
494	puts $fd [format "\t%-25s ;!%s" $insns(insn,$i) $insns(context,$i)]
495	}
496	close $fd
497
498	# Assemble the all_insns.s file for each isa and count how many failures there are
499	foreach arch [array names insns_valid] {
500	set errormessages 0
501	set expected [expr $insncount - $insns_valid($arch)]
502
503	# The -Z option ensures that all error messages are output,
504	# even those from later phases of assembly (such as offset range errors)
505	send_log "$AS -Z -isa=$arch all_insns.s -o /dev/null\n"
506	spawn $AS -Z -isa=$arch all_insns.s -o /dev/null
507	expect Error: {incr errormessages; exp_continue}
508
509	if {$errormessages == $expected} then {
510	pass "$expected insns should not assemble on $arch"
511	} else {
3c1a78a4	512	if {([istarget sh--coff] \|\| [istarget sh-hms]) && [string match {dsp} $arch]} {
e38bc3b5 NC	513	xfail "$expected insns should not assemble on $arch ($errormessages did not)"
	514	} else {
	515	fail "$expected insns should not assemble on $arch ($errormessages did not)"
	516	}
	517	}
	518	}
	519
	520
52b5ca5b	521	} ;# istarget sh--*