moved imulq to dynamic-typing, where it is first needed

Author: jsiek

dynamic-typing.rkt

@@ -442,6 +442,10 @@
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;; select-instructions : C -> psuedo-x86
 
+  (define/override (instructions)
+    (set-union (super instructions)
+	       (set 'imulq)))
+
   (define/override (select-instructions)
     (lambda (x)
       (vomit "select instructions" x)
@@ -470,6 +474,23 @@
            (movq (int 0) ,lhs^))]
         [else ((super select-instructions) x)])))
 
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; patch-instructions
+
+  (define/override (patch-instructions)
+    (lambda (e)
+      (match e
+	 ;; for imulq, destination must be a register -Jeremy
+	 [`(imulq ,s (reg ,d))
+	  `((imulq ,s (reg ,d)))]
+	 [`(imulq ,s ,d)
+	  `((movq ,d (reg rax))
+	    (imulq ,s (reg rax))
+	    (movq (reg rax) ,d))]
+	 [else
+	  ((super patch-instructions) e)]
+	 )))
+
   ));; compile-R7
 
 

int_exp.rkt

@@ -10,15 +10,14 @@
     (super-new)
 
     (define/public (primitives)
-      (set '+ '- '* 'read))
+      (set '+ '- 'read))
 
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; uniquify : env -> S0 -> S0
     (define/public (uniquify env)
       (lambda (e)
 	(define recur (uniquify env))
 	(match e
-          ['(void) '(void)]
           [(? symbol?) (cdr (assq e env))]
           [(? integer?) e]
           [`(let ([,x ,(app recur new-e)]) ,body)
@@ -68,7 +67,8 @@
 
     (define/public (binary-op->inst op)
       (match op
-         ['+ 'addq] ['- 'subq] ['* 'imulq]
+         ['+ 'addq]
+	 ['- 'subq]
 	 [else (error "in binary-op->inst unmatched" op)]
 	 ))
 
@@ -79,7 +79,7 @@
 
     (define/public (commutative? op)
       (match op
-         ['+ #t] ['* #t] 
+         ['+ #t]
          [else #f]))
 
     (define/public (select-instructions)
@@ -136,7 +136,7 @@
     (define/public (first-offset) 8)
 
     (define/public (instructions)
-      (set 'addq 'subq 'imulq 'negq 'movq))
+      (set 'addq 'subq 'negq 'movq))
 
     (define/public (assign-homes homes)
       (lambda (e)
@@ -195,13 +195,6 @@
 	   [`(program ,stack-space ,ss ...)
 	    `(program ,stack-space 
 		      ,@(append* (map (patch-instructions) ss)))]
-	   ;; for imulq, destination must be a register -Jeremy
-	   [`(imulq ,s (reg ,d))
-	    `((imulq ,s (reg ,d)))]
-	   [`(imulq ,s ,d)
-	    `((movq ,d (reg rax))
-	      (imulq ,s (reg rax))
-	      (movq (reg rax) ,d))]
 	   [`(,instr-name ,s ,d)
 	    #:when (set-member? (instructions) instr-name)
 	    (cond [(and (in-memory? s) (in-memory? d))	

vectors.rkt

@@ -64,7 +64,14 @@
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; uniqueify : S1 -> C1-expr x (C1-stmt list)
 
-    ;; nothing to do
+    (define/override (uniquify env)
+      (lambda (e)
+	(define recur (uniquify env))
+	(match e
+           ['(void) '(void)]
+	   [else
+	    ((super uniquify env) e)]
+	   )))
 
     ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
     ;; expose-allocation