From 19260ae02f1447ccd382b5c278cc5d1f22d004b3 Mon Sep 17 00:00:00 2001 From: Tom Smeding Date: Tue, 23 Apr 2019 23:31:19 +0200 Subject: Possibly working lowering to isa-with-infinite-regs --- Compiler.hs | 1 + Intermediate.hs | 3 +++ Lower.hs | 62 +++++++++++++++++++++++++++++++++++++++++++++++---------- VM.hs | 1 + 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 -- cgit v1.2.3-54-g00ecf