-; CPU description file generator for the GAS testsuite.
-; Copyright (C) 2000 Red Hat, Inc.
+; CPU description file generator for the GNU assembler testsuite.
+; Copyright (C) 2000, 2001, 2009 Red Hat, Inc.
; This file is part of CGEN.
; See file COPYING.CGEN for details.
(define (gas-test-analyze!)
(opcodes-analyze!)
(map (lambda (insn)
- (elm-xset! insn 'tmp (syntax-break-out (insn-syntax insn))))
+ (elm-xset! insn 'tmp (syntax-break-out (insn-syntax insn)
+ (obj-isa-list insn))))
(non-multi-insns (current-insn-list)))
*UNSPECIFIED*
)
; The result is a list of strings to be inserted in the assembler
; in the operand's position.
+; For a general assembler operand, just turn the value into a string.
+
(method-make!
<hw-asm> 'test-data
- (lambda (self n)
- ; FIXME: floating point support
- (let ((signed (list 0 1 -1 2 -2))
- (unsigned (list 0 1 2 3 4))
- (mode (elm-get self 'mode)))
- (map number->string
- (list-take n
- (if (eq? (mode:class mode) 'UINT)
- unsigned
- signed)))))
+ (lambda (self ops)
+ (map (lambda (op)
+ (cond ((null? op) "")
+ ((number? op) (number->string op))
+ (else (error "unsupported assembler operand" op))))
+ ops))
)
+; For a keyword operand, choose the appropriate keyword.
+; OPS is a list of values, e.g. from an ifield.
+
(method-make!
<keyword> 'test-data
- (lambda (self n)
- (let* ((values (elm-get self 'values))
- (n (min n (length values))))
- ; FIXME: Need to handle mach variants.
- (map car (list-take n values))))
+ (lambda (self ops)
+ (let* ((test-cases (elm-get self 'values))
+ (prefix (elm-get self 'name-prefix))
+ (find-kw (lambda (val)
+ (find-first (lambda (kw) (= (cadr kw) val)) test-cases))))
+ (map (lambda (n)
+ ;; If an ifield has, e.g., 2 bits (values 0,1,2,3) and the keyword
+ ;; only has two values, e.g. (foo 0) (bar 1), then we can get
+ ;; invalid requests, i.e. for ifield values of 2 and 3.
+ ;; It's not clear what to do here, but it seems like this is an
+ ;; error in the description file.
+ ;; So it seems like we should flag an error for invalid requests.
+ ;; OTOH, we're just generating testcases. So instead we just
+ ;; flag a warning and cope by returning the first keyword in the
+ ;; list.
+ (let ((kw (find-kw n)))
+ (if (not kw)
+ (begin
+ (message "WARNING: Invalid test data request for keyword "
+ (obj:name self)
+ ": "
+ n
+ ".\n"
+ " Compensating by picking a different value.\n")
+ (set! kw (car test-cases))))
+ (string-append
+ (if (and (not (string=? prefix ""))
+ (eq? (string-ref prefix 0) #\$))
+ "\\" "")
+ prefix
+ (->string (car kw)))))
+ ops)))
)
(method-make!
<hw-address> 'test-data
- (lambda (self n)
- (let ((test-data '("foodata" "4" "footext" "-4")))
- (list-take n test-data)))
+ (lambda (self ops)
+ (let* ((test-cases '("foodata" "4" "footext" "-4"))
+ (nr-ops (length ops))
+ (selection (map (lambda (z) (random (length test-cases)))
+ (iota nr-ops))))
+ (map (lambda (n) (list-ref test-cases n)) selection)))
)
(method-make!
<hw-iaddress> 'test-data
- (lambda (self n)
- (let ((test-data '("footext" "4" "foodata" "-4")))
- (list-take n test-data)))
+ (lambda (self ops)
+ (let* ((test-cases '("footext" "4" "foodata" "-4"))
+ (nr-ops (length ops))
+ (selection (map (lambda (z) (random (length test-cases)))
+ (iota nr-ops))))
+ (map (lambda (n) (list-ref test-cases n)) selection)))
)
(method-make-forward! <hw-register> 'indices '(test-data))
(method-make-forward! <hw-immediate> 'values '(test-data))
-; This can't use method-make-forward! as we need to call op:type to
-; resolve the hardware reference.
+; Test data for a field is chosen firstly out of some bit patterns,
+; then randomly. It is then interpreted based on whether there
+; is a decode method.
+
+(method-make!
+ <ifield> 'test-data
+ (lambda (self n)
+ (let* ((bf-len (ifld-length self))
+ (field-max (inexact->exact (round (expt 2 bf-len))))
+ (highbit (quotient field-max 2))
+ (values (map (lambda (n)
+ (case n
+ ((0) 0)
+ ((1) (- field-max 1))
+ ((2) highbit)
+ ((3) (- highbit 1))
+ ((4) 1)
+ (else (random field-max))))
+ (iota n)))
+ (decode (ifld-decode self)))
+ (if decode
+ ; FIXME: need to run the decoder.
+ values
+ ; no decode method
+ (case (mode:class (ifld-mode self))
+ ((INT) (map (lambda (n) (if (>= n highbit) (- n field-max) n))
+ values))
+ ((UINT) values)
+ (else (error "unsupported mode class"
+ (mode:class (ifld-mode self))))))))
+)
+
+;; Return N values for assembler test data, or nil if there are none
+;; (e.g. scalars).
+;; ??? This also returns nil for str-expr and rtx.
+
+(method-make!
+ <hw-index> 'test-data
+ (lambda (self n)
+ (case (hw-index:type self)
+ ((ifield operand) (send (hw-index:value self) 'test-data n))
+ ((constant enum) (make-list n (hw-index-constant-value self)))
+ ((scalar) (make-list n nil))
+ ((str-expr rtx) (make-list n nil)) ;; ???
+ (else (error "invalid hw-index type" (hw-index:type self)))))
+)
(method-make!
<operand> 'test-data
(lambda (self n)
- (send (op:type self) 'test-data n))
+ (send (op:type self) 'test-data (send (op:index self) 'test-data n)))
)
; Given an operand, return a set of N test data.
(else (loop result (cdr l)))))
)
+; Collate a list of operands into a test test.
+; Input is a list of operand lists. Returns a collated set of test
+; inputs. For example:
+; ((r0 r1 r2) (r3 r4 r5) (2 3 8)) => ((r0 r3 2) (r1 r4 3) (r2 r5 8))
+; L is a list of lists. All elements must have the same length.
+
+(define (/collate-test-set L)
+ (if (= (length (car L)) 0)
+ '()
+ (cons (map car L)
+ (/collate-test-set (map cdr L))))
+)
+
; Given a list of operands for an instruction, return the test set
; (all possible combinations).
; N is the number of testcases for each operand.
(define (build-test-set op-list n)
(let ((test-data (map (lambda (op) (operand-test-data op n)) op-list))
(len (length op-list)))
- ; FIXME: Make slicker later.
- (cond ((=? len 0) (list (list)))
- ((=? len 1) test-data)
- (else (list (map car test-data)))))
+ (cond ((= len 0) (list (list)))
+ (else (/collate-test-set test-data))))
)
; Given an assembler expression and a set of operands build a testcase.
)
; Generate the testsuite for INSN.
-; FIXME: This needs to be expanded upon.
+; FIXME: make the number of cases an argument to this application.
(define (gen-gas-test insn)
(logit 2 "Generating gas test data for " (obj:name insn) " ...\n")
(gen-sym insn) ":\n"
(let* ((syntax-list (insn-tmp insn))
(op-list (extract-operands syntax-list))
- (test-set (build-test-set op-list 2)))
- ;(display test-set) (newline)
+ (test-set (build-test-set op-list 8)))
(string-map (lambda (test-data)
(build-asm-testcase syntax-list test-data))
test-set))
(string-append
"\
#/bin/sh
-# Generate test result data for " (current-arch-name) " GAS testing.
+# Generate test result data for " (->string (current-arch-name)) " GAS testing.
# This script is machine generated.
# It is intended to be run in the testsuite source directory.
#
$BUILD/../binutils/objdump -dr a.out | \
sed -e 's/(/\\\\(/g' \
-e 's/)/\\\\)/g' \
+ -e 's/\\$/\\\\$/g' \
-e 's/\\[/\\\\\\[/g' \
-e 's/\\]/\\\\\\]/g' \
-e 's/[+]/\\\\+/g' \
+ -e 's/[.]/\\\\./g' \
-e 's/[*]/\\\\*/g' | \
sed -e 's/^.*file format.*$/.*: +file format .*/' \
>>${1}.d
(logit 1 "Generating allinsn.exp ...\n")
(string-append
"\
-# " (string-upcase (current-arch-name)) " assembler testsuite.
+# " (string-upcase (->string (current-arch-name))) " assembler testsuite. -*- Tcl -*-
-if [istarget " (current-arch-name) "*-*-*] {
+if [istarget " (->string (current-arch-name)) "*-*-*] {
run_dump_test \"allinsn\"
}\n"
)
OSDN Git Service
