Possibly working lowering to isa-with-infinite-regs

4 files changed, 56 insertions, 11 deletions

diff --git a/Compiler.hs b/Compiler.hs
index 8c32236..d190565 100644
--- a/Compiler.hs
+++ b/Compiler.hs
@@ -242,6 +242,7 @@ genTValue (TVLambda args body closure) nextnext = do
         withScope (Map.fromList (zip args (map SIParam [0..]) ++ zip closure (map SIClosure [0..]))) $ do
             b <- newBlockSwitch
             b2 <- newBlock
+            addIns (RNone, IFunctionEntry)
             ref <- genTValue body b2
             switchBlock b2
             setTerm $ IRet ref
diff --git a/Intermediate.hs b/Intermediate.hs
index 8c07980..2729493 100644
--- a/Intermediate.hs
+++ b/Intermediate.hs
@@ -44,6 +44,8 @@ data InsCode
     | IAllocClo Name [Ref]
     -- | Do nothing?
     | IDiscard Ref
+    -- | Do stuff on function entry
+    | IFunctionEntry
   deriving Eq
 
 data Terminator
@@ -95,6 +97,7 @@ instance Show InsCode where
     show (ICallC r as) = "callc " ++ show r ++ " " ++ show as
     show (IAllocClo name vs) = "alloc-closure \"" ++ name ++ "\" " ++ show vs
     show (IDiscard r) = "discard " ++ show r
+    show IFunctionEntry = "function-entry"
 
 instance Show Terminator where
     show (IBr r b1 b2) = "br " ++ show r ++ " " ++ show b1 ++ " " ++ show b2
diff --git a/Lower.hs b/Lower.hs
index 34b5285..57ac9ca 100644
--- a/Lower.hs
+++ b/Lower.hs
@@ -23,11 +23,6 @@ data AsmInstr'
     -- Load/Store: 'Int' is number of BYTES.
     | Load Int ARef ARef
     | Store Int ARef ARef
-    -- Allocate n r: Allocate n bytes of memory, pointer in r
-    | Alloc Int ARef
-    -- Memcpy d s n: Copy n bytes from s to d
-    | Memcpy ARef ARef ARef
-    | SysExit
   deriving (Show)
 
 data ARef
@@ -73,6 +68,7 @@ initState (IRProgram bbs _ _) = LowerState (maxTemp + 1)
         ICallC r rs    -> max (maxTempR r) (maximum (map maxTempR rs))
         IAllocClo _ rs -> maximum (map maxTempR rs)
         IDiscard r     -> maxTempR r
+        IFunctionEntry -> 0
     maxTempT term = case term of
         IBr r _ _ -> maxTempR r
         IJmp _    -> 0
@@ -155,22 +151,50 @@ lowerIns (dest, instruction) gfds = case instruction of
                         | otherwise -> do
         (inss1, closurer) <- toARef closure
         (inss2, argrs) <- toARefs args
+
         eightr <- genTemp
+        twentyfourr <- genTemp
         numitemsr <- genTemp
         numbytesr <- genTemp
+        closurebufr <- genTemp
         stackshiftr <- genTemp
         walkr <- genTemp
         funptrr <- genTemp
