cgen/gas-test.scm

   1 ; CPU description file generator for the GNU assembler testsuite.
   2 ; Copyright (C) 2000, 2001 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 (method-make!
  33  <hw-asm> 'test-data
  34  (lambda (self n)
  35    ; FIXME: floating point support
  36    (let* ((signed (list 0 1 -1 2 -2))
  37           (unsigned (list 0 1 2 3 4))
  38           (mode (elm-get self 'mode))
  39           (test-cases (if (eq? (mode:class mode) 'UINT) unsigned signed))
  40           (selection (map (lambda (z) (random (length test-cases))) (iota n))))
  41      ; FIXME: wider ranges.
  42      (map number->string
  43           (map (lambda (n) (list-ref test-cases n)) selection))))
  44 )
  45
  46 (method-make!
  47  <keyword> 'test-data
  48  (lambda (self n)
  49    (let* ((test-cases (elm-get self 'values))
  50           (selection (map (lambda (z) (random (length test-cases))) (iota n))))
  51      (map (lambda (n) (car (list-ref test-cases n))) selection)))
  52 )
  53
  54 (method-make!
  55  <hw-address> 'test-data
  56  (lambda (self n)
  57    (let* ((test-cases '("foodata" "4" "footext" "-4"))
  58           (selection (map (lambda (z) (random (length test-cases))) (iota n))))
  59      (map (lambda (n) (list-ref test-cases n)) selection)))
  60 )
  61
  62 (method-make!
  63  <hw-iaddress> 'test-data
  64  (lambda (self n)
  65    (let* ((test-cases '("footext" "4" "foodata" "-4"))
  66           (selection (map (lambda (z) (random (length test-cases))) (iota n))))
  67      (map (lambda (n) (list-ref test-cases n)) selection)))
  68 )
  69
  70 (method-make-forward! <hw-register> 'indices '(test-data))
  71 (method-make-forward! <hw-immediate> 'values '(test-data))
  72
  73 ; This can't use method-make-forward! as we need to call op:type to
  74 ; resolve the hardware reference.
  75
  76 (method-make!
  77  <operand> 'test-data
  78  (lambda (self n)
  79    (send (op:type self) 'test-data n))
  80 )
  81
  82 ; Given an operand, return a set of N test data.
  83 ; e.g. For a keyword operand, return a random subset.
  84 ; For a number, return N numbers.
  85
  86 (define (operand-test-data op n)
  87   (send op 'test-data n)
  88 )
  89
  90 ; Given the broken out assembler syntax string, return the list of operand
  91 ; objects.
  92
  93 (define (extract-operands syntax-list)
  94   (let loop ((result nil) (l syntax-list))
  95     (cond ((null? l) (reverse! result))
  96           ((object? (car l)) (loop (cons (car l) result) (cdr l)))
  97           (else (loop result (cdr l)))))
  98 )
  99
 100 ; Collate a list of operands into a test test.
 101 ; Input is a list of operand lists. Returns a collated set of test
 102 ; inputs. For example:
 103 ; ((r0 r1 r2) (r3 r4 r5) (2 3 8)) => ((r0 r3 2) (r1 r4 3) (r2 r5 8))
 104
 105 (define (-collate-test-set L)
 106   (if (=? (length (car L)) 0)
 107       '()
 108       (cons (map car L)
 109             (-collate-test-set (map cdr L))))
 110 )
 111
 112 ; Given a list of operands for an instruction, return the test set
 113 ; (all possible combinations).
 114 ; N is the number of testcases for each operand.
 115 ; The result has N to-the-power (length OP-LIST) elements.
 116
 117 (define (build-test-set op-list n)
 118   (let ((test-data (map (lambda (op) (operand-test-data op n)) op-list))
 119         (len (length op-list)))
 120     (cond ((=? len 0) (list (list)))
 121           (else (-collate-test-set test-data))))
 122 )
 123
 124 ; Given an assembler expression and a set of operands build a testcase.
 125 ; TEST-DATA is a list of strings, one element per operand.
 126
 127 (define (build-asm-testcase syntax-list test-data)
 128   (let loop ((result nil) (sl syntax-list) (td test-data))
 129     ;(display (list result sl td "\n"))
 130     (cond ((null? sl)
 131            (string-append "\t"
 132                           (apply string-append (reverse result))
 133                           "\n"))
 134           ((string? (car sl))
 135            (loop (cons (car sl) result) (cdr sl) td))
 136           (else (loop (cons (car td) result) (cdr sl) (cdr td)))))
 137 )
 138
 139 ; Generate the testsuite for INSN.
 140 ; FIXME: make the number of cases an argument to this application.
 141
 142 (define (gen-gas-test insn)
 143   (logit 2 "Generating gas test data for " (obj:name insn) " ...\n")
 144   (string-append
 145    "\t.text\n"
 146    "\t.global " (gen-sym insn) "\n"
 147    (gen-sym insn) ":\n"
 148    (let* ((syntax-list (insn-tmp insn))
 149           (op-list (extract-operands syntax-list))
 150           (test-set (build-test-set op-list 5)))
 151      (string-map (lambda (test-data)
 152                    (build-asm-testcase syntax-list test-data))
 153                  test-set))
 154    )
 155 )
 156
 157 ; Generate the shell script that builds the .d file.
 158 ; .d files contain the objdump result that is used to see whether the
 159 ; testcase passed.
 160 ; We do this by running gas and objdump.
 161 ; Obviously this isn't quite right - bugs in gas or
 162 ; objdump - the things we're testing - will cause an incorrect testsuite to
 163 ; be built and thus the bugs will be missed.  It is *not* intended that this
 164 ; be run immediately before running the testsuite!  Rather, this is run to
 165 ; generate the testsuite which is then inspected for accuracy and checked
 166 ; into CVS.  As bugs in the testsuite are found they are corrected by hand.
 167 ; Or if they're due to bugs in the generator the generator can be rerun and
 168 ; the output diff'd to ensure no errors have crept back in.
 169 ; The point of doing things this way is TO SAVE A HELL OF A LOT OF TYPING!
 170 ; Clearly some hand generated testcases will also be needed, but this
 171 ; provides a good test for each instruction.
 172
 173 (define (cgen-build.sh)
 174   (logit 1 "Generating gas-build.sh ...\n")
 175   (string-append
 176    "\
 177 #/bin/sh
 178 # Generate test result data for " (current-arch-name) " GAS testing.
 179 # This script is machine generated.
 180 # It is intended to be run in the testsuite source directory.
 181 #
 182 # Syntax: build.sh /path/to/build/gas
 183
 184 if [ $# = 0 ] ; then
 185   if [ ! -x ../gas/as-new ] ; then
 186     echo \"Usage: $0 [/path/to/gas/build]\"
 187   else
 188     BUILD=`pwd`/../gas
 189   fi
 190 else
 191   BUILD=$1
 192 fi
 193
 194 if [ ! -x $BUILD/as-new ] ; then
 195   echo \"$BUILD is not a gas build directory\"
 196   exit 1
 197 fi
 198
 199 # Put results here, so we preserve the existing set for comparison.
 200 rm -rf tmpdir
 201 mkdir tmpdir
 202 cd tmpdir
 203
 204 function gentest {
 205     rm -f a.out
 206     $BUILD/as-new ${1}.s -o a.out
 207     echo \"#as:\" >${1}.d
 208     echo \"#objdump: -dr\" >>${1}.d
 209     echo \"#name: $1\" >>${1}.d
 210     $BUILD/../binutils/objdump -dr a.out | \
 211         sed -e 's/(/\\\\(/g' \
 212             -e 's/)/\\\\)/g' \
 213             -e 's/\\[/\\\\\\[/g' \
 214             -e 's/\\]/\\\\\\]/g' \
 215             -e 's/[+]/\\\\+/g' \
 216             -e 's/[*]/\\\\*/g' | \
 217         sed -e 's/^.*file format.*$/.*: +file format .*/' \
 218         >>${1}.d
 219     rm -f a.out
 220 }
 221
 222 # Now come all the testcases.
 223 cat > allinsn.s <<EOF
 224  .data
 225 foodata: .word 42
 226  .text
 227 footext:\n"
 228     (string-map (lambda (insn)
 229                   (gen-gas-test insn))
 230                 (non-multi-insns (current-insn-list)))
 231     "EOF\n"
 232     "\n"
 233     "# Finally, generate the .d file.\n"
 234     "gentest allinsn\n"
 235    )
 236 )
 237
 238 ; Generate the dejagnu allinsn.exp file that drives the tests.
 239
 240 (define (cgen-allinsn.exp)
 241   (logit 1 "Generating allinsn.exp ...\n")
 242   (string-append
 243    "\
 244 # " (string-upcase (current-arch-name)) " assembler testsuite. -*- Tcl -*-
 245
 246 if [istarget " (current-arch-name) "*-*-*] {
 247     run_dump_test \"allinsn\"
 248 }\n"
 249    )
 250 )