all tests pass again

Author: jsiek

conditionals.rkt

@@ -10,7 +10,9 @@
   (class compile-reg-R0
     (super-new)
 
-    (inherit liveness-ss first-offset variable-size in-memory?)
+    (inherit liveness-ss first-offset variable-size in-memory? 
+	     color-graph identify-home)
+    (inherit-field largest-color)
 
     (define/public (comparison-ops)
       (set 'eq? '< '<= '> '>=))
@@ -368,6 +370,10 @@
 			 ,new-els-ss ,(cdr els-lives))
 		    (set-union live-after-thn live-after-els
 			       (free-vars cnd)))]
+          [`(program ,xs (type ,ty) ,ss ...)
+	    (define-values (new-ss lives) ((liveness-ss (set)) ss))
+	    (assert "lives ss size" (= (length (cdr lives)) (length new-ss)))
+	    `(program (,xs ,(cdr lives)) (type ,ty) ,@new-ss)]
 	   [else ((super uncover-live live-after) ast)]
 	   )))
 
@@ -390,9 +396,37 @@
 	      (define new-thn (map build-inter thn-ss thn-lives))
 	      (define new-els (map build-inter els-ss els-lives))
 	      `(if ,cnd ,new-thn ,new-els)]
+	     [`(program (,xs ,lives) (type ,ty) ,ss ...)
+	      (define G (make-graph xs))
+	      (define new-ss 
+		(for/list ([inst ss] [live-after lives])
+			  ((build-interference live-after G) inst)))
+	      (print-dot G "./interfere.dot")
+	      `(program (,xs ,G) (type ,ty) ,@new-ss)]
 	     [else ((super build-interference live-after G) ast)]
 	     )))
 
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+    ;; allocate-registers
+
+    (define/override (allocate-registers)
+      (lambda (ast)
+	(match ast
+	   ;; just adding the hanlding of (type ,ty) -Jeremy
+           [`(program (,locals ,IG ,MG) (type ,ty) ,ss ...)
+	    (define color (color-graph IG MG locals))
+	    (define homes
+	      (make-hash
+	       (for/list ([x locals])
+			 (cons x (identify-home (hash-ref color x))))))
+	    (define num-spills 
+	      (max 0 (- (add1 largest-color)
+			(vector-length registers-for-alloc))))
+	    (define stk-size (* num-spills (variable-size)))
+	    `(program ,stk-size (type ,ty)
+		      ,@(map (assign-homes homes) ss))]
+	   )))
+
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; assign-homes : homes -> pseudo-x86 -> pseudo-x86
     (define/override (assign-homes homes)

dynamic-typing.rkt

@@ -446,7 +446,7 @@
     (lambda (x)
       (vomit "select instructions" x)
       (match x
-        [`(assign ,lhs (vector-ref ,e-vec (has-type ,i ,Integer))) 
+        [`(assign ,lhs (vector-ref ,e-vec ,i)) 
 	 #:when (not (number? i))
          (define lhs^ ((select-instructions) lhs))
          (define e-vec^ ((select-instructions) e-vec))
@@ -456,7 +456,7 @@
 	   (imulq (int 8) (reg r11))
 	   (addq ,e-vec^ (reg r11))
 	   (movq (deref r11 0) ,lhs^))]
-        [`(assign ,lhs (vector-set! ,e-vec (has-type ,i ,Integer) ,e-arg))
+        [`(assign ,lhs (vector-set! ,e-vec ,i ,e-arg))
 	 #:when (not (number? i))
          (define lhs^ ((select-instructions) lhs))
          (define e-vec^ ((select-instructions) e-vec))

int_exp.rkt

@@ -146,21 +146,6 @@
 	   [`(reg ,r) `(reg ,r)]
 	   [`(deref ,r ,n) `(deref ,r ,n)]
 	   [`(callq ,f) `(callq ,f)]
-	   [`(program (,xs ...) (type ,ty) ,ss ...)
-	    ;; create mapping of variables to stack locations
-	    (define (make-stack-loc n)
-	      `(deref rbp ,(- (+ (first-offset)
-				 (* (variable-size) n)))))
-	    (define new-homes
-	      (make-hash (map cons xs
-			      (map make-stack-loc
-				   (stream->list (in-range 0 (length xs)))))))
-	    (define stack-space (align 
-				 (* (length xs)
-				    (variable-size))
-				 16))
-	    `(program ,stack-space (type ,ty)
-		      ,@(map (assign-homes new-homes) ss))]
 	   [`(program (,xs ...) ,ss ...)
 	    ;; create mapping of variables to stack locations
 	    (define (make-stack-loc n)

interp.rkt

@@ -20,7 +20,7 @@
 (define program (make-parameter '()))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Interpreters for S0: integer arithmetic and 'let'
+;; Interpreters for R0: integer arithmetic and 'let'
 
 (define interp-R0
   (class object%
@@ -166,7 +166,7 @@
     )) ;; class interp-R0
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Interpreters for S1: Booleans and conditionals
+;; Interpreters for R1: Booleans and conditionals
 
 (define interp-R1
   (class interp-R0
@@ -387,7 +387,7 @@
     ));; class interp-R1
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Interpreters for S2: Vectors
+;; Interpreters for R2: Vectors
 
 (define interp-R2
   (class interp-R1
@@ -730,7 +730,7 @@
     ));; interp-R2
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Interpreters for S3: functions
+;; Interpreters for R3: functions
 
 
 (define interp-R3
@@ -789,6 +789,8 @@
           [`(program (type ,ty) ,ds ... ,body)
 	    ((interp-F env) `(program ,@ds ,body))]
           [`(program ,ds ... ,body)
+	   ((initialize!) runtime-config:rootstack-size 
+	    runtime-config:heap-size)
            (let ([top-level (map  (interp-F '()) ds)])
 	      ((interp-F top-level) body))]
 	  ;; For R3
@@ -954,7 +956,7 @@
     )) ;; end  interp-R3
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Interpreters for S4: lambda
+;; Interpreters for R4: lambda
 
 (define interp-R4
   (class interp-R3
@@ -1006,6 +1008,8 @@
           [`(program (type ,ty) ,ds ... ,body)
            ((interp-F env) `(program ,@ds ,body))]
           [`(program ,ds ... ,body)
+	   ((initialize!) runtime-config:rootstack-size 
+	    runtime-config:heap-size)
            (let ([top-level (map (interp-F '()) ds)])
              ;; Use set-cdr! on define lambda's for mutual recursion
              (for/list ([b top-level])

register_allocator.rkt

@@ -62,10 +62,6 @@
     (define/public (uncover-live live-after)
       (lambda (ast)
 	(match ast
-          [`(program ,xs (type ,ty) ,ss ...)
-	    (define-values (new-ss lives) ((liveness-ss (set)) ss))
-	    (assert "lives ss size" (= (length (cdr lives)) (length new-ss)))
-	    `(program (,xs ,(cdr lives)) (type ,ty) ,@new-ss)]
           [`(program ,xs ,ss ...)
 	    (define-values (new-ss lives) ((liveness-ss (set)) ss))
 	    (assert "lives ss size" (= (length (cdr lives)) (length new-ss)))
@@ -95,13 +91,6 @@
 		       #:when (not (equal? v u)))
 		      (add-edge G u v)))
 	    ast]
-           [`(program (,xs ,lives) (type ,ty) ,ss ...)
-	    (define G (make-graph xs))
-	    (define new-ss 
-	      (for/list ([inst ss] [live-after lives])
-	         ((build-interference live-after G) inst)))
-	    (print-dot G "./interfere.dot")
-	    `(program (,xs ,G) (type ,ty) ,@new-ss)]
            [`(program (,xs ,lives) ,ss ...)
 	    (define G (make-graph xs))
 	    (define new-ss 
@@ -127,19 +116,8 @@
                 (add-edge G s d)
                 '())
 	    ast]
-           [`(program (,xs ,IG) (type ,ty) ,ss ...)
-            (define MG (make-graph xs)) ;; JGS
-            (define new-ss
-              (if use-move-biasing
-                  (let ([nss 
-                         (for/list ([inst ss])
-                           ((build-move-graph MG) inst))])
-                    (print-dot MG "./move.dot")
-                    nss)
-                  ss))
-            `(program (,xs ,IG ,MG) (type ,ty) ,@new-ss)]
            [`(program (,xs ,IG) ,ss ...)
-            (define MG (make-graph xs)) ;; JGS
+            (define MG (make-graph xs))
             (define new-ss
               (if use-move-biasing
                   (let ([nss 
@@ -230,7 +208,7 @@
     (define/public (allocate-registers)
       (lambda (ast)
 	(match ast
-           [`(program (,locals ,IG ,MG) (type ,ty) ,ss ...)
+           [`(program (,locals ,IG ,MG) ,ss ...)
 	    (define color (color-graph IG MG locals))
 	    (define homes
 	      (make-hash
@@ -240,7 +218,7 @@
 	      (max 0 (- (add1 largest-color)
 			(vector-length registers-for-alloc))))
 	    (define stk-size (* num-spills (variable-size)))
-	    `(program ,stk-size (type ,ty)
+	    `(program ,stk-size 
 		      ,@(map (assign-homes homes) ss))]
 	   )))