[Patch] Improved gas testsuite generator

[Ben Elliston]

I've improved the gas testsuite generator to produce more numerous and
varied inputs.  It's still far from ideal, but it's an improvement
over what was there.  A few comments about this work:

+ A pseudo random number generator is used with a fixed seed.  This
  means that the test cases will be predictable from one run of
  gas-test.scm to the next -- having the entire testsuite change every
  time the generator is run is undesirable!

+ The Scheme implementation of this PRN generator is licensed under the
  GPL and comes from John David Stone at Grinnell College:

  http://www.cs.grinnell.edu/~stone/programs/random-number-generator.ss

  I assume this will be okay to use in our tree.

+ Fortunately, this is not meant to generate testsuites ready to check
  into CVS -- they frequently need hand massaging.  The <keyword>
  test-data method returns a random keyword for a register banks which
  may not be valid in the assembly language (ie. `mov #10, sp') may be
  invalid.  I felt that it was better to retain generality and for
  such cases to be corrected by hand -- perhaps by replacing those
  keywords with a valid register keyword like `r1'.

+ I have not attempted to handle generating wider ranges of inputs for
  immediate values (ie. operands of type h-sint or h-uint).  I
  couldn't easily discover how this could be done, in light of
  multi-ifields and other complications.  Suggestions welcome!

I have tested this on a couple of ports with good results.  Okay to
commit?

2001-03-24  Ben Elliston  <bje@redhat.com>

	* gas-test.scm (<hw-asm>,test-data): Choose pseudo-random data.
	(<keyword>,test-data): Likewise.
	(<hw-address>,test-data): Likewise.
	(<hw-iaddress>,test-data): Likewise.
	(-collate-test-set): New function.
	(build-test-set): Use it.
	(gen-gas-test): Generate five test cases per instruction.
	(cgen-allinsn.exp): Include "-*- Tcl -*-" in DejaGNU test file.

	* read.scm: Load "slib/random" if random is not defined.
	* slib/random.scm: New file.

Index: gas-test.scm
===================================================================
RCS file: /cvs/cvsfiles/devo/cgen/gas-test.scm,v
retrieving revision 1.27
diff -u -c -r1.27 gas-test.scm
*** gas-test.scm	2000/10/31 23:52:15	1.27
--- gas-test.scm	2001/03/24 00:38:07
***************
*** 1,5 ****
! ; CPU description file generator for the GAS testsuite.
! ; Copyright (C) 2000 Red Hat, Inc.
  ; This file is part of CGEN.
  ; See file COPYING.CGEN for details.
  
--- 1,5 ----
! ; CPU description file generator for the GNU assembler testsuite.
! ; Copyright (C) 2000, 2001 Red Hat, Inc.
  ; This file is part of CGEN.
  ; See file COPYING.CGEN for details.
  
***************
*** 33,69 ****
   <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)))))
  )
  
  (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))))
  )
  
  (method-make!
   <hw-address> 'test-data
   (lambda (self n)
!    (let ((test-data '("foodata" "4" "footext" "-4")))
!      (list-take n test-data)))
  )
  
  (method-make!
   <hw-iaddress> 'test-data
   (lambda (self n)
!    (let ((test-data '("footext" "4" "foodata" "-4")))
!      (list-take n test-data)))
  )
  
  (method-make-forward! <hw-register> 'indices '(test-data))
--- 33,70 ----
   <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))
! 	  (test-cases (if (eq? (mode:class mode) 'UINT) unsigned signed))
! 	  (selection (map (lambda (z) (random (length test-cases))) (iota n))))
!      ; FIXME: wider ranges.
       (map number->string
! 	  (map (lambda (n) (list-ref test-cases n)) selection))))
  )
  
  (method-make!
   <keyword> 'test-data
   (lambda (self n)
!    (let* ((test-cases (elm-get self 'values))
! 	  (selection (map (lambda (z) (random (length test-cases))) (iota n))))
!      (map (lambda (n) (car (list-ref test-cases n))) selection)))
  )
  
  (method-make!
   <hw-address> 'test-data
   (lambda (self n)
!    (let* ((test-cases '("foodata" "4" "footext" "-4"))
! 	  (selection (map (lambda (z) (random (length test-cases))) (iota n))))
!      (map (lambda (n) (list-ref test-cases n)) selection)))
  )
  
  (method-make!
   <hw-iaddress> 'test-data
   (lambda (self n)
!    (let* ((test-cases '("footext" "4" "foodata" "-4"))
! 	  (selection (map (lambda (z) (random (length test-cases))) (iota n))))
!      (map (lambda (n) (list-ref test-cases n)) selection)))
  )
  
  (method-make-forward! <hw-register> 'indices '(test-data))
***************
*** 96,101 ****
--- 97,114 ----
  	  (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))
+ 
+ (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.
***************
*** 104,113 ****
  (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)))))
  )
  
  ; Given an assembler expression and a set of operands build a testcase.
