From 47eb15d0ddbc91f1c0a6d0dac0d1475a9cd49c0b Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@dino13.iro.umontreal.ca>
Date: Mon, 15 Jun 2009 18:30:31 -0400
Subject: [PATCH] Changed the way gotos are generated, so we don't have bbs
 that end with multiple unconditional jumps. This solves the bug that we had
 in PICOBIT's cmp function.

---
 cfg.scm                           | 21 ++++++++++++---------
 six-comp.scm                      |  3 ++-
 tests/picobit/picobit-vm-sixpic.c |  2 +-
 3 files changed, 15 insertions(+), 11 deletions(-)

diff --git a/cfg.scm b/cfg.scm
index 0da024f..f99afbf 100644
--- a/cfg.scm
+++ b/cfg.scm
@@ -20,6 +20,9 @@
   succs
   live-before) ; stored as a set
 
+(define (bb-name bb)
+  (asm-label-id (bb-label bb)))
+
 (define-type instr
   extender: define-type-of-instr
   (live-before unprintable:) ; these 2 are stored as sets
@@ -91,9 +94,6 @@
       (set! current-def-proc-bb-id (+ current-def-proc-bb-id 1))
       bb))
 
-  (define (bb-name bb)
-    (asm-label-id (bb-label bb)))
-
   (define (emit instr) (add-instr bb instr))
 
   (define current-def-proc #f)
@@ -345,7 +345,8 @@
   (define (switch ast)
     (let* ((var      (subast1 ast))
 	   (entry-bb bb)
-	   (exit-bb  (begin (in (new-bb)) (push-break bb) bb)))
+	   (exit-bb  (new-bb)))
+      (push-break exit-bb)
       (let loop ((asts    (cdr (ast-subasts ast))) ; car is the tested variable
 		 (bbs     '())  ; first bb of each case
 		 (end-bbs '())  ; last bb of each case
@@ -505,8 +506,10 @@
     (emit (new-instr 'goto #f #f (subast1 ast))))
   
   (define (gen-goto dest)
-    (add-succ bb dest)
-    (emit (new-instr 'goto #f #f #f)))
+    (if (null? (bb-succs bb))
+	;; since this is an unconditional goto, we want only one
+	(begin (add-succ bb dest)
+	       (emit (new-instr 'goto #f #f #f)))))
 
   (define (test-expression ast bb-true bb-false)
 
@@ -1292,9 +1295,9 @@
 
 (define (print-cfg-bbs cfg)
   (for-each (lambda (bb)
-	      (pp (list "BB:" (bb-label-num bb)
-			"SUCCS" (map bb-label-num (bb-succs bb))
-			"PREDS" (map bb-label-num (bb-preds bb))
+	      (pp (list "BB:" (bb-name bb)
+			"SUCCS" (map bb-name (bb-succs bb))
+			"PREDS" (map bb-name (bb-preds bb))
 			(cond ((null? (bb-rev-instrs bb)) "EMPTY")
 			      ((and (null? (cdr (bb-rev-instrs bb)))
 				     (eq? (instr-id (car (bb-rev-instrs bb))) 'goto)) "SINGLE GOTO")
diff --git a/six-comp.scm b/six-comp.scm
index 040f327..7c5f578 100755
--- a/six-comp.scm
+++ b/six-comp.scm
@@ -92,8 +92,9 @@
 	'(print-cfg-bbs cfg)
 	'(pretty-print cfg)
         (remove-branch-cascades-and-dead-code cfg)
-	(remove-converging-branches cfg) ;; TODO maybe make it possible to disable it, and the next one ?
+	(remove-converging-branches cfg) ;; TODO maybe make it possible to disable it, the one before, and the next one ?
 	(remove-dead-instructions cfg)
+	'(print-cfg-bbs cfg)
  	(if allocate-registers? (allocate-registers cfg))
 	(assembler-gen filename cfg)
 	(asm-assemble)
diff --git a/tests/picobit/picobit-vm-sixpic.c b/tests/picobit/picobit-vm-sixpic.c
index 07391e6..2dcf0b7 100644
--- a/tests/picobit/picobit-vm-sixpic.c
+++ b/tests/picobit/picobit-vm-sixpic.c
@@ -578,7 +578,7 @@ int8 negp (int16 x) {
 int8 cmp (int16 x, int16 y) { // TODO changed. used to return -1, 0 and 1, now is 0, 1, 2
 
 
-  int8 result = 1; // in cmp.c : cell 3
+  int8 result = 1;
   int16 xlo;
   int16 ylo;
 
-- 
2.11.4.GIT