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.
2010-01-28 Doug Evans <dje@sebabeach.org>
+ * 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 <dje@sebabeach.org>
-@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.
* 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
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.
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
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
)
\f
;; 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
(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))
(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!)
)
;; 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))
(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, ???).
(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)
*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)
*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 <location> 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*
)
;; 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)))))))
)
;; Global containing all data of the currently selected architecture.
(define CURRENT-ARCH #f)
-\f
+
;; `keep-mach' processing.
;; Return the currently selected cpu family.
;; 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.
(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.
.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
.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.
# 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} <<EOF
+ cat > ${cpu_file} <<EOF
+(define-rtl-version ${rtl_version})
(include "${srcdir}/../cpu/simplify.inc")
(include "${srcdir}/testsuite.cpu")
(name3 "string3" 3)
)
)
-(.print list-const "\n")
+(${prefix}print list-const "\n")
-(test-name ".ref, .car")
-(.if (.not (.equal? (.ref (.car list-const) 2) 1))
- (.print "FAIL (.not (.equal? (.ref (.car list-const) 2) 1))\n"))
+(test-name "${prefix}ref, ${prefix}car")
+(${prefix}if (${prefix}not (${prefix}equal? (${prefix}ref (${prefix}car list-const) 2) 1))
+ (${prefix}print "FAIL (${prefix}not (${prefix}equal? (${prefix}ref (${prefix}car list-const) 2) 1))\n"))
-(test-name ".for-each, nested .pmacros")
+(test-name "${prefix}for-each, nested ${prefix}pmacros")
(print-match "adgbehcfi")
-(print-thunk (.pmacro ()
- (.begin
- (.for-each (.pmacro (x y z)
- (.print x y z))
+(print-thunk (${prefix}pmacro ()
+ (${prefix}begin
+ (${prefix}for-each (${prefix}pmacro (x y z)
+ (${prefix}print x y z))
(a b c) (d e f) (g h i)))))
-(test-name "nested .pmacros with bindings")
+(test-name "nested ${prefix}pmacros with bindings")
(print-match "(+ 4 3)")
-(print-thunk (.pmacro ()
- (.dump ((.pmacro (arg1 arg2)
- ((.pmacro (bar) (+ arg2 bar)) arg1))
+(print-thunk (${prefix}pmacro ()
+ (${prefix}dump ((${prefix}pmacro (arg1 arg2)
+ ((${prefix}pmacro (bar) (+ arg2 bar)) arg1))
3 4))))
-(test-name ".dump")
+(test-name "${prefix}dump")
(print-match "(name1 \"string1\" 1)(name2 \"string2\" 2)(name3 \"string3\" 3)\n")
-(.print "EXPR: ")
-(.for-each (.pmacro (a) (.dump a)) list-const)
+(${prefix}print "EXPR: ")
+(${prefix}for-each (${prefix}pmacro (a) (${prefix}dump a)) list-const)
(newline)
-(test-name ".sym")
+(test-name "${prefix}sym")
(print-match "abc\n")
-(print-expr (.sym a "b" c))
+(print-expr (${prefix}sym a "b" c))
-(test-name ".str")
+(test-name "${prefix}str")
(print-match "\"def\"\n")
-(print-expr (.str d "e" f))
+(print-expr (${prefix}str d "e" f))
-(test-name ".hex")
+(test-name "${prefix}hex")
(print-match "\"2a\"")
-(print-expr (.hex 42))
+(print-expr (${prefix}hex 42))
-(test-name ".upcase")
+(test-name "${prefix}upcase")
(print-match "\"UPPER\"")
-(print-expr (.upcase "upper"))
+(print-expr (${prefix}upcase "upper"))
(print-match "UPPER")
-(print-expr (.upcase upper))
+(print-expr (${prefix}upcase upper))
-(test-name ".downcase")
+(test-name "${prefix}downcase")
(print-match "\"downer\"")
-(print-expr (.downcase "DOWNER"))
+(print-expr (${prefix}downcase "DOWNER"))
(print-match "downer")
-(print-expr (.downcase DOWNER))
+(print-expr (${prefix}downcase DOWNER))
-(test-name ".substring")
+(test-name "${prefix}substring")
(print-match "\"zz\"")
-(print-expr (.substring "xyzzy" 2 4))
+(print-expr (${prefix}substring "xyzzy" 2 4))
(print-match "zz")
-(print-expr (.substring xyzzy 2 4))
+(print-expr (${prefix}substring xyzzy 2 4))
-(test-name ".splice1")
+(test-name "${prefix}splice1")
(print-match "(now is the time)")
-(print-expr (.splice now (.unsplice (is the time))))
+(print-expr (${prefix}splice now (${prefix}unsplice (is the time))))
-;; Arguments to .splice/.unsplice are evaluated.
-(test-name ".splice2")
+;; Arguments to ${prefix}splice/${prefix}unsplice are evaluated.
+(test-name "${prefix}splice2")
(print-match "(now is the time)")
(define-pmacro splice2-piece now)
-(print-expr (.splice splice2-piece (.unsplice (is the time))))
+(print-expr (${prefix}splice splice2-piece (${prefix}unsplice (is the time))))
-;; Arguments to .splice/.unsplice are evaluated.
-(test-name ".splice3")
+;; Arguments to ${prefix}splice/${prefix}unsplice are evaluated.
+(test-name "${prefix}splice3")
(print-match "(now is the time)")
(define-pmacro splice3-piece the)
-(print-expr (.splice now (.unsplice (is splice3-piece time))))
+(print-expr (${prefix}splice now (${prefix}unsplice (is splice3-piece time))))
-(test-name ".iota")
+(test-name "${prefix}iota")
(print-match "(0 1 2 3)")
-(print-expr (.iota 4))
+(print-expr (${prefix}iota 4))
(print-match "(1 2 3 4)")
-(print-expr (.iota 4 1))
+(print-expr (${prefix}iota 4 1))
(print-match "(2 4 6 8)")
-(print-expr (.iota 4 2 2))
+(print-expr (${prefix}iota 4 2 2))
-(test-name ".map")
+(test-name "${prefix}map")
(print-match "(\"a\" \"b\" \"c\")")
-(print-expr (.map .hex (10 11 12)))
+(print-expr (${prefix}map ${prefix}hex (10 11 12)))
(print-match "(\"a\" \"b\" \"c\")")
-(print-expr (.map (.pmacro (x) (.hex x)) (10 11 12)))
+(print-expr (${prefix}map (${prefix}pmacro (x) (${prefix}hex x)) (10 11 12)))
-(test-name ".apply")
+(test-name "${prefix}apply")
(print-match "ABC")
-(print-expr (.apply .upcase (abc)))
+(print-expr (${prefix}apply ${prefix}upcase (abc)))
-(test-name ".pmacro?")
+(test-name "${prefix}pmacro?")
(print-match "#t")
-(print-expr (.pmacro? .pmacro?))
+(print-expr (${prefix}pmacro? ${prefix}pmacro?))
(print-match "#t")
-(print-expr (.pmacro? test-name))
+(print-expr (${prefix}pmacro? test-name))
(print-match "#t")
-(print-expr (.pmacro? (.pmacro (a) (add a 1))))
+(print-expr (${prefix}pmacro? (${prefix}pmacro (a) (add a 1))))
(print-match "#f")
-(print-expr (.pmacro? 42))
+(print-expr (${prefix}pmacro? 42))
-(test-name ".eval")
+(test-name "${prefix}eval")
(print-match "(explicitly-undefined 42)")
(define-pmacro (eval-test1 a) (explicitly-undefined a))
-(print-expr (.eval (.splice eval-test1 (.unsplice (42)))))
+(print-expr (${prefix}eval (${prefix}splice eval-test1 (${prefix}unsplice (42)))))
-(test-name ".let")
+(test-name "${prefix}let")
(print-match "xyzzy")
-(print-expr (.let ((x xyzzy)) x))
+(print-expr (${prefix}let ((x xyzzy)) x))
;; FIXME: This is the currently defined behaviour, but it's somewhat
;; unintuitive.
;; pmacro expansion re-evaluates the result if it's also a pmacro,
;; so x -> 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
\f
;; 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")))
)
OSDN Git Service
