diff --git a/src/fact.ss b/src/fact.ss
deleted file mode 100644
index 9ddb8df..0000000
--- a/src/fact.ss
+++ /dev/null
@@ -1,6 +0,0 @@
-
-(define (fact n ac)
-  (if (zero? n)
-      ac
-      (fact (- n 1) (* n ac))))
-(begin (fact 10000 1) #f)
diff --git a/src/ikarus.boot b/src/ikarus.boot
index 0de3379..76d3175 100644
Binary files a/src/ikarus.boot and b/src/ikarus.boot differ
diff --git a/src/libaltcogen.ss b/src/libaltcogen.ss
new file mode 100644
index 0000000..1da10f9
--- /dev/null
+++ b/src/libaltcogen.ss
@@ -0,0 +1,980 @@
+
+(module (alt-cogen)
+;;; input to cogen is <Program>:
+;;;  <Expr> ::= (constant x)
+;;;           | (var)
+;;;           | (primref name)
+;;;           | (bind var* <Expr>* <Expr>)
+;;;           | (fix var* <FixRhs>* <Expr>)
+;;;           | (conditional <Expr> <Expr> <Expr>)
+;;;           | (seq <Expr> <Expr>)
+;;;           | (closure <codeloc> <var>*)  ; thunk special case
+;;;           | (primcall op <Expr>*)
+;;;           | (forcall "name" <Expr>*)
+;;;           | (funcall <Expr> <Expr>*)
+;;;           | (jmpcall <label> <Expr> <Expr>*)
+;;;           | (appcall <Expr> <Expr>*)
+;;;           | (mvcall <Expr> <clambda>)
+;;;  <codeloc> ::= (code-loc <label>)
+;;;  <clambda> ::= (clambda <label> <case>* <free var>*) 
+;;;  <case>    ::= (clambda-case <info> <body>)
+;;;  <info>    ::= (clambda-info label <arg var>* proper)
+;;;  <Program> ::= (codes <clambda>* <Expr>)
+
+
+(define (verify-new-cogen-input x)
+  ;;;
+  (define who 'verify-new-cogen-input)
+  ;;;
+  (define (check-gensym x)
+    (unless (gensym? x)
+      (error who "invalid gensym ~s" x)))
+  ;;;
+  (define (check-label x)
+    (record-case x
+      [(code-loc label)
+       (check-gensym label)]
+      [else (error who "invalid label ~s" x)]))
+  ;;;
+  (define (check-var x)
+    (record-case x 
+      [(var) (void)]
+      [else (error who "invalid var ~s" x)]))
+  ;;;
+  (define (check-closure x)
+    (record-case x
+      [(closure label free*)
+       (check-label label)
+       (for-each check-var free*)]
+      [else (error who "invalid closure ~s" x)]))
+  ;;;
+  (define (Expr x)
+    (record-case x
+      [(constant) (void)]
+      [(var)      (void)]
+      [(primref)  (void)]
+      [(bind lhs* rhs* body)
+       (for-each check-var lhs*)
+       (for-each Expr rhs*)
+       (Expr body)]
+      [(fix lhs* rhs* body)
+       (for-each check-var lhs*)
+       (for-each check-closure rhs*)
+       (Expr body)]
+      [(conditional e0 e1 e2) 
+       (Expr e0) (Expr e1) (Expr e2)]
+      [(seq e0 e1)
+       (Expr e0) (Expr e1)]
+      [(closure) (check-closure x)]
+      [(primcall op arg*)
+       (for-each Expr arg*)]
+      [(forcall op arg*)
+       (for-each Expr arg*)]
+      [(funcall rator arg*)
+       (Expr rator)
+       (for-each Expr arg*)]
+      [(jmpcall label rator arg*)
+       (check-gensym label)
+       (Expr rator)
+       (for-each Expr arg*)]
+      [(appcall rator arg*)
+       (Expr rator)
+       (for-each Expr arg*)]
+      [(mvcall rator k)
+       (Expr rator)
+       (Clambda k)]
+      [else (error who "invalid expr ~s" x)]))
+  ;;;
+  (define (check-info x)
+    (record-case x
+      [(case-info label args proper)
+       (check-gensym label)
+       (for-each check-var args)]
+      [else (error who "invalid case-info ~s" x)]))
+  ;;;
+  (define (ClambdaCase x)
+    (record-case x
+      [(clambda-case info body)
+       (check-info info)
+       (Expr body)]
+      [else (error who "invalid clambda-case ~s" x)]))
+  ;;;
+  (define (Clambda x)
+    (record-case x
+      [(clambda label case* free*)
+       (for-each check-var free*)
+       (for-each ClambdaCase case*)
+       (check-gensym label)]
+      [else (error who "invalid clambda ~s" x)]))
+  ;;;
+  (define (Program x)
+    (record-case x 
+      [(codes code* body)
+       (for-each Clambda code*)
+       (Expr body)]
+      [else (error who "invalid program ~s" x)]))
+  ;;;
+  (Program x))
+
+
+
+
+;;; the program so far includes both primcalls and funcalls to
+;;; primrefs.  This pass removes all primcalls.  Once everything
+;;; works, we need to fix all previous passes to eliminate this 
+;;; whole primcall business.
+
+(define (remove-primcalls x)
+  ;;;
+  (define who 'remove-primcalls)
+  ;;;
+  (define (check-gensym x)
+    (unless (gensym? x)
+      (error who "invalid gensym ~s" x)))
+  ;;;
+  (define (check-label x)
+    (record-case x
+      [(code-loc label)
+       (check-gensym label)]
+      [else (error who "invalid label ~s" x)]))
+  ;;;
+  (define (check-var x)
+    (record-case x 
+      [(var) (void)]
+      [else (error who "invalid var ~s" x)]))
+  ;;;
+  (define (check-closure x)
+    (record-case x
+      [(closure label free*)
+       (check-label label)
+       (for-each check-var free*)]
+      [else (error who "invalid closure ~s" x)]))
+  ;;;
+  (define (Expr x)
+    (record-case x
+      [(constant) x]
+      [(var)      x]
+      [(primref)  x]
+      [(bind lhs* rhs* body)
+       (make-bind lhs* (map Expr rhs*) (Expr body))]
+      [(fix lhs* rhs* body)
+       (make-fix lhs* rhs* (Expr body))]
+      [(conditional e0 e1 e2) 
+       (make-conditional (Expr e0) (Expr e1) (Expr e2))]
+      [(seq e0 e1)
+       (make-seq (Expr e0) (Expr e1))]
+      [(closure) x]
+      [(primcall op arg*)
+       (make-appcall (make-primref op) (map Expr arg*))]
+      [(forcall op arg*)
+       (make-forcall op (map Expr arg*))]
+      [(funcall rator arg*)
+       (make-funcall (Expr rator) (map Expr arg*))]
+      [(jmpcall label rator arg*)
+       (make-jmpcall label (Expr rator) (map Expr arg*))]
+      [(appcall rator arg*)
+       (error 'new-cogen "appcall not supported yet")
+       (make-appcall (Expr rator) (map Expr arg*))]
+      [(mvcall rator k)
+       (make-mvcall (Expr rator) (Clambda k))]
+      [else (error who "invalid expr ~s" x)]))
+  ;;;
+  (define (ClambdaCase x)
+    (record-case x
+      [(clambda-case info body)
+       (make-clambda-case info (Expr body))]
+      [else (error who "invalid clambda-case ~s" x)]))
+  ;;;
+  (define (Clambda x)
+    (record-case x
+      [(clambda label case* free*)
+       (make-clambda label (map ClambdaCase case*) free*)]
+      [else (error who "invalid clambda ~s" x)]))
+  ;;;
+  (define (Program x)
+    (record-case x 
+      [(codes code* body)
+       (make-codes (map Clambda code*) (Expr body))]
+      [else (error who "invalid program ~s" x)]))
+  ;;;
+  (Program x))
+
+
+
+(define (eliminate-fix x)
+  ;;;
+  (define who 'eliminate-fix)
+  ;;;
+  (define (Expr cpvar free*)
+    ;;;
+    (define (Var x)
+      (let f ([free* free*] [i 0])
+        (cond
+          [(null? free*) x]
+          [(eq? x (car free*))
+           (make-primcall 'cpref (list cpvar (make-constant i)))]
+          [else (f (cdr free*) (fxadd1 i))])))
+    ;;;
+    (define (make-closure x)
+      (record-case x
+        [(closure code free*)
+         (cond
+           [(null? free*) x]
+           [else 
+            (make-primcall 'make-closure 
+              (list code (make-constant (length free*))))])]))
+    ;;;
+    (define (closure-sets var x ac)
+      (record-case x 
+        [(closure code free*)
+         (let f ([i 0] [free* free*])
+           (cond
+             [(null? free*) ac]
+             [else
+              (make-seq 
+                (make-primcall 'closure-set! 
+                  (list var (make-constant i) 
+                        (Var (car free*))))
+                (f (fxadd1 i) (cdr free*)))]))]))
+    ;;;
+    (define (do-fix lhs* rhs* body)
+      (make-bind 
+         lhs* (map make-closure rhs*)
+        (let f ([lhs* lhs*] [rhs* rhs*])
+          (cond
+            [(null? lhs*) body]
+            [else
+             (closure-sets (car lhs*) (car rhs*)
+               (f (cdr lhs*) (cdr rhs*)))]))))
+    ;;;
+    (define (Expr x)
+      (record-case x
+        [(constant) x]
+        [(var)      (Var x)]
+        [(primref)  x]
+        [(bind lhs* rhs* body)
+         (make-bind lhs* (map Expr rhs*) (Expr body))]
+        [(fix lhs* rhs* body)
+         (do-fix lhs* rhs* (Expr body))]
+        [(conditional e0 e1 e2) 
+         (make-conditional (Expr e0) (Expr e1) (Expr e2))]
+        [(seq e0 e1)
+         (make-seq (Expr e0) (Expr e1))]
+        [(closure) 
+         (let ([t (unique-var 'tmp)])
+           (Expr (make-fix (list t) (list x) t)))]
+        [(primcall op arg*)
+         (make-appcall (make-primref op) (map Expr arg*))]
+        [(forcall op arg*)
+         (make-forcall op (map Expr arg*))]
+        [(funcall rator arg*)
+         (make-funcall (Expr rator) (map Expr arg*))]
+        [(jmpcall label rator arg*)
+         (make-jmpcall label (Expr rator) (map Expr arg*))]
+        [(appcall rator arg*)
+         (error who "appcall not supported yet")
+         (make-appcall (Expr rator) (map Expr arg*))]
+        [(mvcall rator k)
+         (make-mvcall (Expr rator) (Clambda k))]
+        [else (error who "invalid expr ~s" x)]))
+    Expr)
+  ;;;
+  (define (ClambdaCase free*)
+    (lambda (x)
+      (record-case x
+        [(clambda-case info body)
+         (record-case info
+           [(case-info label args proper)
+            (let ([cp (unique-var 'cp)])
+              (make-clambda-case 
+                (make-case-info label (cons cp args) proper)
+                ((Expr cp free*) body)))])]
+        [else (error who "invalid clambda-case ~s" x)])))
+  ;;;
+  (define (Clambda x)
+    (record-case x
+      [(clambda label case* free*)
+       (make-clambda label (map (ClambdaCase free*) case*) 
+                     free*)]
+      [else (error who "invalid clambda ~s" x)]))
+  ;;;
+  (define (Program x)
+    (record-case x 
+      [(codes code* body)
+       (make-codes (map Clambda code*) ((Expr #f '()) body))]
+      [else (error who "invalid program ~s" x)]))
+  ;;;
+  (Program x))
+
+
+
+(define (specify-representation x)
+  (define who 'specify-representation)
+  ;;;
+  (define fixnum-scale 4)
+  ;;;
+  (define nop (make-primcall 'nop '()))
+  ;;;
+  (define (constant-rep x)
+    (let ([c (constant-value x)])
+      (cond
+        [(fixnum? c) (make-constant (* c fixnum-scale))]
+        [(boolean? c) (make-constant (if c bool-t bool-f))]
+        [(eq? c (void)) (make-constant void-object)]
+        [(bwp-object? c) (make-constant bwp-object)]
+        [(char? c) (make-constant 
+                     (fxlogor char-tag
+                       (fxsll (char->integer c) char-shift)))]
+        [(null? c) (make-constant nil)]
+        [else (make-constant (make-object c))])))
+  ;;;
+  (define (Effect x)
+    (record-case x
+      [(constant c) nop]
+      [(var)        nop]
+      [(primref)    nop]
+      [(closure code free*) nop]
+      [(bind lhs* rhs* body)
+       (make-bind lhs* (map Value rhs*) (Effect body))]
+      [(conditional e0 e1 e2) 
+       (make-conditional (Pred e0) (Effect e1) (Effect e2))]
+      [(seq e0 e1)
+       (make-seq (Effect e0) (Effect e1))]
+      [(primcall op arg*)
+       (case op
+         [(closure-set!)
+          (let ([x (Value (car arg*))] 
+                [i (cadr arg*)]
+                [v (Value (caddr arg*))])
+            (record-case i
+              [(constant i) 
+               (unless (fixnum? i) (err x))
+               (make-primcall 'mset!
+                 (list x
+                       (make-constant 
+                         (+ (* i wordsize) 
+                          (- disp-closure-data closure-tag)))
+                       v))]
+              [else (err x)]))]
+         [else (error who "invalid effect prim ~s" op)])]
+      [(forcall op arg*)
+       (error who "effect forcall not supported" op)]
+      [(funcall rator arg*)
+       (make-funcall (Value rator) (map Value arg*))]
+      [(jmpcall label rator arg*)
+       (make-jmpcall label (Value rator) (map Value arg*))]
+      [(appcall rator arg*)
+       (error who "appcall not supported yet")]
+      [(mvcall rator x)
+       (make-mvcall (Value rator) (Clambda x Effect))]
+      [else (error who "invalid pred expr ~s" x)]))
+  ;;;
+  (define (Pred x)
+    (record-case x
+      [(constant c) (make-constant (if c #t #f))]
+      [(var) (make-primcall '!= (list x (make-constant bool-f)))]
+      [(primref)  (make-constant #t)]
+      [(closure code free*) (make-constant #t)]
+      [(bind lhs* rhs* body)
+       (make-bind lhs* (map Value rhs*) (Pred body))]
+      [(conditional e0 e1 e2) 
+       (make-conditional (Pred e0) (Pred e1) (Pred e2))]
+      [(seq e0 e1)
+       (make-seq (Effect e0) (Pred e1))]
+      [(primcall op arg*)
+       (error who "pred prim ~a not supported" op)]
+      [(forcall op arg*)
+       (error who "pred forcall not supported" op)]
+      [(funcall rator arg*)
+       (make-primcall '!= 
+          (list (make-funcall (Value rator) (map Value arg*))
+                (make-constant bool-f)))]
+      [(jmpcall label rator arg*)
+       (make-primcall '!= 
+          (list (make-jmpcall label (Value rator) (map Value arg*))
+                (make-constant bool-f)))]
+      [(appcall rator arg*)
+       (error who "appcall not supported yet")]
+      [(mvcall rator x)
+       (make-mvcall (Value rator) (Clambda x Pred))]
+      [else (error who "invalid pred expr ~s" x)])) 
+  ;;;
+  (define (err x)
+    (error who "invalid form ~s" (unparse x)))
+  ;;;
+  (define (Value x)
+    (record-case x
+      [(constant) (constant-rep x)]
+      [(var)      x]
+      [(primref)  (make-constant x)]
+      [(code-loc) (make-constant x)]
+      [(closure)  (make-constant x)]
+      [(bind lhs* rhs* body)
+       (make-bind lhs* (map Value rhs*) (Value body))]
+      [(conditional e0 e1 e2) 
+       (make-conditional (Pred e0) (Value e1) (Value e2))]
+      [(seq e0 e1)
+       (make-seq (Effect e0) (Value e1))]
+      [(primcall op arg*)
+       (case op
+         [(make-closure)
+          (let ([label (car arg*)] [len (cadr arg*)])
+            (record-case len
+              [(constant i)
+               (unless (fixnum? i) (err x))
+               (let ([t (unique-var 't)])
+                 (make-bind (list t)
+                            (list (make-primcall 'alloc
+                                    (list (make-constant
+                                            (align 
+                                              (+ disp-closure-data
+                                                 (* i wordsize))))
+                                          (make-constant closure-tag))))
+                    (make-seq 
+                      (make-primcall 'mset! 
+                        (list t 
+                              (make-constant (- disp-closure-code closure-tag))
+                              (Value label)))
+                      t)))]
+              [else (err x)]))]
+         [(cpref) 
+          (let ([a0 (car arg*)] [a1 (cadr arg*)])
+            (record-case a1
+              [(constant i) 
+               (unless (fixnum? i) (err x))
+               (make-primcall 'mem 
+                  (list (Value a0) 
+                        (make-constant 
+                          (+ (- disp-closure-data closure-tag)
+                             (* i wordsize) ))))]
+              [else (err x)]))]
+         [else (error who "value prim ~a not supported" (unparse x))])]
+      [(forcall op arg*)
+       (error who "value forcall not supported" op)]
+      [(funcall rator arg*)
+       (make-funcall (Value rator) (map Value arg*))]
+      [(jmpcall label rator arg*)
+       (make-jmpcall label (Value rator) (map Value arg*))]
+      [(appcall rator arg*)
+       (error who "appcall not supported yet")]
+      [(mvcall rator x)
+       (make-mvcall (Value rator) (Clambda x Value))]
+      [else (error who "invalid value expr ~s" x)]))
+  ;;;
+  (define (ClambdaCase x k)
+    (record-case x
+      [(clambda-case info body)
+       (make-clambda-case info (k body))]
+      [else (error who "invalid clambda-case ~s" x)]))
+  ;;;
+  (define (Clambda x k)
+    (record-case x
+      [(clambda label case* free*)
+       (make-clambda label 
+          (map (lambda (x) (ClambdaCase x k)) case*)
+          free*)]
+      [else (error who "invalid clambda ~s" x)]))
+  ;;;
+  (define (Program x)
+    (record-case x 
+      [(codes code* body)
+       (make-codes 
+         (map (lambda (x) (Clambda x Value)) code*) 
+         (Value body))]
+      [else (error who "invalid program ~s" x)]))
+  ;;;
+  (Program x))
+
+
+(define parameter-registers '(%edi)) 
+(define return-value-register '%eax)
+(define cp-register '%edi)
+(define all-registers '(%eax %edi %ebx %edx))
+
+(define (impose-calling-convention/evaluation-order x)
+  (define who 'impose-calling-convention/evaluation-order)
+  ;;;
+  (define (E x)
+    (record-case x
+      [(primcall op rands)
+       (S* rands
+           (lambda (rands)
+             (make-primcall op rands)))]
+      [else (error who "invalid effect ~s" x)]))
+  ;;;
+  (define (S* x* k)
+    (cond
+      [(null? x*) (k '())]
+      [else
+       (S (car x*)
+          (lambda (a)
+            (S* (cdr x*)
+                (lambda (d)
+                  (k (cons a d))))))]))
+  ;;;
+  (define (S x k)
+    (record-case x 
+      [(constant) (k x)]
+      [(var)      (k x)]
+      [else (error who "invalid S ~s" x)]))
+  ;;;
+  (define (do-bind lhs* rhs* body)
+    (cond
+      [(null? lhs*) body]
+      [else
+       (set! locals (cons (car lhs*) locals))
+       (make-seq 
+         (V (car lhs*) (car rhs*))
+         (do-bind (cdr lhs*) (cdr rhs*) body))]))
+  ;;;
+  (define (V d x)
+    (record-case x 
+      [(constant) (make-set d x)]
+      [(var)      (make-set d x)]
+      [(bind lhs* rhs* e)
+       (do-bind lhs* rhs* (V d e))]
+      [(seq e0 e1)
+       (make-seq (E e0) (V d e1))]
+      [(primcall op rands)
+       (S* rands
+          (lambda (rands)
+            (make-set d (make-primcall op rands))))]
+      [else (error who "invalid value ~s" x)]))
+  ;;;
+  (define (VT x)
+    (make-seq 
+       (V return-value-register x)
+       (make-primcall 'return '())))
+  ;;;
+  (define (Tail x)
+    (record-case x 
+      [(constant) (VT x)]
+      [(var)      (VT x)]
+      [(primcall) (VT x)]
+      [(bind lhs* rhs* e)
+       (do-bind lhs* rhs* (Tail e))]
+      [(seq e0 e1)
+       (make-seq (E e0) (Tail e1))]
+      [else (error who "invalid tail ~s" x)]))
+  ;;;
+  (define (formals-locations args)
+    (let f ([regs parameter-registers] [args args])
+      (cond
+        [(null? args) '()]
+        [(null? regs) 
+         (let f ([i 0] [args args])
+           (cond
+             [(null? args) '()]
+             [else
+              (cons (make-fvar i)
+                (f (fxadd1 i) (cdr args)))]))]
+        [else
+         (cons (car regs) (f (cdr regs) (cdr args)))])))
+  ;;;
+  (define locals '())
+  ;;;
+  (define (ClambdaCase x) 
+    (record-case x
+      [(clambda-case info body)
+       (record-case info
+         [(case-info label args proper)
+          (set! locals args)
+          (let* ([locs (formals-locations args)]
+                 [body (let f ([args args] [locs locs])
+                          (cond
+                            [(null? args) (Tail body)]
+                            [else
+                             (make-seq
+                               (make-set (car args) (car locs))
+                               (f (cdr args) (cdr locs)))]))])
+            (make-clambda-case
+              (make-case-info label locs proper)
+              (make-locals locals body)))])]))
+  ;;;
+  (define (Clambda x)
+    (record-case x
+      [(clambda label case* free*)
+       (make-clambda label (map ClambdaCase case*) free*)]))
+  ;;;
+  (define (Main x)
+    (set! locals '())
+    (let ([x (Tail x)])
+      (make-locals locals x)))
+  ;;;
+  (define (Program x)
+    (record-case x 
+      [(codes code* body)
+       (make-codes (map Clambda code*) (Main body))]))
+  ;;;
+  (Program x))
+
+
+(module ListyGraphs 
+  (empty-graph add-edge! empty-graph? print-graph node-neighbors
+   delete-node!)
+  ;;;
+  (define-record graph (ls))
+  ;;;
+  (define (empty-graph) (make-graph '()))
+  ;;;
+  (define (empty-graph? g) 
+    (andmap (lambda (x) (null? (cdr x))) (graph-ls g)))
+  ;;;
+  (define (add-edge! g x y)
+    (let ([ls (graph-ls g)])
+      (cond
+        [(assq x ls) =>
+         (lambda (p0)
+           (unless (memq y (cdr p0))
+             (let ([p1 (assq y ls)])
+               (set-cdr! p1 (cons x (cdr p1)))
+               (set-cdr! p0 (cons y (cdr p0))))))]
+        [else 
+         (set-graph-ls! g 
+           (list* (list x y)
+                  (list y x)
+                  ls))])))
+  (define (print-graph g)
+    (printf "G={\n")
+    (parameterize ([print-gensym 'pretty])
+      (for-each (lambda (x) 
+                  (let ([lhs (car x)] [rhs* (cdr x)])
+                    (printf "  ~s => ~s\n" 
+                            (unparse lhs)
+                            (map unparse rhs*))))
+        (graph-ls g)))
+    (printf "}\n"))
+  (define (node-neighbors x g)
+    (cond
+      [(assq x (graph-ls g)) => cdr]
+      [else '()]))
+  (define (delete-node! x g)
+    (let ([ls (graph-ls g)])
+      (cond
+        [(assq x ls) =>
+         (lambda (p)
+           (for-each (lambda (y) 
+                       (let ([p (assq y ls)])
+                         (set-cdr! p (set-rem x (cdr p)))))
+                     (cdr p))
+           (set-cdr! p '()))]
+        [else (void)])))
+  ;;;
+  #|ListyGraphs|#)
+
+(define (set-add x s)
+  (cond
+    [(memq x s) s]
+    [else (cons x s)]))
+           
+(define (set-rem x s)
+  (cond
+    [(null? s) '()]
+    [(eq? x (car s)) (cdr s)]
+    [else (cons (car s) (set-rem x (cdr s)))]))
+
+(define (set-difference s1 s2)
+  (cond
+    [(null? s2) s1]
+    [else (set-difference (set-rem (car s2) s1) (cdr s2))]))
+
+(module (color-by-chaitin)
+  (import ListyGraphs)
+  ;;;
+  (define (build-graph x)
+    (define who 'build-graph)
+    (define g (empty-graph))
+    (define (reg? x)
+      (or (symbol? x)
+          (var? x)))
+    (define (add-rands ls s)
+      (cond
+        [(null? ls) s]
+        [(reg? (car ls)) 
+         (add-rands (cdr ls) (set-add (car ls) s))]
+        [else (add-rands (cdr ls) s)]))
+    (define (Rhs x s)
+      (record-case x
+        [(fvar) s]
+        [(primcall op rand*) (add-rands rand* s)]
+        [(constant) s]
+        [else (error who "invalid rhs ~s" x)]))
+    (define (E x s)
+      (record-case x
+        [(set lhs rhs) 
+         (if (reg? lhs)
+             (if (reg? rhs)
+                 (let ([s (set-rem rhs (set-rem lhs s))])
+                   (for-each (lambda (x) (add-edge! g lhs x)) s)
+                   (cons rhs s))
+                 (let ([s (set-rem lhs s)])
+                   (for-each (lambda (x) (add-edge! g lhs x)) s)
+                   (Rhs rhs s)))
+             (Rhs rhs s))]
+        [(seq e0 e1) (E e0 (E e1 s))]
+        [(primcall op rands) (add-rands rands s)]
+        [else (error who "invalid effect ~s" x)]))
+    (define (T x)
+      (record-case x
+        [(primcall op rands)
+         (case op
+           [(return) (list return-value-register)]
+           [else (error who "invalid tail op ~s" x)])]
+        [(seq e0 e1) (E e0 (T e1))]
+        [else (error who "invalid tail ~s" x)]))
+    (let ([s (T x)])
+      ;(print-graph g)
+      g))
+  ;;;
+  (define (color-graph sp* un* g)
+    (define (find-low-degree ls g)
+      (cond
+        [(null? ls) #f]
+        [(fx< (length (node-neighbors (car ls) g))
+              (length all-registers))
+         (car ls)]
+        [else (find-low-degree (cdr ls) g)]))
+    (define (find-color/maybe x confs env)
+      (let ([cr (map (lambda (x)
+                       (cond
+                         [(assq x env) => cdr]
+                         [else #f]))
+                     confs)])
+        (let ([r* (set-difference all-registers cr)])
+          (if (null? r*) 
+              #f
+              (car r*)))))
+    (define (find-color x confs env)
+      (or (find-color/maybe x confs env)
+          (error 'find-color "cannot find color for ~s" x)))
+    (cond
+      [(and (null? sp*) (null? un*)) (values '() '() '())]
+      [(find-low-degree un* g) =>
+       (lambda (un)
+         (let ([n* (node-neighbors un g)])
+           (delete-node! un g)
+           (let-values ([(spills sp* env) 
+                         (color-graph sp* (set-rem un un*) g)])
+             (let ([r (find-color un n* env)])
+               (values spills sp*
+                  (cons (cons un r) env))))))]
+      [(find-low-degree sp* g) =>
+       (lambda (sp)
+         (let ([n* (node-neighbors sp g)])
+           (delete-node! sp g)
+           (let-values ([(spills sp* env) 
+                         (color-graph (set-rem sp sp*) un* g)])
+             (let ([r (find-color sp n* env)])
+               (values spills (cons sp sp*)
+                  (cons (cons sp r) env))))))]
+      [else (error color-graph "whoaaa")]))
+  ;;;
+  (define (substitute env x)
+    (define who 'substitute)
+    (define (Var x)
+      (cond
+        [(assq x env) => cdr]
+        [else (error who "~s is unassigned" x)]))
+    (define (Rhs x)
+      (record-case x
+        [(var) (Var x)]
+        [(fvar i) (Fvar i)] 
+        [(primcall op rand*)
+         (make-primcall op (map Rand rand*))]
+        [else x]))
+    (define (Fvar i) 
+      (define (idx->stack-loc i)
+        (fx* (fx- 0 wordsize) (fxadd1 i)))
+      (make-primcall 'mem 
+        (list fpr (make-constant (idx->stack-loc i)))))
+    (define (Rand x) 
+      (record-case x
+        [(var) (Var x)]
+        [(fvar i) (Fvar i)]
+        [else x]))
+    (define (Lhs x)
+      (record-case x
+        [(var) (Var x)]
+        [else x]))
+    (define (E x)
+      (record-case x
+        [(set lhs rhs) 
+         (let ([lhs (Lhs lhs)] [rhs (Rhs rhs)])
+           (cond
+             [(eq? lhs rhs) (make-primcall 'nop '())]
+             [else (make-set lhs rhs)]))]
+        [(seq e0 e1) (make-seq (E e0) (E e1))]
+        [(primcall op rands) 
+         (case op
+           [(mset!)
+            (make-set
+               (make-primcall 'mem 
+                 (list (Rand (car rands))
+                       (Rand (cadr rands))))
+               (Rand (caddr rands)))]
+           [else (error who "invalid effect prim ~s" op)])]
+        [else (error who "invalid effect ~s" x)]))
+    (define (T x)
+      (record-case x
+        [(primcall op rands)
+         (case op
+           [(return) x]
+           [else (error who "invalid tail op ~s" x)])]
+        [(seq e0 e1) (make-seq (E e0) (T e1))]
+        [else (error who "invalid tail ~s" x)]))
+    (T x))
+  ;;;
+  (define (do-spill sp* x un*)
+    (error 'do-spill "not yet"))
+  ;;;
+  (define (color-program x)
+    (define who 'color-program)
+    (record-case x 
+      [(locals sp* body)
+       (let loop ([sp* sp*] [un* '()] [body body])
+         (let ([g (build-graph body)])
+           (let-values ([(spills sp* env) (color-graph sp* un* g)])
+             (cond
+               [(null? spills) (substitute env body)]
+               [else 
+                (let-values ([(un* body) (do-spill spills body un*)])
+                   (loop sp* un* body))]))))]))
+  ;;;
+  (define (color-by-chaitin x)
+    ;;;
+    (define (ClambdaCase x) 
+      (record-case x
+        [(clambda-case info body)
+         (make-clambda-case info (color-program body))]))
+    ;;;
+    (define (Clambda x)
+      (record-case x
+        [(clambda label case* free*)
+         (make-clambda label (map ClambdaCase case*) free*)]))
+    ;;;
+    (define (Program x)
+      (record-case x 
+        [(codes code* body)
+         (make-codes (map Clambda code*) (color-program body))]))
+    ;;;
+    (Program x))
+  #|chaitin module|#)
+
+
+
+(define (flatten-codes x)
+  (define who 'flatten-codes)
+  ;;;
+  (define (Rand x)
+    (record-case x
+      [(constant c)
+       (record-case c
+         [(code-loc label) (label-address label)]
+         [(closure label free*)
+          (unless (null? free*) 
+            (error who "nonempty closure"))
+          `(obj ,c)]
+         [else 
+          (if (integer? c)
+              c
+              (error who "invalid constant rand ~s" c))])]
+      [(primcall op rands)
+       (case op
+         [(mem) `(disp . ,(map Rand rands))]
+         [else (error who "invalid rand ~s" x)])]
+      [else 
+       (if (symbol? x) 
+           x
+           (error who "invalid rand ~s" x))]))
+  ;;;
+  (define (Rhs x d ac)
+    (record-case x
+      [(constant c)
+       (cons `(movl ,(Rand x) ,d) ac)]
+      [(primcall op rands)
+       (case op
+         [(mem)
+          (cons `(movl (disp ,(Rand (car rands)) 
+                             ,(Rand (cadr rands))) 
+                       ,d)
+                ac)]
+         [(alloc) 
+          (let ([sz (Rand (car rands))]
+                [tag (Rand (cadr rands))])
+            (list* `(movl ,apr ,d)
+                   `(addl ,tag ,d)
+                   `(addl ,sz ,apr)
+                   ac))]
+         [else (error who "invalid rhs ~s" x)])]
+      [else 
+       (if (symbol? x)
+           (cons `(movl ,x ,d) ac)
+           (error who "invalid rhs ~s" x))]))
+  ;;;
+  (define (E x ac)
+    (record-case x
+      [(seq e0 e1) (E e0 (E e1 ac))]
+      [(set lhs rhs) 
+       (Rhs rhs (Rand lhs) ac)]
+      [(primcall op rands)
+       (case op
+         [(nop) ac]
+         [else (error who "invalid effect ~s" x)])]
+      [else (error who "invalid effect ~s" x)]))
+  ;;;
+  (define (T x ac)
+    (record-case x
+      [(seq e0 e1) (E e0 (T e1 ac))]
+      [(primcall op rands)
+       (case op
+        [(return) (cons '(ret) ac)]
+        [else (error who "invalid tail ~s" x)])]
+      [else (error who "invalid tail ~s" x)]))
+  ;;;
+  (define (ClambdaCase x) 
+    (record-case x
+      [(clambda-case info body)
+       (record-case info
+         [(case-info L args proper)
+          (unless proper (error who "improper lambda"))
+          (cons (label L) 
+                (T body '()))])]))
+  ;;;
+  (define (Clambda x)
+    (record-case x
+      [(clambda L case* free*)
+       (unless (fx= (length case*) 1)
+         (error who "not a lambda"))
+       (list* (length free*) 
+              (label L)
+              (ClambdaCase (car case*)))]))
+  ;;;
+  (define (Program x)
+    (record-case x 
+      [(codes code* body)
+       (cons (list* 0 
+                    (label (gensym))
+                    (T body '()))
+             (map Clambda code*))]))
+  ;;;
+  (Program x))
+
+(define (print-code x)
+  (parameterize ([print-gensym 'pretty])
+    (pretty-print (unparse x))))
+
+(define (alt-cogen x)
+  (verify-new-cogen-input x)
+  (let* ([x (remove-primcalls x)]
+         [x (eliminate-fix x)]
+         [x (specify-representation x)]
+         [x (impose-calling-convention/evaluation-order x)]
+         ;[foo (print-code x)]
+         [x (color-by-chaitin x)]
+         [foo (print-code x)]
+         [ls (flatten-codes x)])
+    ls))
+  
+#|module alt-cogen|#)
+
+
diff --git a/src/libcompile.ss b/src/libcompile.ss
index 6637b14..471fbf7 100644
--- a/src/libcompile.ss
+++ b/src/libcompile.ss
@@ -252,6 +252,13 @@
 (define-record assign (lhs rhs))
 (define-record mvcall (producer consumer))
 
+
+
+(define-record fvar (idx))
+(define-record set (lhs rhs))
+(define-record object (val))
+(define-record locals (vars body))
+
 (define (unique-var x)
   (make-var (gensym x) #f #f))
 
@@ -398,13 +405,19 @@
       [(fix lhs* rhs* body) 
        `(fix ,(map (lambda (lhs rhs) (list (E lhs) (E rhs))) lhs* rhs*)
           ,(E body))]
-      [(seq e0 e1) `(begin ,(E e0) ,(E e1))]
+      [(seq e0 e1) 
+       (let ()
+         (define (f x ac)
+           (record-case x
+             [(seq e0 e1) (f e0 (f e1 ac))]
+             [else (cons (E x) ac)]))
+         (cons 'begin (f e0 (f e1 '()))))]
       [(clambda-case info body)
-       `(clambda-case ,(E-args (case-info-proper info)
+       `(,(E-args (case-info-proper info)
                                (case-info-args info))
             ,(E body))]
       [(clambda g cls* free)
-       `(case-lambda . ,(map E cls*))]
+       `(,g (case-lambda . ,(map E cls*)))]
       [(clambda label clauses free)
        `(code ,label . ,(map E clauses))]
       [(closure code free*)
@@ -444,7 +457,10 @@
        `(tailcall-cp ,convention ,label ,arg-count)]
       [(foreign-label x) `(foreign-label ,x)]
       [(mvcall prod cons) `(mvcall ,(E prod) ,(E cons))]
-      [else (error 'unparse "invalid record ~s" x)]))
+      [(set lhs rhs) `(set ,(E lhs) ,(E rhs))]
+      [(fvar idx) (string->symbol (format "fv.~a" idx))]
+      [(locals vars body) `(locals ,(map E vars) ,(E body))]
+      [else x]))
   (E x))
 
 
@@ -5141,6 +5157,42 @@
                ls*)])
         (car code*)))))
 
+
+(include "libaltcogen.ss")
+
+
+(define (alt-compile-expr expr)
+  (let* ([p (parameterize ([assembler-output #f])
+              (expand expr))]
+         [p (recordize p)]
+         [p (optimize-direct-calls p)]
+         [p (optimize-letrec p)]
+         [p (uncover-assigned/referenced p)]
+         [p (copy-propagate p)]
+         [p (rewrite-assignments p)]
+         [p (optimize-for-direct-jumps p)]
+         [p (convert-closures p)]
+         [p (optimize-closures/lift-codes p)])
+    (let ([ls* (alt-cogen p)])
+      (when (assembler-output)
+        (parameterize ([gensym-prefix "L"]
+                       [print-gensym #f])
+          (for-each 
+            (lambda (ls)
+              (newline)
+              (for-each (lambda (x) (printf "    ~s\n" x)) ls))
+            ls*)))
+      (let ([code* 
+             (list*->code* 
+               (lambda (x)
+                 (if (closure? x)
+                     (if (null? (closure-free* x))
+                         (code-loc-label (closure-code x))
+                         (error 'compile "BUG: non-thunk escaped: ~s" x))
+                     #f))
+               ls*)])
+        (car code*)))))
+
 (define compile-file
   (lambda (input-file output-file . rest)
     (let ([ip (open-input-file input-file)]
@@ -5165,6 +5217,17 @@
       (let ([proc ($code->closure code)])
         (proc)))))
 
+(primitive-set! 'alt-compile
+  (lambda (x)
+    (let ([code 
+           (if (code? x)
+               x
+               (parameterize ([expand-mode 'eval])
+                 (alt-compile-expr x)))])
+      (let ([proc ($code->closure code)])
+        (proc)))))
+
+
 (primitive-set! 'current-eval
   (make-parameter 
     compile
diff --git a/src/libintelasm.ss b/src/libintelasm.ss
index 2de3406..83f889d 100644
--- a/src/libintelasm.ss
+++ b/src/libintelasm.ss
@@ -341,6 +341,8 @@
            (CODE c (RegReg r1 a1 a2 ac))]
           [(and (imm? a1) (reg? a2))
            (CODErri c r1 a2 a1 ac)]
+          [(and (imm? a2) (reg? a1))
+           (CODErri c r1 a1 a2 ac)]
           [(and (imm? a1) (imm? a2))
            (CODE c 
              (ModRM 0 r1 '/5 
@@ -362,6 +364,8 @@
            (error 'CODEdi "unsupported1")]
           [(and (imm? a1) (reg? a2))
            (CODErri c '/0 a2 a1 (IMM32 n ac))]
+          [(and (imm? a2) (reg? a1))
+           (CODErri c '/0 a1 a2 (IMM32 n ac))]
           [(and (imm? a1) (imm? a2))
            (error 'CODEdi "unsupported2")]
           [else (error 'CODEdi "unhandled ~s" disp)])))))
diff --git a/src/makefile.ss b/src/makefile.ss
index d728291..a00f189 100755
--- a/src/makefile.ss
+++ b/src/makefile.ss
@@ -55,7 +55,7 @@
     gensym->unique-string call-with-values values make-parameter
     dynamic-wind display write print-graph fasl-write printf fprintf format
     print-error read-token read comment-handler error warning exit call/cc
-    error-handler eval current-eval compile compile-file
+    error-handler eval current-eval compile alt-compile compile-file
     new-cafe load system expand sc-expand current-expand expand-mode
     environment? interaction-environment identifier?
     free-identifier=? bound-identifier=? literal-identifier=?
