OSDN Git Service

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