From df28252cdbee8c502b99263cce58528a3c800ed1 Mon Sep 17 00:00:00 2001 From: devans Date: Fri, 29 Jan 2010 02:59:01 +0000 Subject: [PATCH] * pmacros.scm (pmacros-init!): New arg rtl-version, all callers updated. Use %-prefix if rtl-version >= 0.9. * read.scm (/supported-rtl-versions): Add (0 9). (/rtl-version-valid?): New function. (/cmd-define-rtl-version): If new rtl version, reinvoke pmacros-init!. (/reader-expr): New function. (reader-process): New function. (/reader-process-with-loc!): Renamed from /reader-process!. Don't pre-expand `if' commands. (/cmd-if): Simplify. Pmacro-expand test, then, else clauses here. Handle rtl-version-equal?, rtl-version-at-least?. * testsuite/Makefile.am (clean-test-files): Remove *.test.cpu*. * testsuite/Makefile.in: Regenerate. * testsuite/pmacros-1.test: Test both . and % as prefixes. * testsuite/testsuite.cpu (/begin, /print, /dump): New pmacros. (newline, print-match, print-expr, print-thunk): Use them. (internal-verify): Update definition. * doc/rtl.texi (define-rtl-version): Document rtl version 0.9. (Top level conditionals): New node. --- cgen/ChangeLog | 20 +++ cgen/doc/rtl.texi | 72 ++++++++- cgen/pmacros.scm | 28 ++-- cgen/read.scm | 143 +++++++++++------- cgen/testsuite/Makefile.am | 2 +- cgen/testsuite/Makefile.in | 2 +- cgen/testsuite/pmacros-1.test | 338 ++++++++++++++++++++++-------------------- cgen/testsuite/testsuite.cpu | 44 ++++-- 8 files changed, 405 insertions(+), 244 deletions(-) diff --git a/cgen/ChangeLog b/cgen/ChangeLog index beb5bfa426..97d629b7b2 100644 --- a/cgen/ChangeLog +++ b/cgen/ChangeLog @@ -1,5 +1,25 @@ 2010-01-28 Doug Evans + * pmacros.scm (pmacros-init!): New arg rtl-version, all callers + updated. Use %-prefix if rtl-version >= 0.9. + * read.scm (/supported-rtl-versions): Add (0 9). + (/rtl-version-valid?): New function. + (/cmd-define-rtl-version): If new rtl version, reinvoke pmacros-init!. + (/reader-expr): New function. + (reader-process): New function. + (/reader-process-with-loc!): Renamed from /reader-process!. + Don't pre-expand `if' commands. + (/cmd-if): Simplify. Pmacro-expand test, then, else clauses here. + Handle rtl-version-equal?, rtl-version-at-least?. + * testsuite/Makefile.am (clean-test-files): Remove *.test.cpu*. + * testsuite/Makefile.in: Regenerate. + * testsuite/pmacros-1.test: Test both . and % as prefixes. + * testsuite/testsuite.cpu (/begin, /print, /dump): New pmacros. + (newline, print-match, print-expr, print-thunk): Use them. + (internal-verify): Update definition. + * doc/rtl.texi (define-rtl-version): Document rtl version 0.9. + (Top level conditionals): New node. + * read.scm (rtl-version-at-least?): Fix typo. 2010-01-27 Doug Evans diff --git a/cgen/doc/rtl.texi b/cgen/doc/rtl.texi index b6cf4af237..6b63d957b9 100644 --- a/cgen/doc/rtl.texi +++ b/cgen/doc/rtl.texi @@ -1,4 +1,4 @@ -@c Copyright (C) 2000, 2003, 2009 Red Hat, Inc. +@c Copyright (C) 2000, 2003, 2009, 2010 Red Hat, Inc. @c This file is part of the CGEN manual. @c For copying conditions, see the file cgen.texi. @@ -15,6 +15,7 @@ its CPU description language. * Trade-offs:: Various trade-offs in the design * Rules and notes:: Rules and notes common to all entries * RTL Versions:: Supported versions and differences +* Top level conditionals:: Conditional definitions * Definitions:: Definitions in the description file * Attributes:: Random data associated with any entry * Architecture variants:: Specifying variations of a CPU @@ -175,6 +176,7 @@ Syntax: When setting the RTL version, it must be the first thing done in the description file or the behaviour is undefined. +This includes using or defining pmacros, the RTL version must be set first. After the RTL version is set, if it is changed the behavior is undefined. Note that one can still set it to the same version multiple times. @@ -183,10 +185,10 @@ and one is debugging/testing files individually. The default RTL version, if @samp{define-rtl-version} is elided, is 0.7. -The latest RTL version is 0.8: +The latest RTL version is 0.9: @example -(define-rtl-version 0 8) +(define-rtl-version 0 9) @end example Every increment in major and minor versions is generally non-upward @@ -251,8 +253,72 @@ When computing complete enum names with @samp{print-name}, CGEN adds a @samp{-} between the prefix and the enum name. CGEN does not insert a @samp{-} with @samp{enum-prefix}. +@item 0.9 @code{(define-rtl-version 0 9)} + +This version changed the prefix of pmacros from @samp{.} to @samp{%}. +@samp{.pmacro} is changed to @samp{%pmacro}. + @end itemize +@node Top level conditionals +@section Top level conditionals +@cindex Top level conditionals + +CGEN supports conditionally defining objects through the use of @samp{if} +and some specialized predicates. These must appear at the ``top level'', +i.e., not inside any other expression, except @samp{begin}. + +The following predicates are supported: + +@itemize @bullet + +@item (keep-isa? (isa-list)) +Return ``true'' if any ISA in @samp{isa-list} is being kept. +This is controlled by the @samp{-i} option. + +@item (keep-mach? (machine-list)) +Return ``true'' if any machine in @samp{machine-list} is being kept. +This is controlled by the @samp{-m} option. + +@item (application-is? application) +Return ``true'' if the current application generator is @samp{application}. + +@item (rtl-version-equal? major minor) +Return ``true'' if the RTL version specified by the @file{.cpu} file is +@samp{major.minor}. + +@item (rtl-version-at-least? major minor) +Return ``true'' if the RTL version specified by the @file{.cpu} file is +at least @samp{major.minor}. + +@end itemize + +Here's an example from the CGEN testsuite. +It is used to write some wrappers around a few builtin pmacros +that are independent of the pmacro prefix character. + +@smallexample +(if (rtl-version-at-least? 0 9) + (begin + (define-pmacro /begin %begin) + (define-pmacro /print %print) + (define-pmacro /dump %dump)) + (begin + (define-pmacro /begin .begin) + (define-pmacro /print .print) + (define-pmacro /dump .dump))) +@end smallexample + +Here's an example from the @samp{SH} cpu description. + +@smallexample +(if (keep-isa? (compact)) + (include "sh64-compact.cpu")) + +(if (keep-isa? (media)) + (include "sh64-media.cpu")) +@end smallexample + @node Definitions @section Definitions @cindex Definitions diff --git a/cgen/pmacros.scm b/cgen/pmacros.scm index 9873267751..cd626d7199 100644 --- a/cgen/pmacros.scm +++ b/cgen/pmacros.scm @@ -1344,12 +1344,13 @@ ) ;; Initialization. +;; If RTL-VERSION >= (0 9), install %pmacros, otherwise install .pmacros. -(define (pmacros-init!) +(define (pmacros-init! rtl-version) (set! /pmacro-table (make-hash-table 127)) (set! /smacro-table (make-hash-table 41)) - ;; Some "predefined" pmacros. + ;; Predefined pmacros. (let ((macros ;; name arg-spec syntactic? function description @@ -1412,7 +1413,10 @@ (list 'cdar '(x) #f /pmacro-builtin-cdar "return (cdar x)") (list 'cddr '(x) #f /pmacro-builtin-cddr "return (cddr x)") (list 'internal-test '(expr) #f /pmacro-builtin-internal-test "testsuite use only") - ))) + )) + (prefix (if (member rtl-version '((0 7) (0 8))) + /pmacro-orig-prefix + /pmacro-prefix))) (for-each (lambda (x) (let ((name (list-ref x 0)) @@ -1420,16 +1424,12 @@ (syntactic? (list-ref x 2)) (pmacro (list-ref x 3)) (comment (list-ref x 4))) - (for-each (lambda (prefix) - (let ((full-name (string->symbol (string-append prefix (symbol->string name))))) - (/pmacro-set! full-name - (/pmacro-make full-name arg-spec #f syntactic? pmacro comment)) - (if syntactic? - (/smacro-set! full-name - (/pmacro-make full-name arg-spec #f syntactic? pmacro comment))))) - (list /pmacro-orig-prefix)))) + (let ((full-name (string->symbol (string-append prefix (symbol->string name))))) + (/pmacro-set! full-name + (/pmacro-make full-name arg-spec #f syntactic? pmacro comment)) + (if syntactic? + (/smacro-set! full-name + (/pmacro-make full-name arg-spec #f syntactic? pmacro comment)))))) + macros)) ) - -;; Initialize so we're ready to use after loading. -(pmacros-init!) diff --git a/cgen/read.scm b/cgen/read.scm index 1a1aaaaa6f..ee3f488adb 100644 --- a/cgen/read.scm +++ b/cgen/read.scm @@ -94,7 +94,11 @@ ) ;; List of supported versions -(define /supported-rtl-versions '((0 7) (0 8))) +(define /supported-rtl-versions '((0 7) (0 8) (0 9))) + +;; Return a boolean indicating if VERSION is valid. + +(define (/rtl-version-valid? version) (member version /supported-rtl-versions)) (define (/cmd-define-rtl-version major minor) (if (not (non-negative-integer? major)) @@ -106,8 +110,12 @@ (if (not (member new-version /supported-rtl-versions)) (parse-error #f "Unsupported/invalid rtl version" new-version)) (if (not (equal? new-version /CGEN-RTL-VERSION)) - (logit 1 "Setting RTL version to " major "." minor " ...\n")) - (set! /CGEN-RTL-VERSION new-version)) + (begin + (logit 1 "Setting RTL version to " major "." minor " ...\n") + ;; Pmacros are rtl-version-dependent. If we've changed the RTL + ;; version, re-initialize. + (pmacros-init! new-version) + (set! /CGEN-RTL-VERSION new-version)))) ) ;; Which application is in use (UNKNOWN, DESC, OPCODES, SIMULATOR, ???). @@ -358,11 +366,22 @@ (unspecified-location)) ) -;; Process a macro-expanded entry. +;; Pmacro-expand EXPR. + +(define (/reader-expand expr loc) + (if (reader-trace-pmacros? CURRENT-READER) + (pmacro-trace expr loc) + (pmacro-expand expr loc)) +) + +;; Process a pmacro-expanded entry. (define (/reader-process-expanded-1! entry) (let ((location (location-property entry))) + (if (not (form? entry)) + (parse-error location "improperly formed entry" entry)) + ;; Set the current source location for better diagnostics. ;; Access with current-reader-location. (reader-set-location! CURRENT-READER location) @@ -408,12 +427,9 @@ *UNSPECIFIED* ) -;; Process 1 or more macro-expanded entries. +;; Process one or more pmacro-expanded entries. ;; ENTRY is expected to have a location-property object property. -;; NOTE: This is "public" so the .eval pmacro can use it. -;; This is also used by /cmd-if. - (define (reader-process-expanded! entry) ;; () is used to indicate a no-op (cond ((null? entry) @@ -431,23 +447,40 @@ *UNSPECIFIED* ) +;; Process ENTRY, which is not yet pmacro-expanded. + +(define (reader-process! entry) + (/reader-process-with-loc! entry + (or (location-property entry) + (unspecified-location))) +) + ;; Process file entry ENTRY. ;; LOC is a object for ENTRY. -(define (/reader-process! entry loc) - (if (not (form? entry)) - (parse-error loc "improperly formed entry" entry)) - - ;; First do macro expansion, but not if define-pmacro of course. - ;; ??? Singling out define-pmacro this way seems a bit odd. The way to look - ;; at it, I guess, is to think of define-pmacro as (currently) the only - ;; "syntactic" command (it doesn't pre-evaluate its arguments). - (let ((expansion (if (eq? (car entry) 'define-pmacro) - (begin (location-property-set! entry loc) entry) - (if (reader-trace-pmacros? CURRENT-READER) - (pmacro-trace entry loc) - (pmacro-expand entry loc))))) - (reader-process-expanded! expansion)) +(define (/reader-process-with-loc! entry loc) + ;; () is used to indicate a no-op + (cond ((null? entry) + #f) ;; nothing to do + ;; `begin' is used to group a collection of entries into one, + ;; since pmacro can only return one expression (borrowed from + ;; Scheme of course). + ;; Recurse in case there are nested begins. + ((eq? (car entry) 'begin) + (for-each (lambda (e) (/reader-process-with-loc! e loc)) + (cdr entry))) + ;; Don't do pmacro-expansion for `define-pmacro'. + ;; ??? Singling out define-pmacro this way seems a bit odd. The way to + ;; look at it, I guess, is to think of define-pmacro as (currently) the + ;; only "syntactic" command (it doesn't pre-evaluate its arguments). + ;; Defer pmacro-expansion for `if' too. + ((memq (car entry) '(define-pmacro if)) + (location-property-set! entry loc) + (/reader-process-expanded-1! entry)) + (else + ;; First do pmacro expansion. + (let ((expansion (/reader-expand entry loc))) + (reader-process-expanded! expansion)))) *UNSPECIFIED* ) @@ -470,7 +503,7 @@ ;; location (it's easier). ;; ??? Use source-properties of entry, and only if ;; not present fall back on current-input-location. - (/reader-process! entry (current-input-location #t)) + (/reader-process-with-loc! entry (current-input-location #t)) (loop (read))))))) ) @@ -487,7 +520,7 @@ ;; Global containing all data of the currently selected architecture. (define CURRENT-ARCH #f) - + ;; `keep-mach' processing. ;; Return the currently selected cpu family. @@ -878,7 +911,7 @@ ;; Rather than add cgen-internal specific stuff to pmacros.scm, we create ;; the pmacro commands here. - (pmacros-init!) + (pmacros-init! /default-rtl-version) (reader-add-command! 'define-pmacro "\ Define a preprocessor-style macro. @@ -1005,31 +1038,41 @@ Define a preprocessor-style macro. (parse-error #f "wrong number of arguments to `if'" (cons 'if (cons test (cons then else))))) - ;; ??? rtx-eval test - (if (or (not (pair? test)) - (not (memq (car test) '(keep-isa? keep-mach? application-is?)))) - (parse-error #f - "only (if (keep-mach?|keep-isa?|application-is? ...) ...) are currently supported" - test)) - (case (car test) - ((keep-isa?) - (if (keep-isa? (cadr test)) - (reader-process-expanded! then) - (if (null? else) - #f - (reader-process-expanded! (car else))))) - ((keep-mach?) - (if (keep-mach? (cadr test)) - (reader-process-expanded! then) - (if (null? else) - #f - (reader-process-expanded! (car else))))) - ((application-is?) - (if (eq? APPLICATION (cadr test)) - (reader-process-expanded! then) - (if (null? else) - #f - (reader-process-expanded! (car else)))))) + + (let ((etest (/reader-expand test (or (location-property test) + (unspecified-location))))) + + ;; ??? rtx-eval etest + (if (or (not (pair? etest)) + (not (memq (car etest) + '(keep-isa? keep-mach? application-is? rtl-version-equal? rtl-version-at-least?)))) + (parse-error #f + "only (if (keep-mach?|keep-isa?|application-is?|rtl-version-equal?|rtl-version-at-least? ...) ...) are currently supported" + etest)) + + (let ((do-then + (case (car etest) + ((keep-isa?) (keep-isa? (cadr etest))) + ((keep-mach?) (keep-mach? (cadr etest))) + ((application-is?) (eq? APPLICATION (cadr etest))) + ((rtl-version-equal?) + (if (/rtl-version-valid? (cdr etest)) + (rtl-version-equal? (cadr etest) (caddr etest)) + (parse-error #f "invalid rtl version" (cdr etest)))) + ((rtl-version-at-least?) + (if (/rtl-version-valid? (cdr etest)) + (rtl-version-at-least? (cadr etest) (caddr etest)) + (parse-error #f "invalid rtl version" (cdr etest))))))) + + (if do-then + (begin + (logit 3 "Processing then clause: " then "\n") + (reader-process! then)) + (if (null? else) + *UNSPECIFIED* + (begin + (logit 3 "Processing else clause: " (car else) "\n") + (reader-process! (car else))))))) ) ;; Top level routine for loading .cpu files. diff --git a/cgen/testsuite/Makefile.am b/cgen/testsuite/Makefile.am index 04b535c544..d77a6c8a45 100644 --- a/cgen/testsuite/Makefile.am +++ b/cgen/testsuite/Makefile.am @@ -18,6 +18,6 @@ check: Makefile test-utils.sh .PHONY: clean-test-files clean: clean-test-files clean-test-files: - rm -f *.test.cpu + rm -f *.test.cpu* rm -f *.out rm -f *.tmp diff --git a/cgen/testsuite/Makefile.in b/cgen/testsuite/Makefile.in index e0c42d074e..6f0a046df5 100644 --- a/cgen/testsuite/Makefile.in +++ b/cgen/testsuite/Makefile.in @@ -261,7 +261,7 @@ check: Makefile test-utils.sh .PHONY: clean-test-files clean: clean-test-files clean-test-files: - rm -f *.test.cpu + rm -f *.test.cpu* rm -f *.out rm -f *.tmp # Tell versions [3.59,3.63) of GNU make to not export all variables. diff --git a/cgen/testsuite/pmacros-1.test b/cgen/testsuite/pmacros-1.test index 14003d5a5f..9cde5c116b 100644 --- a/cgen/testsuite/pmacros-1.test +++ b/cgen/testsuite/pmacros-1.test @@ -1,13 +1,11 @@ # pmacro testcase #1 -*- shell-script -*- -test=pmacros-1 +gen_cpu_file() { + rtl_version=$1 + prefix=$2 -source ./test-utils.sh - -cpu_file=${test}.test.cpu -rm -f ${cpu_file} - -cat > ${cpu_file} < ${cpu_file} < ${cpu_file} < y -> x and y -> x -> y. (print-match "(x y)") -(print-expr (.let ((x y) (y x)) (.list x y))) +(print-expr (${prefix}let ((x y) (y x)) (${prefix}list x y))) -(test-name ".let*") +(test-name "${prefix}let*") (print-match "(1 2)") -(print-expr (.let* ((x 1) (y (.add x 1))) (.list x y))) +(print-expr (${prefix}let* ((x 1) (y (${prefix}add x 1))) (${prefix}list x y))) -(test-name ".if") +(test-name "${prefix}if") (print-match "then") -(print-expr (.if #t then else)) +(print-expr (${prefix}if #t then else)) (print-match "else") -(print-expr (.if #f then else)) +(print-expr (${prefix}if #f then else)) -(test-name ".case") +(test-name "${prefix}case") (print-match "123") -(print-expr (.case seba ((seba beach) 123) (else 456))) +(print-expr (${prefix}case seba ((seba beach) 123) (else 456))) (print-match "123") -(print-expr (.case beach ((seba beach) 123) (else 456))) +(print-expr (${prefix}case beach ((seba beach) 123) (else 456))) (print-match "456") -(print-expr (.case 0 ((seba beach) 123) (else 456))) +(print-expr (${prefix}case 0 ((seba beach) 123) (else 456))) -(test-name ".cond") +(test-name "${prefix}cond") (print-match "yep") -(print-expr (.cond ((.eq 1 1) yep) (else nope))) +(print-expr (${prefix}cond ((${prefix}eq 1 1) yep) (else nope))) (print-match "nope") -(print-expr (.cond ((.eq 1 2) yep) (else nope))) +(print-expr (${prefix}cond ((${prefix}eq 1 2) yep) (else nope))) -(test-name ".begin") +(test-name "${prefix}begin") (print-match "xyz") -(print-thunk (.pmacro () (.begin (.print "x") (.print "y") (.print "z")))) +(print-thunk (${prefix}pmacro () (${prefix}begin (${prefix}print "x") (${prefix}print "y") (${prefix}print "z")))) -(test-name ".list, .ref") +(test-name "${prefix}list, ${prefix}ref") (print-match "grief") -(print-expr (.ref (.list good grief) 1)) +(print-expr (${prefix}ref (${prefix}list good grief) 1)) -(test-name ".length") +(test-name "${prefix}length") (print-match "6") -(print-expr (.length snoopy)) +(print-expr (${prefix}length snoopy)) (print-match "9") -(print-expr (.length "woodstock")) +(print-expr (${prefix}length "woodstock")) (print-match "4") -(print-expr (.length (good grief charlie brown))) +(print-expr (${prefix}length (good grief charlie brown))) -(test-name ".replicate") +(test-name "${prefix}replicate") (print-match "(no no no no)") -(print-expr (.replicate 4 no)) +(print-expr (${prefix}replicate 4 no)) -(test-name ".find") +(test-name "${prefix}find") (print-match "(0 1)") -(print-expr (.find (.pmacro (n) (.lt n 2)) (.iota 4))) +(print-expr (${prefix}find (${prefix}pmacro (n) (${prefix}lt n 2)) (${prefix}iota 4))) -(test-name ".equal?") +(test-name "${prefix}equal?") (print-match "#t") -(print-expr (.equal? (yo yo) (yo yo))) +(print-expr (${prefix}equal? (yo yo) (yo yo))) (print-match "#f") -(print-expr (.equal? (yo yo) (yo x))) +(print-expr (${prefix}equal? (yo yo) (yo x))) -(test-name ".andif") +(test-name "${prefix}andif") (print-match "andif") -(print-expr (.andif 1 #t andif)) +(print-expr (${prefix}andif 1 #t andif)) (print-match "#f") -(print-expr (.andif 1 #f andif)) +(print-expr (${prefix}andif 1 #f andif)) (print-match "#t") -(print-expr (.andif)) +(print-expr (${prefix}andif)) -(test-name ".orif") +(test-name "${prefix}orif") (print-match "orif") -(print-expr (.orif #f orif)) +(print-expr (${prefix}orif #f orif)) (print-match "#f") -(print-expr (.orif #f #f)) +(print-expr (${prefix}orif #f #f)) (print-match "#f") -(print-expr (.orif)) +(print-expr (${prefix}orif)) -(test-name ".not") +(test-name "${prefix}not") (print-match "yep") -(print-expr (.if (.not #f) yep nope)) +(print-expr (${prefix}if (${prefix}not #f) yep nope)) (print-match "nope") -(print-expr (.if (.not #t) yep nope)) +(print-expr (${prefix}if (${prefix}not #t) yep nope)) -(test-name ".eq") +(test-name "${prefix}eq") (print-match "eq") -(print-expr (.if (.eq foo foo) eq ne)) +(print-expr (${prefix}if (${prefix}eq foo foo) eq ne)) (print-match "eq2") -(print-expr (.if (.eq 1 1) eq2 ne2)) +(print-expr (${prefix}if (${prefix}eq 1 1) eq2 ne2)) -(test-name ".ne") +(test-name "${prefix}ne") (print-match "ne") -(print-expr (.if (.ne foo bar) ne eq)) +(print-expr (${prefix}if (${prefix}ne foo bar) ne eq)) (print-match "ne2") -(print-expr (.if (.ne 1 2) ne2 eq2)) +(print-expr (${prefix}if (${prefix}ne 1 2) ne2 eq2)) -(test-name ".lt") +(test-name "${prefix}lt") (print-match "lt") -(print-expr (.if (.lt 1 2) lt nope)) +(print-expr (${prefix}if (${prefix}lt 1 2) lt nope)) -(test-name ".gt") +(test-name "${prefix}gt") (print-match "gt") -(print-expr (.if (.gt 1 0) gt nope)) +(print-expr (${prefix}if (${prefix}gt 1 0) gt nope)) -(test-name ".le") +(test-name "${prefix}le") (print-match "le1") -(print-expr (.if (.le 1 1) le1 nope)) +(print-expr (${prefix}if (${prefix}le 1 1) le1 nope)) (print-match "le2") -(print-expr (.if (.le 1 2) le2 nope)) +(print-expr (${prefix}if (${prefix}le 1 2) le2 nope)) -(test-name ".ge") +(test-name "${prefix}ge") (print-match "ge1") -(print-expr (.if (.ge 1 1) ge1 nope)) +(print-expr (${prefix}if (${prefix}ge 1 1) ge1 nope)) (print-match "ge2") -(print-expr (.if (.ge 1 0) ge2 nope)) +(print-expr (${prefix}if (${prefix}ge 1 0) ge2 nope)) -(test-name ".add") +(test-name "${prefix}add") (print-match "3") -(print-expr (.add 1 2)) +(print-expr (${prefix}add 1 2)) -(test-name ".sub") +(test-name "${prefix}sub") (print-match "-1") -(print-expr (.sub 1 2)) +(print-expr (${prefix}sub 1 2)) -(test-name ".mul") +(test-name "${prefix}mul") (print-match "6") -(print-expr (.mul 2 3)) +(print-expr (${prefix}mul 2 3)) -(test-name ".div") +(test-name "${prefix}div") (print-match "4") -(print-expr (.div 8 2)) +(print-expr (${prefix}div 8 2)) -(test-name ".rem") +(test-name "${prefix}rem") (print-match "0") -(print-expr (.rem 8 2)) +(print-expr (${prefix}rem 8 2)) -(test-name ".sll") +(test-name "${prefix}sll") (print-match "8") -(print-expr (.sll 1 3)) +(print-expr (${prefix}sll 1 3)) (print-match "4") -(print-expr (.sll 4 0)) +(print-expr (${prefix}sll 4 0)) -(test-name ".srl") +(test-name "${prefix}srl") (print-match "1") -(print-expr (.srl 8 3)) +(print-expr (${prefix}srl 8 3)) (print-match "4") -(print-expr (.srl 4 0)) +(print-expr (${prefix}srl 4 0)) -(test-name ".sra") +(test-name "${prefix}sra") (print-match "-1") -(print-expr (.sra -1 0)) +(print-expr (${prefix}sra -1 0)) (print-match "-1") -(print-expr (.sra -1 1)) +(print-expr (${prefix}sra -1 1)) (print-match "-2") -(print-expr (.sra -3 1)) +(print-expr (${prefix}sra -3 1)) -(test-name ".and") +(test-name "${prefix}and") (print-match "8") -(print-expr (.and 15 8)) +(print-expr (${prefix}and 15 8)) -(test-name ".or") +(test-name "${prefix}or") (print-match "15") -(print-expr (.or 15 8)) +(print-expr (${prefix}or 15 8)) -(test-name ".xor") +(test-name "${prefix}xor") (print-match "7") -(print-expr (.xor 15 8)) +(print-expr (${prefix}xor 15 8)) -(test-name ".inv") +(test-name "${prefix}inv") (print-match "-6") -(print-expr (.inv 5)) +(print-expr (${prefix}inv 5)) -(test-name ".car") +(test-name "${prefix}car") (print-match "car") -(print-expr (.car (car cdr))) +(print-expr (${prefix}car (car cdr))) -(test-name ".cdr") +(test-name "${prefix}cdr") (print-match "(cdr)") -(print-expr (.cdr (car cdr))) +(print-expr (${prefix}cdr (car cdr))) -(test-name ".caar") +(test-name "${prefix}caar") (print-match "caar") -(print-expr (.caar ((caar cdar) cadr cddr))) +(print-expr (${prefix}caar ((caar cdar) cadr cddr))) -(test-name ".cadr") +(test-name "${prefix}cadr") (print-match "cadr") -(print-expr (.cadr ((caar cdar) cadr cddr))) +(print-expr (${prefix}cadr ((caar cdar) cadr cddr))) -(test-name ".cdar") +(test-name "${prefix}cdar") (print-match "(cdar)") -(print-expr (.cdar ((caar cdar) cadr cddr))) +(print-expr (${prefix}cdar ((caar cdar) cadr cddr))) -(test-name ".cddr") +(test-name "${prefix}cddr") (print-match "(cddr)") -(print-expr (.cddr ((caar cdar) cadr cddr))) +(print-expr (${prefix}cddr ((caar cdar) cadr cddr))) EOF +} + +# Run the test twice, once for each kind of prefix. + +for iter in dot percent +do + test="pmacros-1-${iter}" + + source ./test-utils.sh + + cpu_file=${test}.test.cpu + rm -f ${cpu_file} + + case ${iter} in + dot) gen_cpu_file "0 8" "." ;; + percent) gen_cpu_file "0 9" "%" ;; + esac -run_cgen ${cpu_file} + run_cgen ${cpu_file} -post_process + post_process +done finish diff --git a/cgen/testsuite/testsuite.cpu b/cgen/testsuite/testsuite.cpu index 13eb503e3a..ed21814f27 100644 --- a/cgen/testsuite/testsuite.cpu +++ b/cgen/testsuite/testsuite.cpu @@ -36,44 +36,60 @@ ;; Some useful pmacros for testcases. -(define-pmacro (newline) (.print "\n")) +(if (rtl-version-at-least? 0 9) + (begin + (define-pmacro /begin %begin) + (define-pmacro /print %print) + (define-pmacro /dump %dump)) + (begin + (define-pmacro /begin .begin) + (define-pmacro /print .print) + (define-pmacro /dump .dump))) + +(define-pmacro (newline) (/print "\n")) ;; Record name of test for debugging purposes. (define-pmacro (test-name name) - (.print "TEST: " name "\n") + (/print "TEST: " name "\n") ) ;; Print TEXT as the expected output. (define-pmacro (print-match text) - (.begin - (.print "MATCH: ") - (.print text) + (/begin + (/print "MATCH: ") + (/print text) (newline)) ) ;; Print EXPR as the text to be verified. (define-pmacro (print-expr expr) - (.begin - (.print "EXPR: ") - (.dump expr) + (/begin + (/print "EXPR: ") + (/dump expr) (newline)) ) ;; THUNK is invoked to exercise whatever is being tested. (define-pmacro (print-thunk thunk) - (.begin - (.print "EXPR: ") + (/begin + (/print "EXPR: ") (thunk) (newline)) ) ;; Wrapper around .internal-test to include pass/fail messages. -(define-pmacro (internal-verify test-name expr) - (.if (.internal-test expr) - (.print "PASS: " test-name "\n") - (.print "FAIL: " test-name "\n")) + +(if (rtl-version-at-least? 0 9) + (define-pmacro (internal-verify test-name expr) + (%if (%internal-test expr) + (%print "PASS: " test-name "\n") + (%print "FAIL: " test-name "\n"))) + (define-pmacro (internal-verify test-name expr) + (.if (.internal-test expr) + (.print "PASS: " test-name "\n") + (.print "FAIL: " test-name "\n"))) ) -- 2.11.0