diff --git a/alpha.cabal b/alpha.cabal
--- a/alpha.cabal
+++ b/alpha.cabal
@@ -1,5 +1,5 @@
 name:           alpha
-version:        0.99
+version:        0.995
 synopsis:       A compiler for the Alpha language
 description:    Alpha is a programming language that aims at being very simple and 
                 low-level, so as to be efficient, while at the same time
diff --git a/src/Alpha.hs b/src/Alpha.hs
--- a/src/Alpha.hs
+++ b/src/Alpha.hs
@@ -36,7 +36,7 @@
   PrintVersion -> printVersion
   Compile -> doCompile s
 
-version = "0.99"
+version = "0.995"
 printHelp = putStrLn helpMsg
 printVersion = putStrLn $ "Alpha version "++version
 
diff --git a/src/Compile.hs b/src/Compile.hs
--- a/src/Compile.hs
+++ b/src/Compile.hs
@@ -18,7 +18,7 @@
 compile dest expr = runStateT st defaultState >§ \(code,cs) -> (code,imports cs)
   where st = do
           (_,(start,_)) <- compile' dest expr
-          simplify start >>= linearize >>= lift . uniquify
+          simplify start >>= linearize --  >>= lift . uniquify
 
 compile' dest (Symbol sym) = do
   name <- getSymName sym
diff --git a/src/Compile/Utils.hs b/src/Compile/Utils.hs
--- a/src/Compile/Utils.hs
+++ b/src/Compile/Utils.hs
@@ -11,6 +11,7 @@
 
 import qualified Data.Map as M
 import qualified Data.Set as S
+import Data.Function
 import Data.Maybe
 import PCode
 import Syntax  
@@ -35,7 +36,7 @@
   return $ concatMap (newStart oldDep newDep) start
   where 
     purgeAll = do
-      mapM_ (purgeNode isNoop) =<< getNodeList         
+      mapM_ (purgeNode isNoop) =<< getNodeList
       mapM_ (purgeNode isEmptyBranch) =<< getNodeList
     purgeNode p n = do
       c <- getContext n              
@@ -55,17 +56,15 @@
         mergeEdge (BranchAlt t x) (BranchAlt t' _) = BranchAlt (least t t') x
         mergeEdge TimeDep         b                = b
         mergeEdge e               t                = mergeEdge t e
