From 38b917c6631e635cb985d1f94d51e46fd618a196 Mon Sep 17 00:00:00 2001 From: devans Date: Fri, 6 Nov 2009 01:55:33 +0000 Subject: [PATCH] * utils.scm (reduce): Delete. * rtl-traverse.scm (/rtx-canon-rtx-enum): Tweak local name. * enum.scm (gen-enum-sym): Make consistent with gen-enum-decl regarding PREFIX attribute handling. * operand.scm (): Add enum to possible types, all uses updated. (hw-index-constant?, hw-index-constant-value): New functions. (make-enum-hw-index, hw-index-enum-name, hw-index-enum-value, hw-index-enum-obj): New functions. (/operand-parse): Handle enum indices. * intrinsics.scm (md-operand:fixed-register): Use hw-index-constant?, hw-index-constant-value. * rtl.scm (rtx-constant-value): Fix handling of enums. * rtx-funcs.scm (enum): Ditto. * sid.scm ( cxmake-get): Only ifield indices are currently supported here. --- cgen/ChangeLog | 22 ++++++ cgen/enum.scm | 18 +++-- cgen/gas-test.scm | 2 +- cgen/intrinsics.scm | 5 +- cgen/opc-opinst.scm | 5 ++ cgen/operand.scm | 197 ++++++++++++++++++++++++++++++++------------------ cgen/rtl-traverse.scm | 4 +- cgen/rtl.scm | 16 ++-- cgen/rtx-funcs.scm | 5 +- cgen/sid.scm | 12 ++- cgen/sim.scm | 8 +- cgen/utils.scm | 20 ----- 12 files changed, 201 insertions(+), 113 deletions(-) diff --git a/cgen/ChangeLog b/cgen/ChangeLog index c3f5b864c4..67517a5df7 100644 --- a/cgen/ChangeLog +++ b/cgen/ChangeLog @@ -1,3 +1,25 @@ +2009-11-05 Doug Evans + + * utils.scm (reduce): Delete. + + * rtl-traverse.scm (/rtx-canon-rtx-enum): Tweak local name. + + * enum.scm (gen-enum-sym): Make consistent with gen-enum-decl + regarding PREFIX attribute handling. + + * operand.scm (): Add enum to possible types, all uses + updated. + (hw-index-constant?, hw-index-constant-value): New functions. + (make-enum-hw-index, hw-index-enum-name, hw-index-enum-value, + hw-index-enum-obj): New functions. + (/operand-parse): Handle enum indices. + * intrinsics.scm (md-operand:fixed-register): Use hw-index-constant?, + hw-index-constant-value. + * rtl.scm (rtx-constant-value): Fix handling of enums. + * rtx-funcs.scm (enum): Ditto. + * sid.scm ( cxmake-get): Only ifield indices are + currently supported here. + 2009-11-02 Doug Evans Specify isa(s) when doing ifield, operand, insn lookups. diff --git a/cgen/enum.scm b/cgen/enum.scm index 49cbb079b1..ac167117ff 100644 --- a/cgen/enum.scm +++ b/cgen/enum.scm @@ -4,11 +4,12 @@ ; See file COPYING.CGEN for details. ; Enums having attribute PREFIX have their symbols prepended with -; the enum class' name. -; Member PREFIX is always prepended to the symbol names. +; the enum class' name + "_" in generated code. FIXME: deprecated +; +; Member PREFIX is prepended to the symbol names when the object is defined. ; ; Enum values are looked up with `enum-lookup-val'. The value to search for -; has PREFIX prepended. +; must already have PREFIX prepended. ; ; Enums always have mode INT. @@ -231,7 +232,7 @@ ; Return C code to declare enum SYM with values VALS. ; COMMENT is inserted in "/* Enum declaration for <...>. */". -; PREFIX is added to each element of VALS. +; PREFIX is added to each element of VALS (uppercased). ; All enum symbols are uppercase. ; If the list of vals is sequential beginning at 0, don't output them. ; This simplifies the output and is necessary for sanitized values where @@ -332,10 +333,15 @@ (elm-get self 'vals))) ) -; Return the C symbol of an enum value named VAL. +;; Return the C symbol of an enum value named VAL. +;; ENUM-OBJ is the object containing VAL. (define (gen-enum-sym enum-obj val) - (string-upcase (gen-c-symbol (string-append (enum-prefix enum-obj) val))) + (string-upcase + (string-append (if (has-attr? enum-obj 'PREFIX) + (string-append (elm-xget enum-obj 'name) "_") + "") + (gen-c-symbol val))) ) ; Instruction code enums. diff --git a/cgen/gas-test.scm b/cgen/gas-test.scm index b06c588c43..4b6bc06054 100644 --- a/cgen/gas-test.scm +++ b/cgen/gas-test.scm @@ -145,7 +145,7 @@ (lambda (self n) (case (hw-index:type self) ((ifield operand) (send (hw-index:value self) 'test-data n)) - ((constant) (make-list n (hw-index:value self))) + ((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))))) diff --git a/cgen/intrinsics.scm b/cgen/intrinsics.scm index ee25a9525c..ddf66c9374 100644 --- a/cgen/intrinsics.scm +++ b/cgen/intrinsics.scm @@ -560,9 +560,8 @@ (define (md-operand:fixed-register op) (and (not (md-operand:pc? op)) (md-operand:register? op) - (let ((constant (if (equal? 'constant - (hw-index:type (md-operand:index op))) - (hw-index:value (md-operand:index op)) + (let ((constant (if (hw-index-constant? (md-operand:index op)) + (hw-index-constant-value (md-operand:index op)) (md-operand:ifield-value op)))) (and constant (+ constant (target:base-reg (md-operand:hw op))))))) diff --git a/cgen/opc-opinst.scm b/cgen/opc-opinst.scm index 3f585382d6..0ae1b202da 100644 --- a/cgen/opc-opinst.scm +++ b/cgen/opc-opinst.scm @@ -27,6 +27,11 @@ ((eq? (hw-index:type index) 'constant) (string-append "0, " (number->string (hw-index:value index)))) + ((eq? (hw-index:type index) 'enum) + (let ((sym (hw-index-enum-name index)) + (obj (hw-index-enum-obj index))) + (string-append "0, " + (gen-enum-sym obj sym)))) (else "0, 0")) ", " (if (op:cond? op) "COND_REF" "0") " },\n")) diff --git a/cgen/operand.scm b/cgen/operand.scm index 6a8713ae86..2cd5ccb60e 100644 --- a/cgen/operand.scm +++ b/cgen/operand.scm @@ -243,36 +243,6 @@ (string-append "\"" pname "\""))) ) -; PC support. -; This is a subclass of , used to give the simulator a place to -; hang a couple of methods. -; At the moment we only support one pc, a reasonable place to stop for now. - -(define (class-make ' '() nil nil)) - -(method-make! - 'make! - (lambda (self) - (send-next self ' 'make! - (builtin-location) 'pc "program counter" - (atlist-parse (make-prefix-context "make! of pc") - '(SEM-ONLY) "cgen_operand") - 'h-pc - 'DFLT - (make 'anonymous - 'ifield 'UINT (current-ifld-lookup 'f-nil)) - nil ; handlers - #f #f) ; getter setter - self) -) - -; Return a boolean indicating if operand op is the pc. -; This must not call op:type. op:type will try to resolve a hardware -; element that may be multiply specified, and this is used in contexts -; where that's not possible. - -(define (pc? op) (class-instance? op)) - ; Mode support. ; Create a copy of operand OP in mode NEW-MODE-NAME. @@ -351,17 +321,21 @@ ; TYPE is a symbol that indicates what VALUE is. ; scalar: the hardware object is a scalar, no index is required ; [MODE and VALUE are #f to denote "undefined" in this case] -; constant: a (non-negative) integer +; constant: a (non-negative) integer (FIXME: rename to const) +; enum: an enum value stored as (enum-name . (enum-lookup-val enum-name)), +; i.e. (name value . enum-obj) ; str-expr: a C expression as a string ; rtx: an rtx to be expanded -; ifield: an ifield object -; operand: an operand object +; ifield: an object +; derived-ifield: a object ??? +; operand: an object ; ??? A useful simplification may be to always record the value as an rtx ; [which may require extensions to rtl so is deferred]. ; ??? We could use runtime type identification, but doing things this way ; adds more structure. ; -; MODE is the mode of VALUE. If DFLT, mode must be obtained from VALUE. +; MODE is the mode of VALUE, as a object. +; If DFLT, mode must be obtained from VALUE. ; DFLT is only allowable for rtx and operand types. (define (class-make ' nil '(name type mode value) nil)) @@ -415,6 +389,46 @@ 0)) ) +;; Return #t if index is a constant. + +(define (hw-index-constant? hw-index) + (memq (hw-index:type hw-index) '(constant enum)) +) + +;; Given that (hw-index-constant? hw-index) is true, return the value. + +(define (hw-index-constant-value hw-index) + (case (hw-index:type hw-index) + ((constant) (hw-index:value hw-index)) + ((enum) (hw-index-enum-value hw-index)) + (else (error "invalid constant hw-index" hw-index))) +) + +;; Make an enum given the enum's name. + +(define (make-enum-hw-index name enum-name) + (make name 'enum UINT + (cons enum-name (enum-lookup-val enum-name))) +) + +;; Given an enum , return the enum's name. + +(define (hw-index-enum-name hw-index) + (car (hw-index:value hw-index)) +) + +;; Given an enum , return the enum's value. + +(define (hw-index-enum-value hw-index) + (cadr (hw-index:value hw-index)) +) + +;; Given an enum , return the enum's object. + +(define (hw-index-enum-obj hw-index) + (cddr (hw-index:value hw-index)) +) + ; There only ever needs to be one of these objects, so create one. (define hw-index-scalar @@ -555,7 +569,7 @@ ; ??? This only takes insn fields as the index. May need another proc (or an ; enhancement of this one) that takes other kinds of indices. -(define (/operand-parse context name comment attrs hw mode ifld handlers getter setter) +(define (/operand-parse context name comment attrs hw mode index handlers getter setter) (logit 2 "Processing operand " name " ...\n") ;; Pick out name first to augment the error context. @@ -572,50 +586,64 @@ (let ((hw-objs (current-hw-sem-lookup hw)) (mode-obj (parse-mode-name context mode)) - (ifld-val (if (integer? ifld) - ifld - (current-ifld-lookup ifld isa-name-list)))) + (index-val (cond ((integer? index) + index) + ((and (symbol? index) (enum-lookup-val index)) + => (lambda (x) x)) + ((and (symbol? index) (current-ifld-lookup index isa-name-list)) + => (lambda (x) x)) + (else + (if (symbol? index) + (parse-error context "unknown enum or ifield" index) + (parse-error context "invalid operand index" index)))))) (if (not mode-obj) (parse-error context "unknown mode" mode)) - (if (not ifld-val) - (parse-error context "unknown insn field" ifld)) - ; Disallow some obviously invalid numeric indices. - (if (and (integer? ifld-val) - (< ifld-val 0)) - (parse-error context "invalid integer index" ifld-val)) - ; Don't validate HW until we know whether this operand will be kept - ; or not. If not, HW may have been discarded too. + ;; Disallow some obviously invalid numeric indices. + (if (and (number? index-val) + (or (not (integer? index-val)) + (< index-val 0))) + (parse-error context "invalid integer index" index)) + ;; If an enum is used, it must be non-negative. + (if (and (pair? index-val) + (< (car index-val) 0)) + (parse-error context "negative enum value" index)) + ;; NOTE: Don't validate HW until we know whether this operand + ;; will be kept or not. If not, HW may have been discarded too. (if (null? hw-objs) (parse-error context "unknown hardware element" hw)) - ; At this point IFLD-VAL is either an integer or an object. - ; Since we can't look up the hardware element at this time - ; [well, actually we should be able to with a bit of work], - ; we determine scalarness from the index. - (let* ((scalar? (or (integer? ifld-val) (ifld-nil? ifld-val))) - (hw-index - (if (integer? ifld-val) - (make (symbol-append 'i- name) - ; FIXME: constant -> const - 'constant 'UINT ifld-val) - (if scalar? - (hw-index-scalar) - (make (symbol-append 'i- name) - 'ifield 'UINT ifld-val))))) + ;; At this point INDEX-VAL is either an integer, (value . enum-obj), + ;; or an object. + ;; Since we can't look up the hardware element at this time + ;; [well, actually we should be able to with a bit of work], + ;; we determine scalarness from an index of f-nil. + (let ((hw-index + (cond ((integer? index-val) + (make (symbol-append 'i- name) + ;; FIXME: constant -> const + 'constant UINT index-val)) + ((pair? index-val) ;; enum? + (make (symbol-append 'i- name) + 'enum UINT (cons index index-val))) + ((ifld-nil? index-val) + (hw-index-scalar)) + (else + (make (symbol-append 'i- name) + 'ifield UINT index-val))))) (make (context-location context) name (parse-comment context comment) - ; Copy FLD's attributes so one needn't duplicate attrs like - ; PCREL-ADDR, etc. An operand inherits the attributes of - ; its field. They are overridable of course, which is why we use - ; `atlist-append' here. - (if (integer? ifld-val) - atlist-obj - (atlist-append atlist-obj (obj-atlist ifld-val))) - hw ; note that this is the hw's name, not an object - mode ; ditto, this is a name, not an object + ;; Copy FLD's attributes so one needn't duplicate attrs like + ;; PCREL-ADDR, etc. An operand inherits the attributes of + ;; its field. They are overridable of course, which is why we use + ;; `atlist-append' here. + (if (ifield? index-val) + (atlist-append atlist-obj (obj-atlist index-val)) + atlist-obj) + hw ;; note that this is the hw's name, not an object + mode ;; ditto, this is a name, not an object hw-index (parse-handlers context '(parse print) handlers) (/operand-parse-getter context getter (if scalar? 0 1)) @@ -1582,6 +1610,37 @@ ;(define $2 (make 2)) ;(define $3 (make 3)) +;; PC support. +;; This is a subclass of , used to give the simulator a place to +;; hang a couple of methods. +;; At the moment we only support one pc, a reasonable place to stop for now. + +(define (class-make ' '() nil nil)) + +(method-make! + 'make! + (lambda (self) + (send-next self ' 'make! + (builtin-location) 'pc "program counter" + (atlist-parse (make-prefix-context "make! of pc") + '(SEM-ONLY) "cgen_operand") + 'h-pc + 'DFLT + ;;(hw-index-scalar) ;; FIXME: change to this + (make 'anonymous + 'ifield 'UINT (current-ifld-lookup 'f-nil)) + nil ;; handlers + #f #f) ;; getter setter + self) +) + +; Return a boolean indicating if operand op is the pc. +; This must not call op:type. op:type will try to resolve a hardware +; element that may be multiply specified, and this is used in contexts +; where that's not possible. + +(define (pc? op) (class-instance? op)) + ; Called before/after loading the .cpu file to initialize/finalize. ; Builtins. diff --git a/cgen/rtl-traverse.scm b/cgen/rtl-traverse.scm index 89c502f82f..6499c607a0 100644 --- a/cgen/rtl-traverse.scm +++ b/cgen/rtl-traverse.scm @@ -768,9 +768,9 @@ (let ((mode-name (cadr args)) (enum-name (caddr args))) (let ((mode-obj (mode:lookup mode-name)) - (enum-obj (enum-lookup-val enum-name))) + (enum-val-and-obj (enum-lookup-val enum-name))) - (if (not enum-obj) + (if (not enum-val-and-obj) (/rtx-canon-error cstate "unknown enum value" enum-name parent-expr #f)) diff --git a/cgen/rtl.scm b/cgen/rtl.scm index 617345649c..887fe48f6c 100644 --- a/cgen/rtl.scm +++ b/cgen/rtl.scm @@ -679,7 +679,7 @@ (define (rtx-constant-value rtx) (case (rtx-name rtx) ((const) (rtx-const-value rtx)) - ((enum) (enum-lookup-val (rtx-enum-value rtx))) + ((enum) (car (enum-lookup-val (rtx-enum-value rtx)))) (else (error "rtx-constant-value: not const or enum" rtx))) ) @@ -1077,11 +1077,15 @@ (make 'anonymous 'constant UINT index-arg)) ((rtx? index-arg) ; Make sure constant indices are recorded as such. - (if (rtx-constant? index-arg) - (make 'anonymous 'constant UINT - (rtx-constant-value index-arg)) - (make 'anonymous 'rtx (mode:lookup index-mode) - (/rtx-closure-make estate index-mode index-arg)))) + (case (rtx-name index-arg) + ((const) + (make 'anonymous 'constant UINT + (rtx-constant-value index-arg))) + ((enum) + (make-enum-hw-index 'anonymous (rtx-enum-value index-arg))) + (else + (make 'anonymous 'rtx (mode:lookup index-mode) + (/rtx-closure-make estate index-mode index-arg))))) (else (parse-error (estate-context estate) "invalid index" index-arg)))) diff --git a/cgen/rtx-funcs.scm b/cgen/rtx-funcs.scm index 45c3b24644..bf68f0fe74 100644 --- a/cgen/rtx-funcs.scm +++ b/cgen/rtx-funcs.scm @@ -49,8 +49,9 @@ #f (OPTIONS ANYINTMODE SYMBOL) (NA NA NA) ;; ??? s/SYMBOL/ENUM-NAME/ ? ARG - ; When computing a value, return the enum's value. - (enum-lookup-val enum-name) + ;; When computing a value, return the enum's value. + ;; Canonicalization should have already caught bad values. + (car (enum-lookup-val enum-name)) ) ; Instruction fields diff --git a/cgen/sid.scm b/cgen/sid.scm index 72ecae9cf7..4c74142f8a 100644 --- a/cgen/sid.scm +++ b/cgen/sid.scm @@ -384,8 +384,8 @@ (method-make! 'cxmake-get (lambda (self estate mode index selector) - ;(if (not (eq? 'ifield (hw-index:type index))) - ; (error "not an ifield hw-index" index)) + (if (not (eq? 'ifield (hw-index:type index))) + (error "not an ifield hw-index" index)) (/cxmake-ifld-val mode (hw-index:value index))) ) @@ -787,7 +787,7 @@ (method-make! 'get-write-index (lambda (self hw sfmt op access-macro) - (if (memq (hw-index:type self) '(scalar constant str-expr ifield)) + (if (memq (hw-index:type self) '(scalar constant enum str-expr ifield)) self (let ((index-mode (send hw 'get-index-mode))) (if index-mode @@ -821,6 +821,9 @@ (string-append "((" (mode:c-type mode) ") " (number->string value) ")"))) + ((enum) (let ((sym (hw-index-enum-name index)) + (obj (hw-index-enum-obj index))) + (gen-enum-sym obj sym))) ((str-expr) value) ((rtx) (rtl-c-with-estate estate mode value)) ((ifield) (if (= (ifld-length value) 0) @@ -843,6 +846,9 @@ ((constant) (string-append "((" (mode:c-type mode) ") " (number->string value) ")")) + ((enum) (let ((sym (hw-index-enum-name index)) + (obj (hw-index-enum-obj index))) + (gen-enum-sym obj sym))) ((str-expr) value) ((rtx) (rtl-c-with-estate estate mode value)) ((ifield) (if (= (ifld-length value) 0) diff --git a/cgen/sim.scm b/cgen/sim.scm index b0512c624d..ea18f61d50 100644 --- a/cgen/sim.scm +++ b/cgen/sim.scm @@ -853,7 +853,7 @@ (method-make! 'get-write-index (lambda (self hw sfmt op access-macro) - (if (memq (hw-index:type self) '(scalar constant str-expr ifield)) + (if (memq (hw-index:type self) '(scalar constant enum str-expr ifield)) self (let ((index-mode (send hw 'get-index-mode))) (if index-mode @@ -887,6 +887,9 @@ (string-append "((" (mode:c-type mode) ") " (number->string value) ")"))) + ((enum) (let ((sym (hw-index-enum-name index)) + (obj (hw-index-enum-obj index))) + (gen-enum-sym obj sym))) ((str-expr) value) ((rtx) (rtl-c-with-estate estate mode value)) ((ifield) (if (= (ifld-length value) 0) @@ -909,6 +912,9 @@ ((constant) (string-append "((" (mode:c-type mode) ") " (number->string value) ")")) + ((enum) (let ((sym (hw-index-enum-name index)) + (obj (hw-index-enum-obj index))) + (gen-enum-sym obj sym))) ((str-expr) value) ((rtx) (rtl-c-with-estate estate mode value)) ((ifield) (if (= (ifld-length value) 0) diff --git a/cgen/utils.scm b/cgen/utils.scm index 22e8a2381f..65523085f0 100644 --- a/cgen/utils.scm +++ b/cgen/utils.scm @@ -1280,26 +1280,6 @@ #f ; ??? wip ) -; Given X, a number or symbol, reduce it to a constant if possible. -; Numbers always reduce to themselves. -; Symbols are reduced to a number if they're defined as such, -; or to an enum constant if one exists; otherwise X is returned unchanged. -; Requires: symbol-bound? enum-lookup-val - -(define (reduce x) - (if (number? x) - x - ; A symbol bound to a number? - (if (and (symbol? x) (symbol-bound? #f x) (number? (eval1 x))) - (eval1 x) - ; An enum value that has a known numeric value? - (let ((e (enum-lookup-val x))) - (if (number? (car e)) - (car e) - ; Otherwise return X unchanged. - x)))) -) - ; If OBJ has a dump method call it, otherwise return OBJ untouched. (define (dump obj) -- 2.11.0