2009-06-26 Doug Evans * operand.scm (-operand-g/setter-arg-alist): New function. (-operand-parse-getter,operand-parse-setter): Call rtx-compile here ... (-derived-operand-parse): ... instead of calling rtx-canonicalize here. * rtl-traverse.scm (-rtl-traverse): Properly handle #f for expected. * rtl-xform.scm (-rtx-canonicalize-expr): Delete. (rtx-canonicalize): Simplify and generalize by using rtx-traverse. (rtx-compile): Reorganize comments. * rtl.scm (rtx-name-list): Delete. (-rtx-operand-table): Delete. All references deleted. (rtl-init!): Initialize -rtx-name-list. Completely initialize -rtx-traverser-table here. (rtl-finish!): And not here. Index: operand.scm =================================================================== RCS file: /cvs/src/src/cgen/operand.scm,v retrieving revision 1.13 diff -u -p -r1.13 operand.scm --- operand.scm 24 Jun 2009 15:03:09 -0000 1.13 +++ operand.scm 26 Jun 2009 17:37:27 -0000 @@ -478,6 +478,15 @@ ; Parsing support. +; Utility of -operand-parse-[gs]etter to build the EXTRA-VARS-ALIST argument +; to rtx-compile from the index-names list. + +(define (-operand-g/setter-arg-alist arg-list) + (map (lambda (arg) + (list arg 'DFLT arg)) + arg-list) +) + ; Utility of -operand-parse-[gs]etter to build the expected syntax, ; for use in error messages. @@ -494,14 +503,19 @@ ) ; Parse a getter spec. -; The syntax is (([index-names]) (... code ...)). +; The syntax is (([index-names]) expr). ; Omit `index-names' for scalar objects. ; {rank} is the required number of elements in {index-names}. +; +; NOTE: `expr' is uncompiled (and uncanonicalized) rtl. +; Therefore, it may be just and operand name, +; instead of, e.g., (operand () DFLT ). (define (-operand-parse-getter context getter rank) (if (null? getter) #f ; use default (let () + ;; Check the overall format and the argument list. (if (or (not (list? getter)) (!= (length getter) 2) (not (and (list? (car getter)) @@ -510,13 +524,18 @@ (string-append "invalid getter, should be " (-operand-g/setter-syntax rank #f)) getter)) - (if (not (rtx? (cadr getter))) - (context-error context "invalid rtx expression" getter)) - getter)) + ;; Check the expression. + (let ((compiled-expr + (rtx-compile context (cadr getter) + (-operand-g/setter-arg-alist (car getter))))) + ;; Simple test for a valid outer rtx. + (if (not (rtx? compiled-expr)) + (context-error context "invalid rtl expression" (cadr getter))) + (list (car getter) compiled-expr)))) ) ; Parse a setter spec. -; The syntax is (([index-names] newval) (... code ...)). +; The syntax is (([index-names] newval) expr). ; Omit `index-names' for scalar objects. ; {rank} is the required number of elements in {index-names}. @@ -532,9 +551,14 @@ (string-append "invalid setter, should be " (-operand-g/setter-syntax rank #t)) setter)) - (if (not (rtx? (cadr setter))) - (context-error context "invalid rtx expression" setter)) - setter)) + ;; Check the expression. + (let ((compiled-expr + (rtx-compile context (cadr setter) + (-operand-g/setter-arg-alist (car setter))))) + ;; Simple test for a valid outer rtx. + (if (not (rtx? compiled-expr)) + (context-error context "invalid rtl expression" (cadr setter))) + (list (car setter) compiled-expr)))) ) ; Parse an operand definition. @@ -859,14 +883,12 @@ (if (null? getter) #f (-operand-parse-getter context - (list args - (rtx-canonicalize context getter)) + (list args getter) (length args))) (if (null? setter) #f (-operand-parse-setter context - (list (append args '(newval)) - (rtx-canonicalize context setter)) + (list (append args '(newval)) setter) (length args))) ))) (elm-set! result 'hw-name (obj:name (hardware-for-mode mode-obj))) Index: rtl-traverse.scm =================================================================== RCS file: /cvs/src/src/cgen/rtl-traverse.scm,v retrieving revision 1.5 diff -u -p -r1.5 rtl-traverse.scm --- rtl-traverse.scm 24 Jun 2009 15:03:09 -0000 1.5 +++ rtl-traverse.scm 26 Jun 2009 17:37:27 -0000 @@ -732,7 +732,9 @@ ; EXPR is not a list. ; See if it's an operand shortcut. - (if (memq expected '(RTX SETRTX)) + ; "#f" means "don't care". + ; ??? Ifields, integers, and enums can't be set. + (if (memq expected '(RTX SETRTX #f)) (cond ((symbol? expr) (cond ((current-op-lookup expr) @@ -762,7 +764,7 @@ "unexpected operand" expr))) - ; Not expecting RTX or SETRTX. + ; We required a specific kind of rtx and didn't get it. (context-error (tstate-context tstate) "unexpected operand" expr))) Index: rtl-xform.scm =================================================================== RCS file: /cvs/src/src/cgen/rtl-xform.scm,v retrieving revision 1.2 diff -u -p -r1.2 rtl-xform.scm --- rtl-xform.scm 22 Jun 2009 07:02:36 -0000 1.2 +++ rtl-xform.scm 26 Jun 2009 17:37:29 -0000 @@ -357,20 +357,8 @@ ;; rtx-canonicalize (and supporting cast) -; RTX canonicalization. -; ??? wip - -; Subroutine of rtx-canonicalize. -; Return canonical form of rtx expression EXPR. -; CONTEXT is a object or #f if there is none. -; It is used for error message. -; RTX-OBJ is the object of (car expr). - -(define (-rtx-canonicalize-expr context rtx-obj expr) - #f -) - ; Return canonical form of EXPR. +; ; CONTEXT is a object or #f if there is none. ; It is used for error message. ; @@ -383,39 +371,16 @@ ; - absent result mode of those that require a mode -> DFLT ; - rtx macros are expanded ; -; EXPR is returned in source form. We could speed up future processing by -; transforming it into a more compiled form, but that makes debugging more -; difficult, so for now we don't. +; ??? This is currently equivalent to rtx-compile, delete? (define (rtx-canonicalize context expr) - ; FIXME: wip - (cond ((integer? expr) - (rtx-make-const 'INT expr)) - ((symbol? expr) - (let ((op (current-op-lookup expr))) - (if op - (rtx-make-operand expr) - (context-error context "can't canonicalize" expr)))) - ((pair? expr) - expr) - (else - (context-error context "can't canonicalize" expr))) + ; Just call the traverser without doing anything special. + (rtx-traverse context #f expr (lambda args #f) #f) ) ;; rtx-compile (and supporting cast) -; Convert rtl expression EXPR from source form to compiled form. -; The expression is validated and rtx macros are expanded as well. -; CONTEXT is a object or #f if there is none. -; It is used in error messages. -; EXTRA-VARS-ALIST is an association list of extra (symbol value) -; elements to be used during value lookup. -; -; This does the same operation that rtx-traverse does, except that it provides -; a standard value for EXPR-FN. -; -; ??? In the future the compiled form may be the same as the source form -; except that all elements would be converted to their respective objects. +; EXPR-FN for rtx-compile. (define (-compile-expr-fn rtx-obj expr mode parent-expr op-pos tstate appstuff) ; (cond @@ -428,6 +393,16 @@ (-rtx-traverse-operands rtx-obj expr tstate appstuff)) ) +; Convert rtl expression EXPR from source form to compiled form. +; The expression is validated and rtx macros are expanded as well. +; CONTEXT is a object or #f if there is none. +; It is used in error messages. +; EXTRA-VARS-ALIST is an association list of extra (symbol value) +; elements to be used during value lookup. +; +; This does the same operation that rtx-traverse does, except that it provides +; a standard value for EXPR-FN. + (define (rtx-compile context expr extra-vars-alist) (-rtx-traverse expr #f 'DFLT #f 0 (tstate-make context #f Index: rtl.scm =================================================================== RCS file: /cvs/src/src/cgen/rtl.scm,v retrieving revision 1.11 diff -u -p -r1.11 rtl.scm --- rtl.scm 24 Jun 2009 15:03:09 -0000 1.11 +++ rtl.scm 26 Jun 2009 17:37:29 -0000 @@ -168,9 +168,9 @@ ; List of all defined rtx names. This can be map'd over without having ; to know the innards of -rtx-func-table (which is a hash table). +; ??? This could go away if there was another way to iterate over a hashq. (define -rtx-name-list nil) -(define (rtx-name-list) -rtx-name-list) ; Table of rtx function objects. ; This is set in rtl-init!. @@ -194,11 +194,6 @@ (define -rtx-macro-table nil) -; Table of operands, modes, and other non-functional aspects of RTL. -; This is defined in rtl-finish!, after all operands have been read in. - -(define -rtx-operand-table nil) - ; Number of next rtx to be defined. (define -rtx-num-next #f) @@ -1072,6 +1067,7 @@ ; Called before a .cpu file is read in. (define (rtl-init!) + (set! -rtx-name-list nil) (set! -rtx-func-table (make-hash-table 127)) (set! -rtx-macro-table (make-hash-table 127)) (set! -rtx-num-next 0) @@ -1092,6 +1088,20 @@ )) -rtx-name-list) + ; Table of traversers for the various rtx elements. + (let ((hash-table (-rtx-make-traverser-table))) + (set! -rtx-traverser-table (make-vector (rtx-max-num) #f)) + (for-each (lambda (rtx-name) + (let ((rtx (rtx-lookup rtx-name))) + (if rtx + (vector-set! -rtx-traverser-table (rtx-num rtx) + (map1-improper + (lambda (arg-type) + (cons arg-type + (hashq-ref hash-table arg-type))) + (rtx-arg-types rtx)))))) + -rtx-name-list)) + (reader-add-command! 'define-subr "\ Define an rtx subroutine, name/value pair list version. @@ -1106,45 +1116,20 @@ Define an rtx subroutine, name/value pai *UNSPECIFIED* ) -; Called after cpu files are loaded to add misc. remaining entries to the -; rtx handler table for use during evaluation. +; Called after cpu files are loaded to complete the construction of +; rtx related support. +; +; NOTE: rtx traversal is done while the .cpu file is loaded, e.g. to +; compile expressions. Things required for traversal must be completed +; before .cpu files are loaded. +; ; rtl-finish! must be done before ifmt-compute!, the latter will ; construct hardware objects which is done by rtx evaluation. +; [NOTE: This may no longer be true.] (define (rtl-finish!) - (logit 2 "Building rtx operand table ...\n") - ; Update s-pc, must be called after operand-init!. (set! s-pc pc) - ; Table of traversers for the various rtx elements. - (let ((hash-table (-rtx-make-traverser-table))) - (set! -rtx-traverser-table (make-vector (rtx-max-num) #f)) - (for-each (lambda (rtx-name) - (let ((rtx (rtx-lookup rtx-name))) - (if rtx - (vector-set! -rtx-traverser-table (rtx-num rtx) - (map1-improper - (lambda (arg-type) - (cons arg-type - (hashq-ref hash-table arg-type))) - (rtx-arg-types rtx)))))) - (rtx-name-list))) - - ; Initialize the operand hash table. - (set! -rtx-operand-table (make-hash-table 127)) - - ; Add the operands to the eval symbol table. - (for-each (lambda (op) - (hashq-set! -rtx-operand-table (obj:name op) op) - ) - (current-op-list)) - - ; Add ifields to the eval symbol table. - (for-each (lambda (f) - (hashq-set! -rtx-operand-table (obj:name f) f) - ) - (non-derived-ifields (current-ifld-list))) - *UNSPECIFIED* )