+
+        -- mov qword rcx, [closurer + 8]
+        -- shl rcx, 3
+        -- sub rsp, rcx
+        -- lea rsi, [closurer + 16]
+        -- mov rdi, rsp
+        -- rep movsq
+        -- push argN
+        -- ...
+        -- push arg1
+        -- call [closurer]
+        -- add rsp, (8 * N)
+        -- add rsp, rcx
+        -- mov dest, rax
+
         return $
             inss1 ++ inss2 ++
             [Li eightr 8
-            -- Copy the closure parameters
+            -- Copy the closure parameters: first make space
             ,Arith Add walkr closurer eightr
             ,Load 8 numitemsr walkr
             ,Arith Add walkr walkr eightr
             ,Arith Mul numbytesr numitemsr eightr
             ,Arith Sub (ASysReg 15) (ASysReg 15) numbytesr
-            ,Memcpy (ASysReg 15) walkr numbytesr] ++
+            ,Mv closurebufr (ASysReg 15)] ++
+            -- Now do the copy by calling out to an intrinsic function ._.
+            [Arith Sub (ASysReg 15) (ASysReg 15) eightr
+            ,Store 8 (ASysReg 15) numbytesr
+            ,Arith Sub (ASysReg 15) (ASysReg 15) eightr
+            ,Store 8 (ASysReg 15) walkr
+            ,Arith Sub (ASysReg 15) (ASysReg 15) eightr
+            ,Store 8 (ASysReg 15) closurebufr
+            ,Jcc CCNZ (ASysReg 0) (Label "__builtin_memcpy")
+            ,Li twentyfourr 24
+            ,Arith Add (ASysReg 15) (ASysReg 15) twentyfourr] ++
             -- Copy the function parameters
             concat [[Arith Sub (ASysReg 15) (ASysReg 15) eightr
                     ,Store 8 (ASysReg 15) ref]
@@ -197,19 +221,35 @@ lowerIns (dest, instruction) gfds = case instruction of
                     itemr <- genTemp
                     numitemsr <- genTemp
                     eightr <- genTemp
+                    allocsizer <- genTemp
                     (inss, refs') <- toARefs refs
                     return $
                         inss ++
-                        [Alloc (16 + 8 * length refs) destr
+                        [Li eightr 8
+                        -- First call malloc to obtain an allocation
+                        ,Arith Sub (ASysReg 15) (ASysReg 15) eightr
+                        ,Li allocsizer (16 + 8 * length refs)
+                        ,Store 8 (ASysReg 15) allocsizer
+                        ,Jcc CCNZ (ASysReg 0) (Label "__builtin_malloc")
+                        ,Mv destr (ASysReg 13)
+                        -- Then put the right data in the closure allocation
                         ,Store 8 destr (ALabel ("BB" ++ show initBId))
-                        ,Li eightr 8
                         ,Arith Add itemr destr eightr
                         ,Li numitemsr (length refs')
                         ,Store 8 itemr numitemsr] ++
                         concat [[Arith Add itemr itemr eightr, Store 8 itemr ref]
                                | ref <- refs']
 
-    IDiscard _  -> return []
+    IDiscard _  ->
+        return []
+
+    IFunctionEntry -> do
+        -- We need to push the link register
+        eightr <- genTemp
+        return
+            [Li eightr 8
+            ,Arith Sub (ASysReg 15) (ASysReg 15) eightr
+            ,Store 8 (ASysReg 15) (ASysReg 14)]
 
 lowerTerm :: Terminator -> LM [AsmInstr']
 lowerTerm terminator = case terminator of
@@ -236,7 +276,7 @@ lowerTerm terminator = case terminator of
             ,JccR CCNZ (ASysReg 0) ptrr]
 
     IExit ->
-        return [SysExit]
+        return [Jcc CCNZ (ASysReg 0) (Label "__builtin_exit")]
 
     IUnknown ->
         error "Unexpected IUnknown"
diff --git a/VM.hs b/VM.hs
index 4b0a1e0..dfa4c74 100644
--- a/VM.hs
+++ b/VM.hs
@@ -77,6 +77,7 @@ vmRunInstr info@(Info bbmap gfds datas) state@(State tmap (args, closure)) (dest
             obj -> error $ "VM: Cannot call non-closure object: " ++ show obj
     IAllocClo name clrefs -> return (assignRef state dest (RVClosure name (map (findRef tmap) clrefs)))
     IDiscard _ -> return state
+    IFunctionEntry -> return state
 
 vmRunTerm :: Info -> State -> Terminator -> IO (RunValue, State)
 vmRunTerm info@(Info bbmap _ _) state@(State tmap _) term = case term of