[patch] rtx-canonicalize cleanup

[Doug Evans <dje at sebabeach dot org>]

Hi.
fyi, I plan to check this in in a few days if there are no objections.
Regression tested with opcodes, sim, sid, intrinsics, docs.

2009-06-26  Doug Evans  <dje@sebabeach.org>

       * 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.

2009-06-26  Doug Evans  <dje@sebabeach.org>

	* 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 <name>).
 
 (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 <context> object or #f if there is none.
-; It is used for error message.
-; RTX-OBJ is the <rtx-func> object of (car expr).
-
-(define (-rtx-canonicalize-expr context rtx-obj expr)
-  #f
-)
-
 ; Return canonical form of EXPR.
+;
 ; CONTEXT is a <context> 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 <context> object or #f if there is none.
-; It is used in error messages.
-; EXTRA-VARS-ALIST is an association list of extra (symbol <mode> 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 <context> object or #f if there is none.
+; It is used in error messages.
+; EXTRA-VARS-ALIST is an association list of extra (symbol <mode> 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*
 )