-      sequence_ [createEdge (mergeEdge t t')  n  n'' | (n  ,t) <- lies, (n'',t') <- loes ]
       sequence_ [deleteEdge                   n  n'  | (n  ,_) <- lies                   ]
       sequence_ [deleteEdge                   n' n'' | (n'',_) <- loes                   ]
+      sequence_ [createEdge (mergeEdge t t')  n  n'' | (n  ,t) <- lies, (n'',t') <- loes ]
       deleteNode n'
     newStart old new = newStart
       where 
-        newStart n = 
-          maybe (maybe [] (\c -> concat [newStart n | (n,_) <- outEdges c])
-                 (lookupContext n old)) 
-          (const [n])
-          (lookupContext n new)
+        newStart n = fromJust $ (lookupContext n new >> return [n])
+                     `mplus` (lookupContext n old >§ \c -> concat [newStart n | (n,_) <- outEdges c])
+                     `mplus` return []
 
 data ANode = ANode {
   weight :: Int,
@@ -79,16 +78,18 @@
     aG = annotate depG
     getContext n = G.getContext n aG
     withContext n = (n,getContext n)
+    (<#) = ((<) `on` (weight . tag))
     
     isBrPart (instr . tag . getContext -> BrPart _) = True
     isBrPart _ = False
-    instrMap = M.fromList [(n,i) | (i,(n,_)) <- zip [0..] $ concat [map (n,) (getInstr n) | n <- concat blocks]]
+    instrMap = M.fromList $ zip instrs (sums (map (length . getInstr) instrs))
+      where instrs = concat blocks
     instrs = concatMap (concatMap getInstr) blocks    
 
     getInstr (getContext -> c) = case tag c of
       ANode { instr = BrPart v } -> [Branch v $ map branch (classesBy (===) oes)]
         where branch ns = minimum $ catMaybes [M.lookup n instrMap | (n,_) <- ns]
-              (_,e) === (_,e') = e==e'
+              (===) = (==)`on`snd
       ANode { instr = Instr i } -> i : if null oes then [ret] else []
       where oes = outEdges c
 
@@ -97,14 +98,17 @@
     heads = startHeads : deleteBy headsEq startHeads heads
       where eq n1 n2 = if n1`elem`start then n2`elem`start else c'
               where c' = n2 `elem` [n | (n,e') <- outEdges $ getContext prev, e==e']
-                    (prev,e) = fromMaybe (error $ "Couldn't find edge of "++show n1++" in graph "++show aG) $ find isBackEdge $ inEdges $ getContext n1
+                    (prev,e) = fromMaybe (error $ "Couldn't find edge of "++show n1++" in graph "++show aG)
+                               $ find isBackEdge $ inEdges $ getContext n1
             headsEq a b = sort a==sort b
             heads = classesBy eq $ selectHeads $ nodeListFull aG
-    tails = map (nub . concatMap saturate) heads
+    tails = map (S.toList . S.unions) $ classesBy share $ map (S.fromList . concatMap saturate) heads
+      where share s s' = not $ S.null (s `S.intersection` s')
     saturate n = if null nexts then [n] else concatMap saturate nexts
       where nexts = [n' | let c = getContext n                                
                         , (n',c') <- map withContext $ nextNodes c
-                        , weight (tag c') > weight (tag c)]
+                        , c <# c']
+
     
     blocks = map blockFromTails tails
     blockFromTails tails = evalState (concat $< mapM makeBlock tails) S.empty
@@ -115,10 +119,10 @@
           prevs <- mapM makeBlock (getPrevs n)
           visit n
           return $ concat prevs ++ [n]
-        getPrevs n = map fst $ sortBy cmp $ filter p $ map withContext $ prevNodes language
-          where cmp (_,c) (_,c') = compare (erNum $ tag c') (erNum $ tag c)
-                p (_,c) = weight (tag c) < weight (tag language)
-                language = getContext n
+        getPrevs n = map fst $ sortBy cmp $ filter p $ map withContext $ prevNodes ctx
+          where cmp = compare `on` (erNum . tag . snd)
+                p (_,c) = c <# ctx
+                ctx = getContext n
 
 annotate depG = newdepG
   where 
diff --git a/src/Context.hs b/src/Context.hs
--- a/src/Context.hs
+++ b/src/Context.hs
@@ -6,12 +6,14 @@
               ,doTransform ,getAddressComp
               ,execCode) where
 
+import Bindings.Posix.Unistd
 import Bindings.Posix.Sys.Mman
 import Context.Language as Lang
 import Context.Language
 import Context.Types
-import Data.ByteString
+import Data.ByteString hiding (map,putStrLn)
 import Data.ByteString.Unsafe
+import Data.ByteString.Internal
 import Data.Functor.Identity
 import Data.IORef
 import Data.Maybe
@@ -39,11 +41,37 @@
   get = readIORef contextRef
   put = writeIORef contextRef
 
-addressRef = unsafePerformIO $ newIORef (undefined :: ID -> IO Int)
+funPtrToInteger f = fromIntegral $ ptrToIntPtr $ castFunPtrToPtr f
+
+exportAlpha stub ptr = unsafePerformIO $ do
+  unsafeUseAsCStringLen (stub $ funPtrToInteger ptr) $ \(src,size) -> do
+    ptr <- mallocForeignPtrBytes size
+    withForeignPtr ptr $ \dst -> copyBytes (castPtr dst) src size
+    return ptr
+
 foreign export ccall "address_" address_ :: ID -> IO Int
-address_ i = readIORef addressRef >>= ($i)
 foreign import ccall "&address_" address_ptr :: FunPtr (ID -> IO Int)
+addressRef = unsafePerformIO $ newIORef (undefined :: ID -> IO Int)
+address_ id = readIORef addressRef >>= ($id)
 
+foreign export ccall "symName_" symName_ :: ID -> IO (Ptr Word8)
+foreign import ccall "&symName_" symName_ptr :: FunPtr (ID -> IO (Ptr Word8))
+symName_ sym = do
+  n <- gets (lookupSymName sym . language)
+  ret <- newArray0 0 (map c2w $ fromMaybe "" n)
+  return ret
+
+foreign export ccall "allocate_" allocate_ :: Int -> IO (Ptr ())
+foreign import ccall "&allocate_" allocate_ptr :: FunPtr (Int -> IO (Ptr ()))
+allocate_ = mallocBytes
+
+foreign export ccall "printOK_" printOK_ :: IO ()
+foreign import ccall "&printOK_" printOK_ptr :: FunPtr (IO ())
+printOK_ = Prelude.putStrLn "OK"
+foreign export ccall "printNum_" printNum_ :: Int -> IO ()
+foreign import ccall "&printNum_" printNum_ptr :: FunPtr (Int -> IO ())
+printNum_ n = print (intPtrToPtr $ fromIntegral n)
+
 initialBindings = [(n,Left $ Builtin b) | (b,n) <- bNames] ++ [
   ("alter"  ,Left $ Axiom XAlter),
   ("bind"   ,Left $ Axiom XBind),
@@ -60,7 +88,11 @@
   ("id"     ,Left $ Axiom XID),
   ("@"      ,Left $ Axiom XAddr),
   ("#"      ,Left $ Axiom XSize)] ++ [
-  ("addressC",Right $ castFunPtrToPtr address_ptr)
+  ("alpha/c@"          , Right $ exportAlpha callStub1 address_ptr),    
+  ("alpha/symbol-name" , Right $ exportAlpha callStub1 symName_ptr),    
+  ("alpha/allocate"    , Right $ exportAlpha callStub1 allocate_ptr), 
+  ("alpha/print-OK"    , Right $ exportAlpha callStub0 printOK_ptr),    
+  ("alpha/print-num"   , Right $ exportAlpha callStub1 printNum_ptr)  
   ]
 
 doTransform syn = gets transform >>= ($syn)
@@ -71,7 +103,7 @@
                   i <- stateF fstF (internSym s)
                   case v of
                     Left v -> modifyF fstF (setSymVal i v)
-                    Right p -> modifyF sndF (M.insert i $ unsafePerformIO $ newForeignPtr_ p)
+                    Right p -> modifyF sndF (M.insert i p)
 
 withDefaultContext = withState initialContext
 
@@ -82,34 +114,38 @@
 foreign import ccall "dynamic" mkFunSize :: FunPtr (Ptr() -> IO Int) -> Ptr() -> IO Int
 foreign import ccall "dynamic" mkFunInit :: FunPtr (Ptr () -> Ptr() -> IO ()) -> Ptr() -> Ptr () -> IO ()
 
+pageSize = fromIntegral $ unsafePerformIO $ c'sysconf c'_SC_PAGESIZE
+enableExec p size = do
+  let p' = alignPtr (p`plusPtr`(1-pageSize)) pageSize
+  mprotect (castPtr p') (fromIntegral $ size+ p`minusPtr`p') (c'PROT_READ .|. c'PROT_WRITE .|. c'PROT_EXEC)
+  
 getAddress arch lookup register = withRef addressRef getAddr . getAddr
   where
-    getAddr id = lookup id >>= \val -> case val of
+    getAddr sym = lookup sym >>= \val -> case val of
       Just a -> return a
-      Nothing -> gets language >>= \lang -> (>> getAddr id) $ case lookupSymVal id lang of
+      Nothing -> gets language >>= \lang -> (>> getAddr sym) $ case lookupSymVal sym lang of
         Verb c -> void $ do
-          let (size,codem) = specialize arch (id,getAddr) c
+          let (size,codem) = specialize arch (sym,getAddr) c
           ptr <- mallocForeignPtrBytes size
-          register id ptr size
+          register sym ptr size
           code <- codem
           withForeignPtr ptr $ \p -> do
             unsafeUseAsCStringLen code $ \(p',n) -> copyBytes p (castPtr p') n
-            mprotect (castPtr p) (fromIntegral size) (c'PROT_READ .|. c'PROT_WRITE .|. c'PROT_EXEC)
+            enableExec p size
         Noun size init -> do
-          size <- join $ evalCode mkFunSize execStub size
+          size <- evalCode mkFunSize execStub size id
           ptr <- mallocForeignPtrBytes size
-          register id ptr size
-          withForeignPtr ptr $ \p -> evalCode mkFunInit initStub init >>= ($castPtr p)
-        _ -> fail $ "Couldn't find definition of symbol "++fromMaybe (show id) (lookupSymName id lang)
+          register sym ptr size
+          withForeignPtr ptr $ \p -> evalCode mkFunInit initStub init ($castPtr p)
+        _ -> fail $ "Couldn't find definition of symbol "++fromMaybe (show sym) (lookupSymName sym lang)
 
-evalCode :: (FunPtr (Ptr() -> a) -> (Ptr() -> a)) -> ByteString -> Code -> IO a
-evalCode wrap stub code = do
+evalCode :: (FunPtr (Ptr() -> a) -> Ptr() -> a) -> ByteString -> Code -> (a -> IO b) -> IO b
+evalCode wrap stub code f = do
   id <- languageState $ state createSym >>= \i -> modify (setSymVal i (Verb code)) >> return i
   p <- getAddressJIT id
-  unsafeUseAsCString stub $ \stub ->
-    return $ wrap (castPtrToFunPtr stub) (intPtrToPtr $ fromIntegral p) 
+  unsafeUseAsCString stub $ \stub -> f $ wrap (castPtrToFunPtr stub) (intPtrToPtr $ fromIntegral p) 
 execCode [] = return ()
-execCode instrs = join $ evalCode mkProc execStub (Code [] instrs (symBind (ID (-1))))
+execCode instrs = evalCode mkProc execStub (Code [] instrs (symBind (ID (-1)))) id
 
 getAddressJIT = getAddress hostArch lookup register
   where lookup id = do
diff --git a/src/My/Prelude.hs b/src/My/Prelude.hs
--- a/src/My/Prelude.hs
+++ b/src/My/Prelude.hs
@@ -5,6 +5,11 @@
 import Data.Maybe
 import Debug.Trace as Tr
 import My.Control.Monad
+import qualified Data.ByteString as B
+import Data.List
+import Data.Char
+import Data.Word
+import Data.Array
 
 debugMess mess x = Tr.trace (mess++show x) x
 debug x = traceShow x x
@@ -23,4 +28,11 @@
 
 newerThan f1 f2 = liftM2 (>) (modTime f1) (modTime f2)
   where modTime f = modificationTime $< getFileStatus f
+
+showHex n = reverse $ map (intToDigit . fromIntegral . (`mod`16)) $ take 2 $ iterate (`div`16) (n :: Word8)
+showCode code = intercalate " " $ map showHex $ B.unpack $ code
+
+a !# i | bounds a`inRange`i = a!i
+       | otherwise = error $ "undefined index "++show i++" in array "
+
 
diff --git a/src/PCode/Builtin.hs b/src/PCode/Builtin.hs
--- a/src/PCode/Builtin.hs
+++ b/src/PCode/Builtin.hs
@@ -5,7 +5,7 @@
              | BLowerEq | BLowerThan | BGreaterEq | BGreaterThan 
              | BEqual | BNotEqual
              | BCall
-             | BSet
+             | BSet | BSetSX
              deriving (Show,Eq)
 
 isBinOp b = b/=BCall && b/=BSet && b/=BNot
@@ -13,5 +13,6 @@
 bNames = [(BAdd,"+"),(BMul,"*"),(BSub,"-"),(BDiv,"/"),(BMod,"%"),
           (BLowerThan,"<"),(BGreaterThan,">"),(BLowerEq,"<="),(BGreaterEq,">="),
           (BEqual,"=="),(BNotEqual,"<>"),
-          (BAnd,"&"),(BOr,"|"),(BXor,"x|"),(BNot,"not")]
+          (BAnd,"&"),(BOr,"|"),(BXor,"x|"),(BNot,"not"),
+          (BSet,"^"),(BSetSX,"¨")]
 
diff --git a/src/PCode/Instruction.hs b/src/PCode/Instruction.hs
--- a/src/PCode/Instruction.hs
+++ b/src/PCode/Instruction.hs
@@ -10,6 +10,7 @@
 import PCode.Builtin
 import PCode.Value
 import ID
+import My.Prelude
 
 type Addr = Int
 data BindVar = BindVar { 
diff --git a/src/Specialize.hs b/src/Specialize.hs
--- a/src/Specialize.hs
+++ b/src/Specialize.hs
@@ -55,11 +55,11 @@
         nextFuture i f = snd4 $ runInstr i undefined f (const Nothing)
         gens = array bounds $ zip (flatten codeTree) [0..]
         gens' = array bounds $ zip [0..] (flatten codeTree)
-        getPast g i | g >= gens!i = Just $ fst $ instrs!i
+        getPast g i | g >= gens!i = Just $ fst $ instrs!#i
                     | otherwise = Nothing
         instrs = array bounds $ flatten $ descend desc past codeTree
           where desc i p = ((i,(p,c)),p')
-                  where ~(p',_,_,c) = runInstr i p (snd $ futures!g!i) (getPast g)
+                  where ~(p',_,_,c) = runInstr i p (snd $ futures!g!#i) (getPast g)
                         g = gens!i
         futures = fmap snd $ listArray bounds $ iterate nextFut (1,initial)
           where initial = execState (sequence_ [changeFuture i 0 (futureOf i) | i <- map last (branches codeTree)])
@@ -68,7 +68,7 @@
                                    | otherwise = emptyFuture
                 nextFut (g,fa) = (g+1,fa')
                   where fa' = execState (sequence_ [changeFuture i g newFut | i <- prevs instr, head (nexts i)==instr]) fa
-                        instr = gens'!g ; newFut = Future $ registers $ fst (instrs!instr)
+                        instr = gens'!g ; newFut = Future $ registers $ fst (instrs!#instr)
                 changeFuture i g f = puti i (g,f) >> mapM_ propagate (prevs i)
                 propagate i = do 
                   let j = head (nexts i)
@@ -92,9 +92,9 @@
                     fun i a = (addActives (instr i) out,out)
                       where out = S.unions (map ((a!) >>> fst) (nexts i))
                             addActives (Op _ v vs) s = (s S.\\ clobbers i v)
-                                                       <> S.unions [clobbers i s' | SymVal Value s <- vs
-                                                                                  , s' <- s:maybeToList (root i s)]
-                                                       <> S.fromList (catMaybes [root i s | SymVal Address s <- SymVal Address v:vs])
+                                                       <> S.unions [clobbers i s | SymVal Value s <- vs]
+                                                       <> S.fromList (catMaybes [root i s | SymVal t s <- SymVal Address v:vs
+                                                                                          , t==Value || t==Address])
                             addActives (Branch (SymVal Value id) _) s = s <> clobbers i id 
                             addActives (Bind _ v) s = maybe id S.insert v s
                             addActives _ s = s
@@ -107,11 +107,14 @@
               where next i r (Bind bv v) = insertManyA r assocs
                       where assocs = [(bindSym bv,s) | bv <- bindNodes bv
                                                      , s <- bindSyms bv]
-                                     ++[(s,ref) | v <- maybeToList v
-                                                , ref <- S.toList $ references i v
-                                                , s <- maybe [v] S.toList (R.lookupRan ref r)]
+                                     ++[(s,s') | v <- maybeToList v
+                                               , ref <- S.toList $ references i v
+                                               , s <- S.toList $ clobbers i ref
+                                               , s' <- bindSyms bv]
                     next i r (Op BCall d (_:args)) = insertManyA r assocs
-                      where assocs = map (worldID,) $ d : argRefs i args
+                      where assocs = [a | ref <- d : argRefs i args
+                                        , v <- S.toList $ clobbers i ref
+                                        , a <- [(v,worldID),(v,v)]]
                     next _ r _ = r
                     insertManyA r as = insertManyR r [a | (x,y) <- as, a <- [(x,y),(y,x)]]
             lookupRefs v r = fromMaybe (S.singleton worldID) $ R.lookupRan v r
diff --git a/src/Specialize/Architecture.hs b/src/Specialize/Architecture.hs
--- a/src/Specialize/Architecture.hs
+++ b/src/Specialize/Architecture.hs
@@ -2,7 +2,7 @@
                               ,arch_x86
                               ,arch_x86_64
                               ,arch_arm
-                              ,hostArch,Specialize.Architecture.execStub,Specialize.Architecture.initStub
+                              ,hostArch,Specialize.Architecture.execStub,Specialize.Architecture.initStub,Specialize.Architecture.callStub0,Specialize.Architecture.callStub1
                               ,architectures) where
 
 import Specialize.Types
@@ -25,3 +25,5 @@
 
 execStub = unsafePerformIO Host.execStub
 initStub = unsafePerformIO Host.initStub
+callStub0 = unsafePerformIO . Host.callStub0
+callStub1 = unsafePerformIO . Host.callStub1
diff --git a/src/Specialize/Types.hs b/src/Specialize/Types.hs
--- a/src/Specialize/Types.hs
+++ b/src/Specialize/Types.hs
@@ -1,13 +1,14 @@
 {-# LANGUAGE RankNTypes #-}
 module Specialize.Types(module Data.Word, module My.Control.Monad.RWTL
                        ,module PCode, module ID,module Specialize.Frame
-                       ,Register(..),BinCode(..), isEmptyCode
+                       ,Register(..),BinCode(..), isEmptyCode, binCodeData
                        ,Architecture(..)
                        ,Info(..)
                        ,MemState(..),Future(..), emptyFuture
-                       ,frameF, registersF, fregistersF) where
+                       ,frameF, registersF, changedF, fregistersF) where
 
 import Data.Bimap
+import Data.Set
 import Data.ByteString
 import Data.Map
 import Data.Relation
@@ -24,9 +25,10 @@
   mempty = BC (0,0,return mempty)
   mappend (BC ~(e,s,v)) (BC ~(e',s',v')) = BC (e+e',s+s',liftM2 (<>) v v')
 instance Show BinCode where
-  show (BC (e,a,_)) = show (e,a)
+  show (BC (e,s,_)) = show (e,s)
 
 isEmptyCode (BC (e,_,_)) = e==0
+binCodeData (BC (_,_,b)) = b
 
 type Register = Int
 data Architecture = Arch {
@@ -36,8 +38,9 @@
   archCompileInstr :: Instruction -> RWTL Info BinCode MemState Future ()
   }
 data MemState = MemState {
-  registers  :: Bimap ID Register,
-  frame :: Frame
+  registers :: Bimap ID Register,
+  changed   :: Set ID,
+  frame     :: Frame
   }
           deriving Show
 data Future = Future {
@@ -54,8 +57,17 @@
   branchPos  :: (Int,Int -> (Int,Int,Maybe MemState))
   }
 
-frameF = Field (frame,\f p -> p { frame = f })
-registersF = Field (registers,\r p -> p { registers = r })
-fregistersF = Field (fregisters,\r f -> f { fregisters = r })
+instance Show Info where
+  show (Info _ b sz a c l _) = "Info { bindings = "++show b
+                               ++", sizes = "++show sz
+                               ++", actives = "++show a
+                               ++", clobbers = "++show c
+                               ++", locals = "++show l
+                               ++" }"
+
+registersF  = Field (registers  ,\r p -> p { registers = r })
+changedF    = Field (changed    ,\c p -> p { changed = c })
+frameF      = Field (frame      ,\f p -> p { frame = f })
+fregistersF = Field (fregisters ,\r f -> f { fregisters = r })
 
 emptyFuture = Future Data.Bimap.empty
diff --git a/src/Specialize/X86_64.hs b/src/Specialize/X86_64.hs
--- a/src/Specialize/X86_64.hs
+++ b/src/Specialize/X86_64.hs
@@ -1,5 +1,5 @@
-{-# LANGUAGE ViewPatterns, TupleSections, ParallelListComp, ImplicitParams, NoMonomorphismRestriction, Rank2Types #-}
-module Specialize.X86_64(arch_x86_64,execStub,initStub) where
+{-# LANGUAGE ViewPatterns, TupleSections, ParallelListComp, ImplicitParams, NoMonomorphismRestriction #-}
+module Specialize.X86_64(arch_x86_64,execStub,initStub,callStub0,callStub1) where
 
 import Control.Monad.Writer.Class
 
@@ -30,24 +30,27 @@
 bytes        :: (Bits a,Integral a,Num b) => a -> [b]
 defSize      :: Num a => a
 argBytesWide :: Bool -> Int -> Int -> (Maybe Integer) -> ([Word8],[Word8])
-codeFun      :: [(Int,(Word8,Int))] -> (Int,IO Integer) -> Maybe (Word8,Int,Int,IO [Word8])
-
-type OpT = MonadWriter BinCode m => (Int -> Int -> Int -> m ()
-                                    ,Int -> Int -> (Int,IO Integer) -> m ()
-                                    ,Int -> (Int,IO Integer) -> Int -> m ()
-                                    ,Integer -> Integer -> Integer)
+codeFun      :: [(Int,(Word8,Int,Int))] -> (Int,IO Integer) -> Maybe (Word8,Int,Int,IO [Word8])
 
 arch_x86_64 = Arch "x86_64" defSize defaults compile
-(execStub,initStub) = (writerStub exec,writerStub init)
-  where callStub loadArgs = do
+(execStub,initStub, callStub0, callStub1) = (writerStub exec,writerStub init,
+                                             writerStub . callStub0,writerStub . callStub1)
+  where cStub loadArgs = do
           mapM_ push saved
           loadArgs
           call rdi
           mapM_ pop saved
           tellCode [0xc3]
+        alphaStub loadArgs f = do
+          loadArgs
+          movi r14 (withSize (f :: Integer))
+          call r14
+          tellCode [0xc3]
         saved = rbx:rbp:[r12..r15]
-        init = callStub (mov rdx rsi)
-        exec = callStub (return ())
+        init = cStub (mov rdx rsi)
+        exec = cStub (return ())
+        callStub0 = alphaStub (return ())
+        callStub1 = alphaStub (mov rdi rdx)
         push r = tellCode $ pre++[0x50.|.(fi r.&.7)]
           where (pre,_) = argBytesWide False 0 r Nothing
         pop r = tellCode $ pre++[0x58.|.(fi r.&.7)]
@@ -56,19 +59,24 @@
 
 defSize = 8
 ([rax,rcx,rdx,rbx,rsp,rbp,rsi,rdi,r8,r9,r10,r11,r12,r13,r14,r15],allocRegs) =
-  (regs,filter (not . (`elem`[rsp,r15])) regs)
+  (regs,filter isAllocReg regs)
   where regs = [0..15] :: [Int]
+isAllocReg r = (r>=rax && r<rsp) || (r>rdi && r<=r15)
+oppFlags f = fromJust $ lookup f $ fls++map swap fls
+  where fls = [(0xf,0xc),(0x4,0x5),(0xd,0xe)]
 
 fis = fmap fromIntegral ; fi = fromIntegral
 k = Kleisli
 a <|||> b = runKleisli (k a ||| k b)
 leftK f = runKleisli (left $ k f)
 
-showHex n = reverse $ map (intToDigit . fromIntegral . (`mod`16)) $ take 2 $ iterate (`div`16) (n :: Word8)
-showCode = intercalate " " . map showHex
-
 bSize (bindSize -> (n,nr)) = n+nr*defSize
-numSize n = length $ takeWhile (>0) $ iterate (`shiftR`8) n
+numSize n | n>=0 = numSize 64 n
+          | otherwise = 1+numSize 64 (-1-n)
+  where numSize 0 _ = 1
+        numSize bl n = case reverse $ takeWhile (>0) $ iterate (`shiftR`bl) n of
+          [] -> 0
+          (x:t) -> (length t)*bl + numSize (bl`div`2) x
 withSize n = (numSize n,return $ fi n)
 fromFields fs = foldl1 xor (zipWith shiftL (map (fst) fs) (scanl (+) 0 $ map snd fs))
 bytes = fis . iterate (`shiftR`8)
@@ -97,26 +105,43 @@
   Just (code,r,s',imm) -> mov d a >> tell (fromBytesN (length pref+s') (liftM (pref++) imm))
     where (pre,suf) = argBytes r d Nothing
           pref = pre++[code]++suf
-  Nothing -> movi r15 n >> op def d a r15
-codeFun codes (size,n) = listToMaybe [(code,r,s,imm s) | (s,(code,r)) <- codes, s>=size]
+  Nothing -> movi rsi n >> op def d a rsi
+codeFun codes (size,n) = listToMaybe [(code,r,count,imm count) | (s,(code,count,r)) <- codes, s>=size]
   where imm s = liftM (take s . bytes) n
                       
 mov d s | d==s = return ()
-        | otherwise = tellCode $ pre++[0x8b]++suf
+        | otherwise = tellCode (pre++[0x8b]++suf)
   where (pre,suf) = argBytes d s Nothing
-movi d (0,_) = bwxor d d d
+movi d (0,_) = bwxorrr d d d
 movi d n = tell $ fromBytesN (length pref+s) (liftM (pref++) imm)
-  where (code,r,s,imm) = fromJust $ codeFun [(4,(0xC7,0)),(8,(0xB8`xor`(fi d.&.7),0))] n
+  where (code,r,s,imm) = fromJust $ codeFun [(31,(0xC7,4,0)),(64,(0xB8`xor`(fi d.&.7),8,0))] n
         (pre,suf) | code==0xC7 = argBytes 0 d Nothing
                   | otherwise = (fst $ argBytes d 0 Nothing,[])
         pref = pre++[code]++suf
 lea d s n = tellCode $ pre++[0x8d]++post
   where (pre,post) = argBytes d s (Just n)
+zxtnd r s = case (s :: Int) of
+  1 -> tellCode (pre++[0x0f,0xb6]++post)
+  2 -> tellCode (pre++[0x0f,0xb7]++post)
+  _ -> shli r r sz >> shri r r sz
+    where sz = withSize $ 8*(defSize-s)
+  where (pre,post) = argBytes r r Nothing
+sxtnd r s = case (s :: Int) of
+  1 -> tellCode (pre++[0x0f,0xbe]++post)
+  2 -> tellCode (pre++[0x0f,0xbf]++post)
+  4 -> tellCode (pre++[0x63]++post)
+  _ -> shli r r sz >> sari r r sz
+    where sz = withSize $ 8*(defSize-s)
+  where (pre,post) = argBytes r r Nothing
+  
+setcc r f = tellCode (pre++[0x0f,0x90.|.fi f]++post) >> zxtnd r 1
+  where (pre,post) = argBytesWide False 0 r Nothing
 
-shli = opi (codeFun [(1,(0xC1,4))]) undefined
-shri = opi (codeFun [(1,(0xC1,5))]) undefined
+shli = opi (codeFun [(8,(0xC1,1,4))]) undefined
+shri = opi (codeFun [(8,(0xC1,1,5))]) undefined
+sari = opi (codeFun [(8,(0xC1,1,7))]) undefined
 rori d s n | n==0||n==64 = return ()
-           | otherwise = opi (codeFun [(1,(0xC1,1))]) undefined d s (withSize n)
+           | otherwise = opi (codeFun [(8,(0xC1,1,1))]) undefined d s (withSize n)
 ld d (_,_,0) = return ()
 ld d (s,n,size) = load
   where szs = maximumBy (comparing weight) $ permutations [sz | sz <- [8,4,2,1], sz.&.size /= 0]
@@ -124,11 +149,7 @@
                   where f s i = fromJust $ findIndex (\p -> m.&.p==0) $ iterate (`shiftR`1) s
                           where m = s-((n+i)`mod`s)
         load = sequence_ $ zipWith ldChunk (reverse $ zip (sums szs) szs) (True:repeat False)
-        ldChunk (i,sz) fst = do
-          sh sz
-          if sz==1 && d>=4 && d<8
-            then (if fst then return () else mov r15 d) >> ld r15 (s,n+i,1) >> mov d r15
-            else tellCode $ pre'++pre++code++suf
+        ldChunk (i,sz) fst = sh sz >> tellCode (pre'++pre++code++suf)
           where (pre,suf) = argBytesWide (sz==8) d s (Just (n+i))
                 (pre',code) = fromJust (lookup sz [(8,([],[0x8b]))
                                                   ,(4,([],[0x8b]))
@@ -143,11 +164,7 @@
                   where f s i = fromJust $ findIndex (\p -> m.&.p==0) $ iterate (`shiftR`1) s
                           where m = s-((n+i)`mod`s)
         store = sequence_ $ reverse [stChunk a b | (a,b) <- zip (reverse $ zip (sums szs) szs) (True:repeat False)]
-        stChunk (i,sz) lst = do
-          (if sz==1 && d>=4 && d<8
-            then mov r15 s >> st (d,n+i,1) r15
-            else tellCode $ pre'++pre++code++suf)
-          sh sz
+        stChunk (i,sz) lst = tellCode (pre'++pre++code++suf) >> sh sz
           where (pre,suf) = argBytesWide (sz==8) s d (Just (n+i))
                 (pre',code) = fromJust (lookup sz [(8,([],[0x89]))
                                                   ,(4,([],[0x89]))
@@ -156,30 +173,34 @@
                 sh sz | lst = rori s s ((8-i)*8)
                       | otherwise = rori s s (sz*8)
 
-commOp c c' f = (op c,opn,flip . opn,f :: Integer -> Integer -> Integer)
+commOp c c' = (op c,opn,flip . opn)
   where opn = opi (codeFun c') c
 
-adds@(add,addi,_,_)       = commOp [0x03]      [(1,(0x83,0)),(4,(0x81,0))]  (+)
-muls@(mul,muli,_,_)       = commOp [0x0F,0xAF] [(1,(0x6B,0)),(8,(0x69,0))]  (*)
-bwands@(bwand,bwandi,_,_) = commOp [0x23]      [(1,(0x83,4)),(4,(0x81,4))]  (.&.)
-bwors@(bwor,bwori,_,_)    = commOp [0x0b]      [(1,(0x83,1)),(4,(0x81,1))]  (.|.)
-bwxors@(bwxor,bwxori,_,_) = commOp [0x33]      [(1,(0x83,6)),(4,(0x81,6))]  xor
-subs :: OpT
-subs@(sub,subi,_,_) = (sub,opi (codeFun codes) [0x2b],subi',(-))
-  where neg r = tellCode $ pre++[0xf7]++post
-          where (pre,post) = argBytes 3 r Nothing
-        sub d a b | d==b = op [0x2b] d d a >> neg d
-                  | otherwise = op [0x2b] d a b
-        codes = [(1,(0x83,5)),(4,(0x81,5))]
-        subi' d n a | d==a = subi d d n >> neg d
-                    | otherwise = movi d n >> sub d d a
-cmps f = (cmp,cmpi,cmp',f)
-  where cmp _ a b = op [0x3b] a a b
-        codes = [(1,(0x83,7)),(4,(0x81,7))]
-        cmpi _ a = opi (codeFun codes) [0x3b] a a
-        cmp' _ n a = movi r15 n >> cmp r15 r15 a
+addri d r (0,_) = return ()
+addri d r v = addri' d r v
+(addrr,addri',addir)      = commOp [0x03]      [(8,(0x83,1,0)),(32,(0x81,4,0))]
+(mulrr,mulri,mulir)       = commOp [0x0F,0xAF] [(8,(0x6B,1,0)),(64,(0x69,8,0))]
+(bwandrr,bwandri,bwandir) = commOp [0x23]      [(7,(0x83,1,4)),(31,(0x81,4,4))]
+(bworrr,bworri,bworir)    = commOp [0x0b]      [(7,(0x83,1,1)),(31,(0x81,4,1))]
+(bwxorrr,bwxorri,bwxorir) = commOp [0x33]      [(7,(0x83,1,6)),(31,(0x81,4,6))]
+neg r = tellCode $ pre++[0xf7]++post
+  where (pre,post) = argBytes 3 r Nothing
+subrr d a b | d==b = op [0x2b] d d a >> neg d
+            | otherwise = op [0x2b] d a b
+subri d r (0,_) = return ()
+subri d r v = opi (codeFun [(8,(0x83,1,5)),(32,(0x81,4,5))]) [0x2b] d r v
+subir d n a | d==a = subri d d n >> neg d
+            | otherwise = movi d n >> subrr d d a
 
-calli pos (_,v) = tell $ fromBytesN 5 (liftM2 (\p v -> [0xe8]++take 4 (bytes (v-fi p-5))) pos v)
+cmprr _ a b = op [0x3b] a a b
+cmpri _ a = opi (codeFun codes) [0x3b] a a
+  where codes = [(8,(0x83,1,7)),(32,(0x81,4,7))]
+cmpir _ n a = movi rsi n >> cmprr rsi rsi a
+
+calli pos (size,v) = tell $ fromBytesN 5 $ do
+  pos <- pos ; v <- v
+  -- putStrLn $ "calli: size="++show size++" pos="++show pos++" dest="++show v
+  return $ [0xe8]++take 4 (bytes (v-fi pos-5))
 call r = tellCode $ pre++[0xff]++post
   where (pre,post) = argBytesWide False 2 r Nothing
 
@@ -189,19 +210,10 @@
   (Right v,Left r) -> ir dest v r
   (Right (s,n),Right (s',n')) -> movi dest (max s s',liftM2 ii n n')
 
-associate r (Just s) = modifyF registersF $ BM.insert s r
-associate r Nothing = modifyF registersF $ BM.deleteR r
-frameAddr s = stateF frameF (withAddr defSize s) >§ \n -> (-8)-n
-lookupSymIn = flip BM.lookupR
-lookupRegIn = flip BM.lookup
-argValSym (SymVal Value s) = Just s
-argValSym _ = Nothing
-lookupArgReg arg m = argValSym arg >>= lookupRegIn m
-
 argVal (IntVal n) = Right $ withSize n
 argVal (SymVal Size s) = Right $ withSize $ fromMaybe defSize $ M.lookup s (sizes ?info)
 argVal (SymVal SymID (ID s)) = Right $ withSize $ s
-argVal (SymVal _ s) = maybe (Left s) (Right . (4,)) $ globVal s
+argVal (SymVal _ s) = maybe (Left s) (Right . (defSize*8,)) $ globVal s
 globVal s = if isLocal s then Nothing else Just (toInteger $< snd (envInfo ?info) s)
 isLocal s = S.member s (locals ?info)
 binding s = M.lookup s (bindings ?info)
@@ -209,7 +221,21 @@
 varSize s = fromMaybe defSize (M.lookup s $ sizes ?info) 
 argSize (SymVal Value s) = varSize s
 argSize _ = defSize
+verbAddress = let (me,addrs) = envInfo ?info in addrs me
+instrAddress i = let (_,addrs) = branchPos ?info ; (e,s,_) = addrs i in (e,s) 
+instrPast i = let (_,addrs) = branchPos ?info ; (_,_,p) = addrs i in p 
+thisInstr = fst $ branchPos ?info
 
+associate r s = modifyF registersF (maybe BM.deleteR BM.insert s r)
+frameAddr s = stateF frameF (withAddr defSize s)
+stackAddr sz = liftM (frameToStack sz) . frameAddr
+frameToStack sz n = -(n+sz)
+lookupSymIn = flip BM.lookupR
+lookupRegIn = flip BM.lookup
+argValSym (SymVal Value s) | isLocal s = Just s
+argValSym _ = Nothing
+lookupArgReg arg m = argValSym arg >>= lookupRegIn m
+
 withFreeSet m = liftM2 (,) get (future get) >>= \(p,f) -> do
   let cmp r r' = case (regVar r,regVar r') of
         (Just _,Nothing) -> GT
@@ -234,7 +260,7 @@
 
 allocReg sym = lift regInfo >>= \(_,regs) -> do
   let st free = (r,SB.delete r free)
-        where r | SB.null free = r15
+        where r | SB.null free = rdi
                 | otherwise = fromMaybe (SB.findMin free) $ mfilter (`SB.member`free)
                                                                      $ lookupRegIn regs sym
   state st
@@ -242,16 +268,17 @@
 destRegister d = lift regInfo >>= \(regs,fregs) -> 
   case mfilter (\r -> maybe True (==d) $ BM.lookupR r regs) $ lookupRegIn fregs d of
     Just r -> return r
-    Nothing -> case find ((==Just d) . findReg) allocRegs `mplus` find (isNothing . findReg) allocRegs of
+    Nothing -> case mfilter isAllocReg (findSym d) `mplus` find (isNothing . findReg) allocRegs of
       Just r -> return r
       Nothing -> storeRegs [head allocRegs] >> return (head allocRegs)
-      where findReg s = lookupSymIn regs s `mplus` lookupSymIn fregs s
+      where findReg r = lookupSymIn regs r `mplus` lookupSymIn fregs r
+            findSym s = lookupRegIn regs s `mplus` lookupRegIn fregs s
 
 loadRoot (Just s) = lift regInfo >>= \(regs,_) -> case lookupRegIn regs s of
   Just r -> return r
   Nothing -> do
     r <- allocReg s
-    a <- lift (frameAddr s)
+    a <- lift (stackAddr defSize s)
     lift $ associate r (Just s)
     ld r (rsp,fi a,defSize)
     return r
@@ -262,15 +289,18 @@
       parent (_,_,b) = fmap fst b
       groups = classesBy ((==)`on`parent) vars
       storeGroup g = do
-        reg <- loadRoot $ parent $ head g
-        lift $ mapM_ (store reg) g
+        ch <- lift $ gets (flip S.member . changed)
+        let loaded = [(ch s,ge) | ge@(_,s,_) <- g]
+        reg <- if any fst loaded then loadRoot $ parent $ head g else return undefined
+        lift $ mapM_ (\(c,ge@(r,s,_)) -> when c (store reg ge)
+                                         >> associate r Nothing
+                                         >> modifyF changedF (S.delete s)) loaded
         where store base (r,s,b) = do
-                n <- maybe (frameAddr s) (return . snd) b
+                n <- maybe (stackAddr (varSize s) s) (return . snd) b
                 st (base,fi n,fi (varSize s)) r
       restrict m = gets (SB.partition isFree) >>= \(free',occ) -> put free' >> m >> modify (SB.union occ)
         where isFree = isNothing . lookupSymIn regs
   restrict $ mapM_ storeGroup groups
-  lift $ modifyF registersF $ \rs -> foldr BM.delete rs [s | (_,s,_) <- vars]
 
 loadArgs args = do
   let modFRegs regs = foldr ($) regs [maybe (BM.deleteR r) (flip BM.insert r) $ argValSym arg
@@ -290,22 +320,21 @@
     allocs <- mapM argNew alls
     let assocs = filter (\(r,arg,_) -> not $ (myWorkIsDone r ||| const False) (argVal arg))
                  $ lefts [left (,arg,bind arg) all | all <- allocs | (arg,_) <- args]
-        bind (SymVal _ s) | isLocal s = binding s
-        bind _ = Nothing
+        bind arg = argValSym arg >>= binding
         groups = classesBy ((==)`on`parent) assocs
         parent (_,_,b) = fmap fst b
-        myWorkIsDone r s = lookupRegIn regs s == Just r
+        myWorkIsDone r s = BM.pairMember (s,r) regs
         loadGroup g = do
           base <- loadRoot (parent $ head g)
           mapM_ (load base) g
           where load base (r,arg,b) = lift regInfo >>= \(regs,_) -> do
-                  when (isJust $ lookupSymIn regs r) (storeRegs [r])
+                  when (BM.memberR r regs) (storeRegs [r])
                   lift $ case argVal arg of
                     Right v -> movi r v
                     Left s -> case lookupRegIn regs s of
                       Just r' -> mov r r'
                       Nothing -> do
-                        n <- maybe (frameAddr s) return $ fmap snd b
+                        n <- maybe (stackAddr (varSize s) s) return $ fmap snd b
                         if symValType arg == Value
                           then ld r (base,fi n,fi (varSize s))
                           else lea r base (fi n)
@@ -319,7 +348,7 @@
   free <- get
   readFuture $ storeRegs (SB.toList free)
 
-defaults args ret = (MemState pregs frame,Future fr)
+defaults args ret = (MemState pregs (S.fromList $ map (bindSym . snd) regs) frame,Future fr)
   where (regArgs,stArgs) = partition ((<=defSize) . bSize) args
         (regs,nonRegs) = zipRest argRegs regArgs
         (retReg:funReg:argRegs) = allocRegs
@@ -328,42 +357,65 @@
         fr | bSize ret<=defSize = BM.singleton (bindSym ret) retReg
            | otherwise = BM.empty
 
-compile i = ask >>= \info -> let ?info = info in compile' i
-    
+storeFlags s = do
+  regs <- gets registers
+  withFreeSet $ readFuture $ case M.lookupGE 16 (BM.toMapR regs) of
+    Nothing -> doNothing
+    Just (rf,s') | s==Just s' -> doNothing
+                 | isActive s' -> do
+      r <- destRegister s'
+      storeRegs [r]
+      setcc r rf
+      lift $ associate r (Just s')
+                 | otherwise -> lift $ associate rf Nothing
+
+compile i = ask >>= \info -> let ?info = info in 
+  listen (storeFlags (branchSym i)) >>= \(_,BC (e',s',_)) -> 
+  let ?info = info { branchPos = (thisInstr,
+                                  \i -> let (e,s,p) = snd (branchPos ?info) i in (e+e',s+s',p)) }
+  in compile' i
+
+  where branchSym (Branch (SymVal Value s) _) = Just s
+        branchSym _ = Nothing
+                                                 
 compile' (Op b d vs) = do
   future $ modifyF fregistersF $ BM.delete d
   compileOp b d vs
   flip evalStateT (SB.empty compare) $ readFuture $ do
     (regs,_) <- lift regInfo
+    when (BM.member d regs) $ lift $ modifyF changedF (S.insert d)
     storeRegs [r | (s,r) <- BM.toList regs, not (isActive s), isJust (binding s)]
     lift $ modifyF registersF (BM.filter (const . isActive))
 compile' (Branch v alts) = withFreeSet $ do
-  (instr,brInfo) <- asks branchPos
-  let alignPast (brInfo -> (_,_,p)) = maybe doNothing (preserve . alignWith . registers) p
-      jmpc short long (BC (e,a,_)) (BC (e',a',_)) = BC (length long+4,length code,return $ B.pack code)
-        where de = e'-e ; da = a'-a
+  let alignPast i = maybe doNothing (preserve . alignWith . registers) (instrPast i)
+      jmpc short long (BC (e,s,_)) (BC (e',s',_)) = BC (length long+4,length code,return $ B.pack code)
+        where de = e'-e ; ds = s'-s
               code | de==0 = []
-                   | de > -128 && de<=128 = short++take 1 (bytes da)
-                   | otherwise = long++take 4 (bytes da)
+                   | de > -128 && de<=128 = short++take 1 (bytes ds)
+                   | otherwise = long++take 4 (bytes ds)
       jmp = jmpc [0xeb] [0xe9]
-      start i = BC (est,pos,undefined) where (est,pos,_) = brInfo i
+      start i = BC (est,pos,undefined) where (est,pos) = instrAddress i
 
   case alts of
     [def,null] -> do
-      (r,c) <- listen $ readFuture $ do
+      (r,c) <- censor (const mempty) $ listen $ readFuture $ do
         r <- lift $ gets (lookupArgReg v . registers)
         case mfilter (>=16) r of
           Just r -> return r
-          Nothing -> unReadFuture (loadArgs [(v,Nothing)]) >§ \[Left r] -> r
+          Nothing -> do
+            [Left r] <- unReadFuture (loadArgs [(v,Nothing)])
+            cmpri r r (withSize (0 :: Int))
+            return r
       [al,al'] <- mapM (listening . alignPast) [def,null]
-      let [_,_,p1,_,p2,_,p3] = scanl mappend (start instr) codes
+      let [_,_,p1,_,p2,_,p3] = scanl mappend (start thisInstr) codes
           (d1,jmp2) = if isEmptyCode al' then (start null,mempty) else (p2,jmp p3 (start null))
           codes = [c,jmpc cshort clong p1 d1,al,jmp p2 (start def),al',jmp2]
-          cshort = [0x70+testCode] ; clong = [0x0f,0x80+testCode] ; testCode = fi $ r-16
+          cshort = [0x70+testCode] ; clong = [0x0f,0x80+testCode]
+          testCode = oppFlags $ fi $ if r>=16 then r-16 else 0x4
       mapM_ tell codes
     [def] -> do
       al <- listening $ alignPast def
-      let [_,_,p] = scanl mappend (start instr) codes
+      let [_,_,p] = scanl mappend (start thisInstr) codes
           codes = [al,jmp p (start def)]
       mapM_ tell codes
     [] -> readFuture $ do
@@ -375,58 +427,67 @@
       unReadFuture $ alignWith (BM.filter isPresent fregs)
       tellCode [0xc3]
 
-compile' (Bind bv Nothing) = modifyF frameF (frameAlloc defSize bv)
-compile' (Bind bv _) = return ()
+compile' (Bind bv arg) = do
+  future $ modifyF fregistersF $ \rs -> foldr BM.delete rs (bindSyms bv)
+  when (isNothing arg) $ modifyF frameF (frameAlloc defSize bv)
+
 compile' Noop = withFuture (align . fregisters)
   where align regs = void $ withFreeSet $ loadArgs [(SymVal Value s,Just r) | (s,r) <- BM.toList regs]
 
 compileOp BCall d (fun:args) = withFreeSet $ do
-  (instr,brInfo) <- asks branchPos
-  (myID,addrs) <- asks envInfo
-  let (MemState regs subFrame,_) = defaults [BindVar id (sz,0) 0 []
-                                            | (id,arg) <- argAssocs
-                                            | sz <- map argSize args] undefined
+  let (MemState regs _ subFrame,_) = defaults [BindVar id (sz,0) 0 []
+                                              | (id,arg) <- argAssocs
+                                              | sz <- map argSize args] undefined
       argAssocs = zip (map ID [0..]) args
-      start = BC (est,pos,undefined) where (est,pos,_) = brInfo instr
+      storeBig top (id,arg) = case lookupAddr id subFrame of
+        Just addr -> case argVal arg of
+          Left s -> do
+            let loadAddr (r,n) = do a <- stackAddr defSize r ; ld rdi (rsp,fi a,defSize) ; return (rdi,n)
+            (base,n) <- maybe ((rsp,) $< stackAddr size s) loadAddr $ binding s
+            let addrs = [0,defSize..size]
+            sequence_ [ld rax (base,fi $ n+a,fi sz)
+                       >> st (rsp,fi $ frameToStack size (top+defSize+addr)+a,fi sz) rax
+                      | a <- addrs, let sz = min defSize (size-a)]
+            
+          Right v -> movi rdi v >> st (rsp,fi $ frameToStack defSize $ top+defSize+addr,defSize) rdi
+          where size = argSize arg
+        Nothing -> return ()
 
   modify (SB.delete rax)
-  (func:_,cload) <- listen $ loadArgs
-                    $ (fun,Nothing):[(arg,r) | (id,arg) <- argAssocs
-                                             , let r = BM.lookup id regs, isJust r]
-  readFuture $ do
-    (_,cstore) <- listen $ get >>= \free -> storeRegs (rax:SB.toList free)
+  let args' = [(arg,r :: Maybe Register) | (id,arg) <- argAssocs, let r = BM.lookup id regs, isJust r]
+  (func:_,cload) <- listen $ loadArgs $ (fun,Nothing):args'
 
+  readFuture $ do
+    put (SB.empty compare)
+    (_,cstore) <- listen $ storeRegs allocRegs
     top <- lift $ gets (frameTop . frame)
-    let storeBig (id,arg) = case lookupAddr id subFrame of
-          Just addr -> case argVal arg of
-            Left s -> do
-              let loadAddr (r,n) = do a <- frameAddr r ; ld r15 (rsp,fi a,defSize) ; return (r15,a)
-              (base,n) <- maybe ((rsp,) $< frameAddr s) loadAddr $ binding s
-              let addrs = [0,defSize..sz]
-                  sz = argSize arg
-              sequence_ [ld rax (base,fi$n+a,fi sz) >> st (rsp,fi $ top+defSize+addr+a,fi sz) rax
-                        | a <- addrs, let sz = min defSize (sz-a)]
-            Right v -> movi r15 v >> st (rsp,fi $ top+defSize+addr,defSize) rax
-          Nothing -> return ()
     (_,cstore') <- listen $ do
-      lift $ mapM_ storeBig argAssocs
-      subi rsp rsp $ withSize top
-    let pos = thisFunc >§ (+(instrPos+delta))
+      lift $ mapM_ (storeBig top) argAssocs
+      subri rsp rsp $ withSize top
+    let pos = verbAddress >§ (+(snd (instrAddress thisInstr)+delta))
         BC ~(_,delta,_) = cload <> cstore <> cstore'
-        (_,instrPos,_) = brInfo instr ; thisFunc = addrs myID
     (call <|||> calli pos) func
-    addi rsp rsp $ withSize top
+    addri rsp rsp $ withSize top
     lift $ associate rax (Just d)
 
-compileOp BSet d [s] = withFreeSet $ do
+compileOp b d [s] | b`elem`[BSet,BSetSX] && varSize d<=defSize = withFreeSet $ do
   [v] <- loadArgs [(s,Nothing)]
   readFuture $ do
     let dest r = maybe (destRegister d) (const $ return r) $ mfilter (not . isActive) $ argValSym s
     r' <- dest $ (id ||| const 0) v 
     (mov r' <|||> movi r') v
+    when (argSize s < varSize d) $ case b of
+      BSet -> zxtnd r' (argSize s)
+      BSetSX -> sxtnd r' (argSize s)
     lift $ associate r' (Just d)
+
 compileOp b d [a,a'] | b`elem`[BAdd,BSub,BMul,BAnd,BOr,BXor] = withFreeSet $ do
-  let ops = fromJust $ lookup b [(BAdd,adds),(BSub,subs),(BMul,muls),(BAnd,bwands),(BOr,bwors),(BXor,bwxors)]
+  let ops = fromJust $ lookup b [(BAdd,(addrr,addri,addir,(+)))
+                                ,(BSub,(subrr,subri,subir,(-)))
+                                ,(BMul,(mulrr,mulri,mulir,(*)))
+                                ,(BAnd,(bwandrr,bwandri,bwandir,(.&.)))
+                                ,(BOr,(bworrr,bworri,bworir,(.|.)))
+                                ,(BXor,(bwxorrr,bwxorri,bwxorir,xor))]
   [v,v'] <- loadArgs [(a,Nothing),(a',Nothing)]
   readFuture $ do
     dest <- destRegister d
@@ -434,12 +495,12 @@
     lift $ associate dest (Just d)
                         | b`elem`[BLowerThan,BLowerEq,BEqual,BNotEqual,BGreaterEq,BGreaterThan] = withFreeSet $ do
   let dest = 16 + fromJust (lookup b codes)
-      codes = [(BLowerThan,0xf),(BLowerEq,0xd),(BGreaterEq,0xc),(BGreaterThan,0xe),(BEqual,0x5),(BNotEqual,0x4)]
+      codes = [(BLowerThan,0xc),(BLowerEq,0xe),(BGreaterEq,0xf),(BGreaterThan,0xd),(BEqual,0x4),(BNotEqual,0x5)]
       applys = [(BLowerThan,(<)),(BLowerEq,(<=)),(BGreaterEq,(>=)),(BGreaterThan,(>)),(BEqual,(==)),(BNotEqual,(/=))]
       convert f n n' = if f n n' then 1 else 0
   [v,v'] <- loadArgs [(a,Nothing),(a',Nothing)]
   readFuture $ do
-    opsCode (cmps $ convert $ fromJust (lookup b applys)) dest v v'
+    opsCode (cmprr,cmpri,cmpir,convert $ fromJust (lookup b applys)) dest v v'
     lift $ associate dest (Just d)
                         | b`elem`[BMod,BDiv] = withFreeSet $ do
   [_,_,v] <- loadArgs [(a,Just rax),(IntVal 0,Just rdx),(a',Nothing)]