Variable spilling using temporaries

TODO.md

@@ -1,6 +1,7 @@
 # TODO
 
-* register spilling (spill variables, spill definition-use connected components)
+* select variable to spill, iteration,
+  http://www.cs.cornell.edu/courses/cs412/2008sp/lectures/lec33.pdf
 * 1d-array plus 2d-array
 * coalesce registers (see Chaitin's paper)
 * flatten-code needed?

aiscm/jit.scm

@@ -1,17 +1,17 @@
 (define-module (aiscm jit)
   #:use-module (oop goops)
   #:use-module (ice-9 optargs)
+  #:use-module (ice-9 curried-definitions)
+  #:use-module (ice-9 binary-ports)
   #:use-module (system foreign)
   #:use-module (rnrs bytevectors)
-  #:use-module (ice-9 curried-definitions)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (aiscm util)
   #:use-module (aiscm mem)
   #:use-module (aiscm element)
   #:use-module (aiscm int)
   #:use-module (aiscm sequence)
-  #:use-module (ice-9 binary-ports)
   #:export (<jit-context> <jit-function> <jcc> <cmd> <ptr> <operand> <register> <address> <var>
             asm obj resolve-jumps get-code get-bits ptr get-disp get-index get-target retarget
             ADD MOV MOVSX MOVZX LEA NOP RET PUSH POP SAL SAR SHL SHR NEG SUB IMUL CMP
@@ -132,8 +132,11 @@
 (define (is-ptr? value) (is-a? value <ptr>))
 (define-method (substitute-variables self alist) self)
 (define-method (substitute-variables (self <var>) alist)
-  (let [(register (assq-ref alist self))]
-    (if register (reg (typecode self) (get-code register)) self)))
+  (let [(target (assq-ref alist self))]
+    (cond
+      ((is-a? target <register>) (reg (typecode self) (get-code target)))
+      ((is-a? target <var>)      target)
+      (else                      self))))
 (define-method (substitute-variables (self <ptr>) alist)
   (apply ptr (cons (typecode self) (map (cut substitute-variables <> alist) (get-args self)))))
 (define-method (substitute-variables (self <cmd>) alist)
@@ -434,9 +437,13 @@
                         (flatten-code x)
                         (list x))) prog)))
 (define (spill-variable var offset prog)
-  (let [(load-var (lambda (cmd) (and (memv var (input  cmd)) (MOV var (ptr (typecode var) RSP offset)))))
-        (save-var (lambda (cmd) (and (memv var (output cmd)) (MOV (ptr (typecode var) RSP offset) var))))]
-    (concatenate (map (lambda (cmd) (compact (list (load-var cmd) cmd (save-var cmd)))) prog))))
+  (define (spill cmd)
+    (let [(temporary (make <var> #:type (typecode var)))]
+      (list
+        (and (memv var (input cmd)) (MOV temporary (ptr (typecode var) RSP offset)))
+        (substitute-variables cmd (list (cons var temporary)))
+        (and (memv var (output cmd)) (MOV (ptr (typecode var) RSP offset) temporary))))) 
+  (concatenate (map (compose compact spill) prog)))
 (define* (virtual-registers result-type arg-types proc #:key (registers default-registers))
   (let* [(result-types (if (eq? result-type <null>) '() (list result-type)))
          (arg-vars     (map (cut make <var> #:type <>) arg-types))

aiscm/util.scm

@@ -3,6 +3,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (ice-9 optargs)
+  #:use-module (ice-9 common-list)
   #:use-module (ice-9 curried-definitions)
   #:use-module (rnrs bytevectors)
   #:use-module (system foreign)
@@ -25,7 +26,7 @@
 (define (index a b)
   (let [(tail (member a (reverse b)))]
     (if tail (length (cdr tail)) #f)))
-(define (all-but-last lst) (reverse (cdr (reverse lst))))
+(define (all-but-last lst) (butlast lst 1))
 (define (drop-up-to lst n)
   (if (null? lst) lst (if (zero? n) lst (drop-up-to (cdr lst) (1- n)))))
 (define-syntax-rule (expand n expr) (map (lambda (tmp) expr) (iota n)))

tests/test_jit.scm

@@ -11,7 +11,7 @@
              (aiscm bool)
              (aiscm pointer)
              (guile-tap))
-(planned-tests 341)
+(planned-tests 342)
 (define b1 (random (ash 1  6)))
 (define b2 (random (ash 1  6)))
 (define w1 (random (ash 1 14)))
@@ -751,6 +751,9 @@
 (ok (equal? (list (MOV (ptr <int> RCX) ESI))
             (substitute-variables (list (MOV (ptr <int> p) a)) (list (cons p RCX) (cons a RSI))))
     "Substitute pointer variable")
+(ok (equal? (MOV EAX 0)
+            (substitute-variables (substitute-variables (MOV a 0) (list (cons a b))) (list (cons b RAX))))
+    "Substitute variable with another")
 (ok (equal? (MOV ECX EDX) (substitute-variables (MOV a b) (list (cons a RCX) (cons b RDX))))
     "Substitution works with 'MOV'")
 (ok (equal? (MOVSX RCX EDX) (substitute-variables (MOVSX p b) (list (cons p RCX) (cons b RDX))))
@@ -911,12 +914,12 @@
 (ok (eqv? 3 ((wrap ctx <int> '()  (lambda (r)
                                     (list (MOV r 0) (JMP 'a) (list 'a (MOV r 2)) 'a (ADD r 3) (RET))))))
     "'wrap' creates separate namespaces for labels")
-(ok (equal? (list (MOV EAX 0) (MOV (ptr <int> RSP 8) EAX))
-            (substitute-variables (spill-variable a 8 (list (MOV a 0))) (list (cons a RAX))))
+(ok (equal? (list (MOV EAX 0) (MOV (ptr <int> RSP 8) EAX) (RET))
+            (virtual-registers <null> '() (lambda () (spill-variable a 8 (list (MOV a 0) (RET))))))
     "Write spilled variable to stack")
-(ok (equal? (list (MOV EAX (ptr <int> RSP 16)) (MOV ECX EAX))
-            (substitute-variables (spill-variable a 16 (list (MOV ECX a))) (list (cons a RAX))))
+(ok (equal? (list (MOV EAX (ptr <int> RSP 16)) (MOV ECX EAX) (RET))
+            (virtual-registers <null> '() (lambda () (spill-variable a 16 (list (MOV ECX a) (RET))))))
     "Read spilled variable from stack")
-(ok (equal? (list (MOV AL (ptr <byte> RSP 24)) (ADD AL 1) (MOV (ptr <byte> RSP 24) AL))
-            (substitute-variables (spill-variable u 24 (list (ADD u 1))) (list (cons u RAX))))
+(ok (equal? (list (MOV AL (ptr <byte> RSP 24)) (ADD AL 1) (MOV (ptr <byte> RSP 24) AL) (RET))
+            (virtual-registers <null> '() (lambda () (spill-variable u 24 (list (ADD u 1) (RET))))))
     "Read and write spilled variable")