From 19260ae02f1447ccd382b5c278cc5d1f22d004b3 Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom.smeding@gmail.com>
Date: Tue, 23 Apr 2019 23:31:19 +0200
Subject: Possibly working lowering to isa-with-infinite-regs

---
 Lower.hs | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 51 insertions(+), 11 deletions(-)

(limited to 'Lower.hs')

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"
-- 
cgit v1.2.3-54-g00ecf