--- 117,124 ----
  (define (build-test-set op-list n)
    (let ((test-data (map (lambda (op) (operand-test-data op n)) op-list))
  	(len (length op-list)))
      (cond ((=? len 0) (list (list)))
! 	  (else (-collate-test-set test-data))))
  )
  
  ; Given an assembler expression and a set of operands build a testcase.
***************
*** 126,132 ****
  )
  
  ; Generate the testsuite for INSN.
! ; FIXME: This needs to be expanded upon.
  
  (define (gen-gas-test insn)
    (logit 2 "Generating gas test data for " (obj:name insn) " ...\n")
--- 137,143 ----
  )
  
  ; Generate the testsuite for INSN.
! ; 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")
***************
*** 136,143 ****
     (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)
       (string-map (lambda (test-data)
  		   (build-asm-testcase syntax-list test-data))
  		 test-set))
--- 147,153 ----
     (gen-sym insn) ":\n"
     (let* ((syntax-list (insn-tmp insn))
  	  (op-list (extract-operands syntax-list))
! 	  (test-set (build-test-set op-list 5)))
       (string-map (lambda (test-data)
  		   (build-asm-testcase syntax-list test-data))
  		 test-set))
***************
*** 231,237 ****
    (logit 1 "Generating allinsn.exp ...\n")
    (string-append
     "\
! # " (string-upcase (current-arch-name)) " assembler testsuite.
  
  if [istarget " (current-arch-name) "*-*-*] {
      run_dump_test \"allinsn\"
--- 241,247 ----
    (logit 1 "Generating allinsn.exp ...\n")
    (string-append
     "\
! # " (string-upcase (current-arch-name)) " assembler testsuite. -*- Tcl -*-
  
  if [istarget " (current-arch-name) "*-*-*] {
      run_dump_test \"allinsn\"


Index: read.scm
===================================================================
RCS file: /cvs/cvsfiles/devo/cgen/read.scm,v
retrieving revision 1.25
diff -u -c -r1.25 read.scm
*** read.scm	2001/01/08 18:41:14	1.25
--- read.scm	2001/03/24 00:38:53
***************
*** 1,5 ****
  ; Top level file for reading and recording .cpu file contents.
! ; Copyright (C) 2000 Red Hat, Inc.
  ; This file is part of CGEN.
  ; See file COPYING.CGEN for details.
  
--- 1,5 ----
  ; Top level file for reading and recording .cpu file contents.
! ; Copyright (C) 2000, 2001 Red Hat, Inc.
  ; This file is part of CGEN.
  ; See file COPYING.CGEN for details.
  
***************
*** 58,65 ****
  ;   usually these procs return "*UNSPECIFIED*"
  ; - all -foo-parse,parse-foo procs shall have `context' as the first arg
  ;   [FIXME: not all such procs have been converted]
! ; - stay away from non-portable C symbols, it makes using hobbit more difficult
! ;   e.g. don't have anything named `index', sigh.
  
  ; Variables representing misc. global constants.
  
--- 58,64 ----
  ;   usually these procs return "*UNSPECIFIED*"
  ; - all -foo-parse,parse-foo procs shall have `context' as the first arg
  ;   [FIXME: not all such procs have been converted]
! ; - stay away from non-portable C symbols.
  
  ; Variables representing misc. global constants.
  
***************
*** 167,172 ****
--- 166,172 ----
  ; Used to pretty-print debugging messages.
  (maybe-load "slib/pp" #f 'pretty-print)
  ; Used by pretty-print.
+ (maybe-load "slib/random" #f 'random)
  (maybe-load "slib/genwrite" #f 'generic-write)
  (maybe-load "utils" #f 'logit)
  (maybe-load "utils-cgen" "utils_cgen" 'obj:name)