Index: cgen/decode.scm
===================================================================
RCS file: /cvs/src/src/cgen/decode.scm,v
retrieving revision 1.3
diff -c -p -b -r1.3 decode.scm
*** cgen/decode.scm	2000/11/10 16:43:21	1.3
--- cgen/decode.scm	2002/01/02 20:58:04
***************
*** 222,228 ****
  (define (-distinguishing-bit-population masks mask-lens values lsb0?)
    (let* ((max-length (apply max mask-lens))
  	 (0-population (make-vector max-length 0))
! 	 (1-population (make-vector max-length 0)))
      ; Compute the 1- and 0-population vectors
      (for-each (lambda (mask len value)
  		(logit 5 " population count mask=" (number->hex mask) " len=" len "\n")
--- 222,229 ----
  (define (-distinguishing-bit-population masks mask-lens values lsb0?)
    (let* ((max-length (apply max mask-lens))
  	 (0-population (make-vector max-length 0))
! 	 (1-population (make-vector max-length 0))
! 	 (num-insns (length masks)))
      ; Compute the 1- and 0-population vectors
      (for-each (lambda (mask len value)
  		(logit 5 " population count mask=" (number->hex mask) " len=" len "\n")
***************
*** 240,247 ****
      (list->vector
       (map (lambda (p0 p1)
  	    (logit 4 p0 "/" p1 " ")
! 	    ; (sqrt (+ p0 p1 (* p0 p1))) ; funny function - nice curve
! 	    (sqrt (* p0 p1))) ; geometric mean
  	  (vector->list 0-population) (vector->list 1-population))))
  )
  
--- 241,262 ----
      (list->vector
       (map (lambda (p0 p1)
  	    (logit 4 p0 "/" p1 " ")
! 	    ; The most useful bits for decoding are those with counts in both
! 	    ; p0 and p1. These are the bits which distinguish one insn from
! 	    ; another. Assign these bits a high value (greater than num-insns).
! 	    ;
! 	    ; The next most useful bits are those with counts in either p0
! 	    ; or p1.  These bits represent specializations of other insns.
! 	    ; Assign these bits a value between 0 and (num-insns - 1). Note that
! 	    ; p0 + p1 is guaranteed to be <= num-insns.
! 	    ;
! 	    ; Bits with no count in either p0 or p1 are useless for decoding
! 	    ; and should never be considered. Assigning these bits a value of
! 	    ; 0 ensures this.
! 	    (cond
! 	     ((= (+ p0 p1) 0) 0)
! 	     ((= (* p0 p1) 0) (- num-insns (+ p0 p1)))
! 	     (else (+ num-insns (sqrt (* p0 p1))))))
  	  (vector->list 0-population) (vector->list 1-population))))
  )
  
***************
*** 302,311 ****
  	       " picks=(" old-picks ") pop=(" remaining-population ")"
  	       " threshold=" count-threshold " new-picks=(" new-picks ")\n")
  	(cond 
  	 ; No new matches?
  	 ((null? new-picks)
  	  (if (null? old-picks)
! 	      (logit 1 "-population-top-few: No bits left to pick from!\n"))
  	  old-picks)
  	 ; Way too many matches?
  	 ((> (+ (length new-picks) (length old-picks)) (+ size 3))
--- 317,332 ----
  	       " picks=(" old-picks ") pop=(" remaining-population ")"
  	       " threshold=" count-threshold " new-picks=(" new-picks ")\n")
  	(cond 
+ 	 ; No point picking bits with population count of zero.  This leads to
+ 	 ; the generation of layers of subtables which resolve nothing.  Generating
+ 	 ; these tables can slow the build by several orders of magnitude.
+ 	 ((= 0 count-threshold)
+ 	  (logit 2 "-population-top-few: count-threshold is zero!\n")
+ 	  old-picks)
  	 ; No new matches?
  	 ((null? new-picks)
  	  (if (null? old-picks)
! 	      (logit 2 "-population-top-few: No bits left to pick from!\n"))
  	  old-picks)
  	 ; Way too many matches?
  	 ((> (+ (length new-picks) (length old-picks)) (+ size 3))
***************
*** 495,501 ****
  (define -build-decode-table-entry-args #f)
  
  (define (-build-decode-table-entry insn-vec startbit decode-bitsize index index-list lsb0? invalid-insn)
!   (let ((slot (filter-harmlessly-ambiguous-insns (vector-ref insn-vec index))))
      (logit 2 "Processing decode entry "
  	   (number->string index)
  	   " in "
--- 516,522 ----
  (define -build-decode-table-entry-args #f)
  
  (define (-build-decode-table-entry insn-vec startbit decode-bitsize index index-list lsb0? invalid-insn)
!   (let ((slot (vector-ref insn-vec index)))
      (logit 2 "Processing decode entry "
  	   (number->string index)
  	   " in "
***************
*** 553,559 ****
  
  	; If bitnums is still nil there is an ambiguity.
  	(if (null? bitnums)
! 
  	    (begin
  	      ; If all insns are marked as DECODE-SPLIT, don't warn.
  	      (if (not (all-true? (map (lambda (insn)
--- 574,589 ----
  
  	; If bitnums is still nil there is an ambiguity.
  	(if (null? bitnums)
! 	    (begin
! 	      ; Try filtering out insns which are more general cases of
! 	      ; other insns in the slot.  The filtered insns will appear
! 	      ; in other slots as appropriate.
! 	      (set! slot (filter-non-specialized-ambiguous-insns slot))
! 
! 	      (if (= 1 (length slot))
! 		  ; Only 1 insn left in the slot, so take it.
! 		  (dtable-entry-make index 'insn (car slot))
! 		  ; There is still more than one insn in 'slot', so there is still an ambiguity.
  		  (begin
  		    ; If all insns are marked as DECODE-SPLIT, don't warn.
  		    (if (not (all-true? (map (lambda (insn)
***************
*** 565,571 ****
  					  (string-append ", " (obj:name insn)))
  					slot))
  			   "\n"))
! 	      ; Things aren't entirely hopeless.  See if any ifield-assertion
  	      ; specs are present.
  	      ; FIXME: For now we assume that if they all have an
  	      ; ifield-assertion spec, then there is no ambiguity (it's left
--- 595,608 ----
  						(string-append ", " (obj:name insn)))
  					      slot))
  				 "\n"))
! 			; Things aren't entirely hopeless.  We've warned about the ambiguity.
! 		        ; Now, if there are any identical insns, filter them out.  If only one
! 		        ; remains, then use it.
! 		    (set! slot (filter-identical-ambiguous-insns slot))
! 		    (if (= 1 (length slot))
! 			; Only 1 insn left in the slot, so take it.
! 			(dtable-entry-make index 'insn (car slot))
! 		        ; Otherwise, see if any ifield-assertion
  			; specs are present.
  			; FIXME: For now we assume that if they all have an
  			; ifield-assertion spec, then there is no ambiguity (it's left
***************
*** 588,594 ****
  		  (dtable-entry-make index 'expr
  				     (exprtable-make
  				      (-gen-exprtable-name exprtable-entries)
! 				      exprtable-entries)))))
  
  	    ; There is no ambiguity so generate the subtable.
  	    ; Need to build `subtable' separately because we
--- 625,631 ----
  			    (dtable-entry-make index 'expr
  					       (exprtable-make
  						(-gen-exprtable-name exprtable-entries)
! 						exprtable-entries))))))))
  
  	    ; There is no ambiguity so generate the subtable.
  	    ; Need to build `subtable' separately because we
Index: cgen/insn.scm
===================================================================
RCS file: /cvs/src/src/cgen/insn.scm,v
retrieving revision 1.5
diff -c -p -b -r1.5 insn.scm
*** cgen/insn.scm	2001/09/18 03:17:12	1.5
--- cgen/insn.scm	2002/01/02 20:58:04
***************
*** 708,715 ****
  
  
  ; Filter out instructions whose ifield patterns are strict subsets of
! ; another.  For decoding purpose, it is sufficient to consider the
  ; more general cousin.
  
  (define (filter-harmlessly-ambiguous-insns insn-list)
    (logit 3 "Filtering " (length insn-list) " instructions.\n")
--- 708,720 ----
  
  
  ; Filter out instructions whose ifield patterns are strict subsets of
! ; another.  For decoding purposes, it is sufficient to consider the
  ; more general cousin.
+ ;
+ ; NOTE: Not currently used.  This filtering is not harmless for ISAs
+ ; in which certain values of a given ifield change the semantics of
+ ; the insn. For example, encoding register 15 in a field normally
+ ; used for specifying a register may result in a different addressing mode.
  
  (define (filter-harmlessly-ambiguous-insns insn-list)
    (logit 3 "Filtering " (length insn-list) " instructions.\n")
***************
*** 735,740 ****
--- 740,799 ----
  	insn-list)
  )
  
+ ; Filter out instructions whose ifield patterns are strict supersets of
+ ; another, keeping the less general cousin.  Used to resolve ambiguity
+ ; when there are no more bits to consider.
+ 
+ (define (filter-non-specialized-ambiguous-insns insn-list)
+   (logit 3 "Filtering " (length insn-list) " instructions for non specializations.\n")
+   (find (lambda (insn)
+ 	  (let* ((i-mask (insn-base-mask insn))
+ 		 (i-mask-len (insn-base-mask-length insn))
+ 		 (i-value (insn-value insn))
+ 		 (subset-insn (find-first 
+ 			       (lambda (insn2) ; insn2: possible submatch (more mask bits)
+ 				    (let ((i2-mask (insn-base-mask insn2))
+ 					  (i2-mask-len (insn-base-mask-length insn2))
+ 					  (i2-value (insn-value insn2)))
+ 				      (and (not (eq? insn insn2))
+ 					   (= i-mask-len i2-mask-len)
+ 					   (mask-superset? i-mask i-value i2-mask i2-value))))
+ 				  insn-list))
+ 		 (keep? (not subset-insn)))
+ 	    (if (not keep?) 
+ 		(logit 2
+ 		       "Instruction " (obj:name insn) " specialization-filtered by "
+ 		       (obj:name subset-insn) "\n"))
+ 	    keep?))
+ 	insn-list)
+ )
+ 
+ ; Filter out instructions whose ifield patterns are identical.
+ 
+ (define (filter-identical-ambiguous-insns insn-list)
+   (logit 3 "Filtering " (length insn-list) " instructions for identical variants.\n")
+   (let loop ((l insn-list) (result nil))
+     (cond ((null? l) (reverse! result))
+ 	  ((find-identical-insn (car l) (cdr l)) (loop (cdr l) result))
+ 	  (else (loop (cdr l) (cons (car l) result)))
+ 	  )
+     )
+ )
+ 
+ (define (find-identical-insn insn insn-list)
+   (let ((i-mask (insn-base-mask insn))
+ 	(i-mask-len (insn-base-mask-length insn))
+ 	(i-value (insn-value insn)))
+     (find-first 
+      (lambda (insn2)
+        (let ((i2-mask (insn-base-mask insn2))
+ 	     (i2-mask-len (insn-base-mask-length insn2))
+ 	     (i2-value (insn-value insn2)))
+ 	 (and (= i-mask-len i2-mask-len)
+ 	      (= i-mask i2-mask)
+ 	      (= i-value i2-value))))
+        insn-list))
+ )
  
  ; Helper function for above: does (m1,v1) match a STRICT superset of (m2,v2) ?
  ;