- Added primop for *.

scheme/ikarus.compiler.altcogen.ss

@@ -2173,6 +2173,13 @@
                  (make-seq
                    (E (make-asm-instr 'move u b))
                    (E (make-asm-instr op a u))))]
+              [(and (memq op '(int* int*/overflow)) (mem? a))
+               (let ([u (mku)])
+                 (make-seq
+                   (make-seq
+                     (E (make-asm-instr 'move u a))
+                     (E (make-asm-instr op u b)))
+                   (E (make-asm-instr 'move a u))))]
               [(and (mem? a) (mem? b)) 
                (let ([u (mku)])
                  (make-seq

scheme/last-revision

@@ -1 +1 @@
-1348
+1349

scheme/pass-specify-rep-primops.ss

@@ -1192,6 +1192,32 @@
   [(E) (nop)]
   [(E a . a*) (assert-fixnums a a*)])
 
+(define-primop * safe
+  [(V) (K (fxsll 1 fx-shift))]
+  [(V a b) 
+   (struct-case a
+     [(constant ak) 
+      (cond
+        [(fx? ak)
+         (with-tmp ([b (T b)])
+           (assert-fixnum b)
+           (prm 'int*/overflow b a))]
+        [else (interrupt)])]
+     [else 
+      (struct-case b
+        [(constant bk)
+         (cond
+           [(fx? bk) 
+            (with-tmp ([a (T a)])
+              (assert-fixnum a)
+              (prm 'int*/overflow a b))]
+           [else (interrupt)])]
+        [else (interrupt)])])]
+  [(P) (K #t)]
+  [(P a . a*) (seq* (assert-fixnums a a*) (K #t))]
+  [(E) (nop)]
+  [(E a . a*) (assert-fixnums a a*)])
+
 (define-primop bitwise-and safe
   [(V) (K (fxsll -1 fx-shift))]
   [(V a . a*)