cgen/sim-test.scm

   1 ; CPU description file generator for the simulator testsuite.
   2 ; Copyright (C) 2000 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 'SIM-TEST)
  11 \f
  12 ; Called before/after the .cpu file has been read.
  13
  14 (define (sim-test-init!) (opcodes-init!))
  15 (define (sim-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 (sim-test-analyze!)
  21   (opcodes-analyze!)
  22   (map (lambda
  23            (insn) (elm-xset! insn 'tmp (syntax-break-out (insn-syntax insn))))
  24        (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      (map number->string
  40           (list-take n
  41                      (if (eq? (mode:class mode) 'UINT)
  42                          unsigned
  43                          signed)))))
  44 )
  45
  46 (method-make!
  47  <keyword> 'test-data
  48  (lambda (self n)
  49    (let* ((values (elm-get self 'values))
  50           (n (min n (length values))))
  51      ; FIXME: Need to handle mach variants.
  52      (map car (list-take n values))))
  53 )
  54
  55 (method-make!
  56  <hw-address> 'test-data
  57  (lambda (self n)
  58    (let ((test-data '("foodata" "4" "footext" "-4")))
  59      (list-take n test-data)))
  60 )
  61
  62 (method-make!
  63  <hw-iaddress> 'test-data
  64  (lambda (self n)
  65    (let ((test-data '("footext" "4" "foodata" "-4")))
  66      (list-take n test-data)))
  67 )
  68
  69 (method-make-forward! <hw-register> 'indices '(test-data))
  70 (method-make-forward! <hw-immediate> 'values '(test-data))
  71
  72 ; This can't use method-make-forward! as we need to call op:type to
  73 ; resolve the hardware reference.
  74
  75 (method-make!
  76  <operand> 'test-data
  77  (lambda (self n)
  78    (send (op:type self) 'test-data n))
  79 )
  80
  81 ; Given an operand, return a set of N test data.
  82 ; e.g. For a keyword operand, return a random subset.
  83 ; For a number, return N numbers.
  84
  85 (define (operand-test-data op n)
  86   (send op 'test-data n)
  87 )
  88
  89 ; Given the broken out assembler syntax string, return the list of operand
  90 ; objects.
  91
  92 (define (extract-operands syntax-list)
  93   (let loop ((result nil) (l syntax-list))
  94     (cond ((null? l) (reverse result))
  95           ((object? (car l)) (loop (cons (car l) result) (cdr l)))
  96           (else (loop result (cdr l)))))
  97 )
  98
  99 ; Given a list of operands for an instruction, return the test set
 100 ; (all possible combinations).
 101 ; N is the number of testcases for each operand.
 102 ; The result has N to-the-power (length OP-LIST) elements.
 103
 104 (define (build-test-set op-list n)
 105   (let ((test-data (map (lambda (op) (operand-test-data op n)) op-list))
 106         (len (length op-list)))
 107     ; FIXME: Make slicker later.
 108     (cond ((=? len 0) (list (list)))
 109           ((=? len 1) test-data)
 110           (else (list (map car test-data)))))
 111 )
 112
 113 ; Given an assembler expression and a set of operands build a testcase.
 114 ; SYNTAX-LIST is a list of syntax elements (characters) and <operand> objects.
 115 ; TEST-DATA is a list of strings, one element per operand.
 116 ; FIXME: wip
 117
 118 (define (build-sim-testcase syntax-list test-data)
 119   (logit 3 "Building a testcase for: "
 120          (map (lambda (sl)
 121                 (string-append " "
 122                                (cond ((string? sl)
 123                                       sl)
 124                                      ((operand? sl)
 125                                       (obj:name sl))
 126                                      (else
 127                                       (with-output-to-string
 128                                         (lambda () (display sl)))))))
 129               syntax-list)
 130          ", test data: "
 131          (map (lambda (td) (list " " td))
 132               test-data)
 133          "\n")
 134   (let loop ((result nil) (sl syntax-list) (td test-data))
 135     ;(display (list result sl td "\n"))
 136     (cond ((null? sl)
 137            (string-append "\t"
 138                           (apply string-append (reverse result))
 139                           "\n"))
 140           ((string? (car sl))
 141            (loop (cons (car sl) result) (cdr sl) td))
 142           (else (loop (cons (car td) result) (cdr sl) (cdr td)))))
 143 )
 144
 145 ; Generate a set of testcases for INSN.
 146 ; FIXME: wip
 147
 148 (define (gen-sim-test insn)
 149   (logit 2 "Generating sim test set for " (obj:name insn) " ...\n")
 150   (string-append
 151    "\t.global " (gen-sym insn) "\n"
 152    (gen-sym insn) ":\n"
 153    (let* ((syntax-list (insn-tmp insn))
 154           (op-list (extract-operands syntax-list))
 155           (test-set (build-test-set op-list 2)))
 156      (string-map (lambda (test-data)
 157                    (build-sim-testcase syntax-list test-data))
 158                  test-set))
 159    )
 160 )
 161 \f
 162 ; Generate the shell script that builds the .cgs files.
 163 ; .cgs are .s files except that there may be other .s files in the directory
 164 ; and we want the .exp driver script to easily find the files.
 165 ;
 166 ; Eventually it would be nice to generate as much of the testcase as possible.
 167 ; For now we just generate the template and leave the programmer to fill in
 168 ; the guts of the test (i.e. set up various registers, execute the insn to be
 169 ; tested, and then verify the results).
 170 ; Clearly some hand generated testcases will also be needed, but this
 171 ; provides a good start for each instruction.
 172
 173 (define (cgen-build.sh)
 174   (logit 1 "Generating sim-build.sh ...\n")
 175   (string-append
 176    "\
 177 #/bin/sh
 178 # Generate test result data for " (current-arch-name) " simulator testing.
 179 # This script is machine generated.
 180 # It is intended to be run in the testsuite source directory.
 181 #
 182 # Syntax: /bin/sh sim-build.sh
 183
 184 # Put results here, so we preserve the existing set for comparison.
 185 rm -rf tmpdir
 186 mkdir tmpdir
 187 cd tmpdir
 188 \n"
 189
 190     (string-map (lambda (insn)
 191                   (string-append
 192                    "cat <<EOF > " (gen-file-name (obj:name insn)) ".cgs\n"
 193                    ; FIXME: Need to record assembler line comment char in .cpu.
 194                    "# " (current-arch-name) " testcase for " (backslash "$" (insn-syntax insn)) "\n"
 195                    "# mach: "
 196                    (let ((machs (insn-machs insn)))
 197                      (if (null? machs)
 198                          "all"
 199                          (string-drop1 (string-map (lambda (mach)
 200                                                      (string-append "," mach))
 201                                                    machs))))
 202                    "\n\n"
 203                    "\t.include \"testutils.inc\"\n\n"
 204                    "\tstart\n\n"
 205                    (gen-sim-test insn)
 206                    "\n\tpass\n"
 207                    "EOF\n\n"))
 208                 (non-alias-insns (current-insn-list)))
 209    )
 210 )
 211
 212 ; Generate the dejagnu allinsn.exp file that drives the tests.
 213
 214 (define (cgen-allinsn.exp)
 215   (logit 1 "Generating sim-allinsn.exp ...\n")
 216   (string-append
 217    "\
 218 # " (string-upcase (current-arch-name)) " simulator testsuite.
 219
 220 if [istarget " (current-arch-name) "*-*-*] {
 221     # load support procs (none yet)
 222     # load_lib cgen.exp
 223
 224     # all machines
 225     set all_machs \""
 226    (string-drop1 (string-map (lambda (m)
 227                                (string-append " "
 228                                               (gen-sym m)))
 229                              (current-mach-list)))
 230    "\"
 231
 232     # The .cgs suffix is for \"cgen .s\".
 233     foreach src [lsort [glob -nocomplain $srcdir/$subdir/*.cgs]] {
 234         # If we're only testing specific files and this isn't one of them,
 235         # skip it.
 236         if ![runtest_file_p $runtests $src] {
 237             continue
 238         }
 239
 240         run_sim_test $src $all_machs
 241     }
 242 }\n"
 243    )
 244 )