cgen/gas-test.scm

   1 ; CPU description file generator for the GNU assembler testsuite.
   2 ; Copyright (C) 2000, 2001, 2009 Red Hat, Inc.
   3 ; This file is part of CGEN.
   4 ; See file COPYING.CGEN for details.
   5
   6 ; This is invoked to build allinsn.exp and a script to run to
   7 ; generate allinsn.s and allinsn.d.
   8
   9 ; Specify which application.
  10 (set! APPLICATION 'GAS-TEST)
  11 \f
  12 ; Called before/after the .cpu file has been read.
  13
  14 (define (gas-test-init!) (opcodes-init!))
  15 (define (gas-test-finish!) (opcodes-finish!))
  16
  17 ; Called after .cpu file has been read and global error checks are done.
  18 ; We use the `tmp' member to record the syntax split up into its components.
  19
  20 (define (gas-test-analyze!)
  21   (opcodes-analyze!)
  22   (map (lambda (insn)
  23          (elm-xset! insn 'tmp (syntax-break-out (insn-syntax insn))))
  24        (non-multi-insns (current-insn-list)))
  25   *UNSPECIFIED*
  26 )
  27 \f
  28 ; Methods to compute test data.
  29 ; The result is a list of strings to be inserted in the assembler
  30 ; in the operand's position.
  31
  32 ; For a general assembler operand, just turn the value into a string.
  33 (method-make!
  34  <hw-asm> 'test-data
  35  (lambda (self ops)
  36    (map number->string ops))
  37 )
  38
  39 ; For a keyword operand, choose the appropriate keyword.
  40 (method-make!
  41  <keyword> 'test-data
  42  (lambda (self ops)
  43    (let* ((test-cases (elm-get self 'values))
  44           (prefix (elm-get self 'prefix)))
  45      (map (lambda (n)
  46             (string-append
  47              (if (and (not (string=? prefix ""))
  48                       (eq? (string-ref prefix 0) #\$))
  49                  "\\" "")
  50              prefix
  51              (car (list-ref test-cases n))))
  52           ops)))
  53 )
  54
  55 (method-make!
  56  <hw-address> 'test-data
  57  (lambda (self ops)
  58    (let* ((test-cases '("foodata" "4" "footext" "-4"))
  59           (n (length ops))
  60           (selection (map (lambda (z) (random (length test-cases))) (iota n))))
  61      (map (lambda (n) (list-ref test-cases n)) selection)))
  62 )
  63
  64 (method-make!
  65  <hw-iaddress> 'test-data
  66  (lambda (self ops)
  67    (let* ((test-cases '("footext" "4" "foodata" "-4"))
  68           (n (length ops))
  69           (selection (map (lambda (z) (random (length test-cases))) (iota n))))
  70      (map (lambda (n) (list-ref test-cases n)) selection)))
  71 )
  72
  73 (method-make-forward! <hw-register> 'indices '(test-data))
  74 (method-make-forward! <hw-immediate> 'values '(test-data))
  75
  76 ; Test data for a field is chosen firstly out of some bit patterns,
  77 ; then randomly.  It is then interpreted based on whether there
  78 ; is a decode method.
  79 (method-make!
  80  <ifield> 'test-data
  81  (lambda (self n)
  82    (let* ((bf-len (ifld-length self))
  83           (field-max (inexact->exact (round (expt 2 bf-len))))
  84           (highbit (quotient field-max 2))
  85           (values (map (lambda (n)
  86                          (case n
  87                            ((0) 0)
  88                            ((1) (- field-max 1))
  89                            ((2) highbit)
  90                            ((3) (- highbit 1))
  91                            ((4) 1)
  92                            (else (random field-max))))
  93                        (iota n)))
  94           (decode (ifld-decode self)))
  95      (if decode
  96          ; FIXME: need to run the decoder.
  97          values
  98          ; no decode method
  99          (case (mode:class (ifld-mode self))
 100            ((INT) (map (lambda (n) (if (>= n highbit) (- n field-max) n))
 101                        values))
 102            ((UINT) values)
 103            (else (error "unsupported mode class"
 104                         (mode:class (ifld-mode self))))))))
 105 )
 106
 107 (method-make!
 108  <hw-index> 'test-data
 109  (lambda (self n)
 110    (case (hw-index:type self)
 111      ((ifield operand) (send (hw-index:value self) 'test-data n))
 112      ((constant) (hw-index:value self))
 113      (else nil)))
 114 )
 115
 116 (method-make!
 117  <operand> 'test-data
 118  (lambda (self n)
 119    (send (op:type self) 'test-data (send (op:index self) 'test-data n)))
 120 )
 121
 122 ; Given an operand, return a set of N test data.
 123 ; e.g. For a keyword operand, return a random subset.
 124 ; For a number, return N numbers.
 125
 126 (define (operand-test-data op n)
 127   (send op 'test-data n)
 128 )
 129
 130 ; Given the broken out assembler syntax string, return the list of operand
 131 ; objects.
 132
 133 (define (extract-operands syntax-list)
 134   (let loop ((result nil) (l syntax-list))
 135     (cond ((null? l) (reverse! result))
 136           ((object? (car l)) (loop (cons (car l) result) (cdr l)))
 137           (else (loop result (cdr l)))))
 138 )
 139
 140 ; Collate a list of operands into a test test.
 141 ; Input is a list of operand lists. Returns a collated set of test
 142 ; inputs. For example:
 143 ; ((r0 r1 r2) (r3 r4 r5) (2 3 8)) => ((r0 r3 2) (r1 r4 3) (r2 r5 8))
 144
 145 (define (-collate-test-set L)
 146   (if (=? (length (car L)) 0)
 147       '()
 148       (cons (map car L)
 149             (-collate-test-set (map cdr L))))
 150 )
 151
 152 ; Given a list of operands for an instruction, return the test set
 153 ; (all possible combinations).
 154 ; N is the number of testcases for each operand.
 155 ; The result has N to-the-power (length OP-LIST) elements.
 156
 157 (define (build-test-set op-list n)
 158   (let ((test-data (map (lambda (op) (operand-test-data op n)) op-list))
 159         (len (length op-list)))
 160     (cond ((=? len 0) (list (list)))
 161           (else (-collate-test-set test-data))))
 162 )
 163
 164 ; Given an assembler expression and a set of operands build a testcase.
 165 ; TEST-DATA is a list of strings, one element per operand.
 166
 167 (define (build-asm-testcase syntax-list test-data)
 168   (let loop ((result nil) (sl syntax-list) (td test-data))
 169     ;(display (list result sl td "\n"))
 170     (cond ((null? sl)
 171            (string-append "\t"
 172                           (apply string-append (reverse result))
 173                           "\n"))
 174           ((string? (car sl))
 175            (loop (cons (car sl) result) (cdr sl) td))
 176           (else (loop (cons (car td) result) (cdr sl) (cdr td)))))
 177 )
 178
 179 ; Generate the testsuite for INSN.
 180 ; FIXME: make the number of cases an argument to this application.
 181
 182 (define (gen-gas-test insn)
 183   (logit 2 "Generating gas test data for " (obj:name insn) " ...\n")
 184   (string-append
 185    "\t.text\n"
 186    "\t.global " (gen-sym insn) "\n"
 187    (gen-sym insn) ":\n"
 188    (let* ((syntax-list (insn-tmp insn))
 189           (op-list (extract-operands syntax-list))
 190           (test-set (build-test-set op-list 8)))
 191      (string-map (lambda (test-data)
 192                    (build-asm-testcase syntax-list test-data))
 193                  test-set))
 194    )
 195 )
 196
 197 ; Generate the shell script that builds the .d file.
 198 ; .d files contain the objdump result that is used to see whether the
 199 ; testcase passed.
 200 ; We do this by running gas and objdump.
 201 ; Obviously this isn't quite right - bugs in gas or
 202 ; objdump - the things we're testing - will cause an incorrect testsuite to
 203 ; be built and thus the bugs will be missed.  It is *not* intended that this
 204 ; be run immediately before running the testsuite!  Rather, this is run to
 205 ; generate the testsuite which is then inspected for accuracy and checked
 206 ; into CVS.  As bugs in the testsuite are found they are corrected by hand.
 207 ; Or if they're due to bugs in the generator the generator can be rerun and
 208 ; the output diff'd to ensure no errors have crept back in.
 209 ; The point of doing things this way is TO SAVE A HELL OF A LOT OF TYPING!
 210 ; Clearly some hand generated testcases will also be needed, but this
 211 ; provides a good test for each instruction.
 212
 213 (define (cgen-build.sh)
 214   (logit 1 "Generating gas-build.sh ...\n")
 215   (string-append
 216    "\
 217 #/bin/sh
 218 # Generate test result data for " (current-arch-name) " GAS testing.
 219 # This script is machine generated.
 220 # It is intended to be run in the testsuite source directory.
 221 #
 222 # Syntax: build.sh /path/to/build/gas
 223
 224 if [ $# = 0 ] ; then
 225   if [ ! -x ../gas/as-new ] ; then
 226     echo \"Usage: $0 [/path/to/gas/build]\"
 227   else
 228     BUILD=`pwd`/../gas
 229   fi
 230 else
 231   BUILD=$1
 232 fi
 233
 234 if [ ! -x $BUILD/as-new ] ; then
 235   echo \"$BUILD is not a gas build directory\"
 236   exit 1
 237 fi
 238
 239 # Put results here, so we preserve the existing set for comparison.
 240 rm -rf tmpdir
 241 mkdir tmpdir
 242 cd tmpdir
 243
 244 function gentest {
 245     rm -f a.out
 246     $BUILD/as-new ${1}.s -o a.out
 247     echo \"#as:\" >${1}.d
 248     echo \"#objdump: -dr\" >>${1}.d
 249     echo \"#name: $1\" >>${1}.d
 250     $BUILD/../binutils/objdump -dr a.out | \
 251         sed -e 's/(/\\\\(/g' \
 252             -e 's/)/\\\\)/g' \
 253             -e 's/\\$/\\\\$/g' \
 254             -e 's/\\[/\\\\\\[/g' \
 255             -e 's/\\]/\\\\\\]/g' \
 256             -e 's/[+]/\\\\+/g' \
 257             -e 's/[.]/\\\\./g' \
 258             -e 's/[*]/\\\\*/g' | \
 259         sed -e 's/^.*file format.*$/.*: +file format .*/' \
 260         >>${1}.d
 261     rm -f a.out
 262 }
 263
 264 # Now come all the testcases.
 265 cat > allinsn.s <<EOF
 266  .data
 267 foodata: .word 42
 268  .text
 269 footext:\n"
 270     (string-map (lambda (insn)
 271                   (gen-gas-test insn))
 272                 (non-multi-insns (current-insn-list)))
 273     "EOF\n"
 274     "\n"
 275     "# Finally, generate the .d file.\n"
 276     "gentest allinsn\n"
 277    )
 278 )
 279
 280 ; Generate the dejagnu allinsn.exp file that drives the tests.
 281
 282 (define (cgen-allinsn.exp)
 283   (logit 1 "Generating allinsn.exp ...\n")
 284   (string-append
 285    "\
 286 # " (string-upcase (current-arch-name)) " assembler testsuite. -*- Tcl -*-
 287
 288 if [istarget " (current-arch-name) "*-*-*] {
 289     run_dump_test \"allinsn\"
 290 }\n"
 291    )
 292 )