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.
6 ; This is invoked to build allinsn.exp and a script to run to
7 ; generate allinsn.s and allinsn.d.
9 ; Specify which application.
10 (set! APPLICATION 'GAS-TEST)
12 ; Called before/after the .cpu file has been read.
14 (define (gas-test-init!) (opcodes-init!))
15 (define (gas-test-finish!) (opcodes-finish!))
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.
20 (define (gas-test-analyze!)
23 (elm-xset! insn 'tmp (syntax-break-out (insn-syntax insn)
24 (obj-isa-list insn))))
25 (non-multi-insns (current-insn-list)))
29 ; Methods to compute test data.
30 ; The result is a list of strings to be inserted in the assembler
31 ; in the operand's position.
33 ; For a general assembler operand, just turn the value into a string.
40 ((number? op) (number->string op))
41 (else (error "unsupported assembler operand" op))))
45 ; For a keyword operand, choose the appropriate keyword.
46 ; OPS is a list of values, e.g. from an ifield.
51 (let* ((test-cases (elm-get self 'values))
52 (prefix (elm-get self 'name-prefix))
53 (find-kw (lambda (val)
54 (find-first (lambda (kw) (= (cadr kw) val)) test-cases))))
56 ;; If an ifield has, e.g., 2 bits (values 0,1,2,3) and the keyword
57 ;; only has two values, e.g. (foo 0) (bar 1), then we can get
58 ;; invalid requests, i.e. for ifield values of 2 and 3.
59 ;; It's not clear what to do here, but it seems like this is an
60 ;; error in the description file.
61 ;; So it seems like we should flag an error for invalid requests.
62 ;; OTOH, we're just generating testcases. So instead we just
63 ;; flag a warning and cope by returning the first keyword in the
65 (let ((kw (find-kw n)))
68 (message "WARNING: Invalid test data request for keyword "
73 " Compensating by picking a different value.\n")
74 (set! kw (car test-cases))))
76 (if (and (not (string=? prefix ""))
77 (eq? (string-ref prefix 0) #\$))
80 (->string (car kw)))))
85 <hw-address> 'test-data
87 (let* ((test-cases '("foodata" "4" "footext" "-4"))
89 (selection (map (lambda (z) (random (length test-cases)))
91 (map (lambda (n) (list-ref test-cases n)) selection)))
95 <hw-iaddress> 'test-data
97 (let* ((test-cases '("footext" "4" "foodata" "-4"))
99 (selection (map (lambda (z) (random (length test-cases)))
101 (map (lambda (n) (list-ref test-cases n)) selection)))
104 (method-make-forward! <hw-register> 'indices '(test-data))
105 (method-make-forward! <hw-immediate> 'values '(test-data))
107 ; Test data for a field is chosen firstly out of some bit patterns,
108 ; then randomly. It is then interpreted based on whether there
109 ; is a decode method.
114 (let* ((bf-len (ifld-length self))
115 (field-max (inexact->exact (round (expt 2 bf-len))))
116 (highbit (quotient field-max 2))
117 (values (map (lambda (n)
120 ((1) (- field-max 1))
124 (else (random field-max))))
126 (decode (ifld-decode self)))
128 ; FIXME: need to run the decoder.
131 (case (mode:class (ifld-mode self))
132 ((INT) (map (lambda (n) (if (>= n highbit) (- n field-max) n))
135 (else (error "unsupported mode class"
136 (mode:class (ifld-mode self))))))))
139 ;; Return N values for assembler test data, or nil if there are none
141 ;; ??? This also returns nil for str-expr and rtx.
144 <hw-index> 'test-data
146 (case (hw-index:type self)
147 ((ifield operand) (send (hw-index:value self) 'test-data n))
148 ((constant enum) (make-list n (hw-index-constant-value self)))
149 ((scalar) (make-list n nil))
150 ((str-expr rtx) (make-list n nil)) ;; ???
151 (else (error "invalid hw-index type" (hw-index:type self)))))
157 (send (op:type self) 'test-data (send (op:index self) 'test-data n)))
160 ; Given an operand, return a set of N test data.
161 ; e.g. For a keyword operand, return a random subset.
162 ; For a number, return N numbers.
164 (define (operand-test-data op n)
165 (send op 'test-data n)
168 ; Given the broken out assembler syntax string, return the list of operand
171 (define (extract-operands syntax-list)
172 (let loop ((result nil) (l syntax-list))
173 (cond ((null? l) (reverse! result))
174 ((object? (car l)) (loop (cons (car l) result) (cdr l)))
175 (else (loop result (cdr l)))))
178 ; Collate a list of operands into a test test.
179 ; Input is a list of operand lists. Returns a collated set of test
180 ; inputs. For example:
181 ; ((r0 r1 r2) (r3 r4 r5) (2 3 8)) => ((r0 r3 2) (r1 r4 3) (r2 r5 8))
182 ; L is a list of lists. All elements must have the same length.
184 (define (/collate-test-set L)
185 (if (= (length (car L)) 0)
188 (/collate-test-set (map cdr L))))
191 ; Given a list of operands for an instruction, return the test set
192 ; (all possible combinations).
193 ; N is the number of testcases for each operand.
194 ; The result has N to-the-power (length OP-LIST) elements.
196 (define (build-test-set op-list n)
197 (let ((test-data (map (lambda (op) (operand-test-data op n)) op-list))
198 (len (length op-list)))
199 (cond ((= len 0) (list (list)))
200 (else (/collate-test-set test-data))))
203 ; Given an assembler expression and a set of operands build a testcase.
204 ; TEST-DATA is a list of strings, one element per operand.
206 (define (build-asm-testcase syntax-list test-data)
207 (let loop ((result nil) (sl syntax-list) (td test-data))
208 ;(display (list result sl td "\n"))
211 (apply string-append (reverse result))
214 (loop (cons (car sl) result) (cdr sl) td))
215 (else (loop (cons (car td) result) (cdr sl) (cdr td)))))
218 ; Generate the testsuite for INSN.
219 ; FIXME: make the number of cases an argument to this application.
221 (define (gen-gas-test insn)
222 (logit 2 "Generating gas test data for " (obj:name insn) " ...\n")
225 "\t.global " (gen-sym insn) "\n"
227 (let* ((syntax-list (insn-tmp insn))
228 (op-list (extract-operands syntax-list))
229 (test-set (build-test-set op-list 8)))
230 (string-map (lambda (test-data)
231 (build-asm-testcase syntax-list test-data))
236 ; Generate the shell script that builds the .d file.
237 ; .d files contain the objdump result that is used to see whether the
239 ; We do this by running gas and objdump.
240 ; Obviously this isn't quite right - bugs in gas or
241 ; objdump - the things we're testing - will cause an incorrect testsuite to
242 ; be built and thus the bugs will be missed. It is *not* intended that this
243 ; be run immediately before running the testsuite! Rather, this is run to
244 ; generate the testsuite which is then inspected for accuracy and checked
245 ; into CVS. As bugs in the testsuite are found they are corrected by hand.
246 ; Or if they're due to bugs in the generator the generator can be rerun and
247 ; the output diff'd to ensure no errors have crept back in.
248 ; The point of doing things this way is TO SAVE A HELL OF A LOT OF TYPING!
249 ; Clearly some hand generated testcases will also be needed, but this
250 ; provides a good test for each instruction.
252 (define (cgen-build.sh)
253 (logit 1 "Generating gas-build.sh ...\n")
257 # Generate test result data for " (->string (current-arch-name)) " GAS testing.
258 # This script is machine generated.
259 # It is intended to be run in the testsuite source directory.
261 # Syntax: build.sh /path/to/build/gas
264 if [ ! -x ../gas/as-new ] ; then
265 echo \"Usage: $0 [/path/to/gas/build]\"
273 if [ ! -x $BUILD/as-new ] ; then
274 echo \"$BUILD is not a gas build directory\"
278 # Put results here, so we preserve the existing set for comparison.
285 $BUILD/as-new ${1}.s -o a.out
286 echo \"#as:\" >${1}.d
287 echo \"#objdump: -dr\" >>${1}.d
288 echo \"#name: $1\" >>${1}.d
289 $BUILD/../binutils/objdump -dr a.out | \
290 sed -e 's/(/\\\\(/g' \
293 -e 's/\\[/\\\\\\[/g' \
294 -e 's/\\]/\\\\\\]/g' \
297 -e 's/[*]/\\\\*/g' | \
298 sed -e 's/^.*file format.*$/.*: +file format .*/' \
303 # Now come all the testcases.
304 cat > allinsn.s <<EOF
309 (string-map (lambda (insn)
311 (non-multi-insns (current-insn-list)))
314 "# Finally, generate the .d file.\n"
319 ; Generate the dejagnu allinsn.exp file that drives the tests.
321 (define (cgen-allinsn.exp)
322 (logit 1 "Generating allinsn.exp ...\n")
325 # " (string-upcase (->string (current-arch-name))) " assembler testsuite. -*- Tcl -*-
327 if [istarget " (->string (current-arch-name)) "*-*-*] {
328 run_dump_test \"allinsn\"