diff options
| -rw-r--r-- | AST.hs | 2 | ||||
| -rw-r--r-- | BuildIR.hs | 82 | ||||
| -rw-r--r-- | CodeGen.hs | 14 | ||||
| -rw-r--r-- | Intermediate.hs | 2 | ||||
| -rw-r--r-- | Main.hs | 2 | ||||
| -rw-r--r-- | Optimiser.hs | 21 | ||||
| -rw-r--r-- | Utils.hs | 4 | ||||
| -rw-r--r-- | opttest.lang | 8 | ||||
| -rw-r--r-- | struct.lang | 15 |
9 files changed, 100 insertions, 50 deletions
@@ -131,7 +131,7 @@ instance Pretty DVar where instance Pretty DFunc where prettyI i (DFunc mt n al b) = "func" ++ maybe "" ((' ' :) . prettyI i) mt ++ " " ++ n ++ "(" ++ - intercalate "," + intercalate ", " (map (\(at,an) -> prettyI i at ++ " " ++ an) al) ++ ") " ++ prettyI i b @@ -14,6 +14,7 @@ import Defs import Intermediate import Pretty import TypeRules +import Utils type Scope = Map.Map Name (Ref, Type) @@ -49,6 +50,15 @@ genTemp sz = liftM (Temp sz) genId genStructTemp :: Size -> BuildM Ref genStructTemp sz = liftM (StructTemp sz) genId +genTempForType :: Type -> BuildM Ref +genTempForType t@(TStruct _) = genStructTemp (sizeof t) +genTempForType t = genTemp (sizeof t) + +genTempLike :: Ref -> BuildM Ref +genTempLike (Temp sz _) = genTemp sz +genTempLike (StructTemp sz _) = genStructTemp sz +genTempLike _ = undefined + newBlock :: BuildM Id newBlock = do i <- genId @@ -125,7 +135,7 @@ internString :: String -> BuildM Ref internString str = do i <- genId let n = "__str_cnst_" ++ show i - ref <- genTemp (sizeof TInt) + ref <- genTempForType TInt addIns $ ILea ref n state $ \s -> (ref, s {internedStrings = internedStrings s ++ [(n, str)]}) @@ -180,7 +190,7 @@ convertStatement :: Statement -> Id -> BuildM () convertStatement (SDecl t n e) nextnext = do endid <- newBlockNoSwitch ref <- convertExpression e endid - varref <- genTemp (sizeof t) + varref <- genTempForType t scopeInsert n varref t switchBlock endid addIns $ IMov varref ref @@ -235,12 +245,12 @@ convertStatement SDebugger nextnext = do convertExpression :: Expression -> Id -> BuildM Ref convertExpression (ELit (LInt n) _) nextnext = do - ref <- genTemp (sizeof TInt) + ref <- genTempForType TInt addIns $ IMov ref (Constant (sizeof TInt) (fromInteger n)) setTerm $ IJmp nextnext return ref convertExpression (ELit (LChar c) _) nextnext = do - ref <- genTemp (sizeof TChar) + ref <- genTempForType TChar addIns $ IMov ref (Constant (sizeof TChar) (fromIntegral $ ord c)) setTerm $ IJmp nextnext return ref @@ -248,7 +258,7 @@ convertExpression (ELit (LVar n) _) nextnext = do mres <- findVar n case mres of Just (_, (r, t)) -> do - ref <- genTemp (sizeof t) + ref <- genTempForType t addIns $ IMov ref r setTerm $ IJmp nextnext return ref @@ -264,7 +274,7 @@ convertExpression (ELit (LCall n al) mrt) nextnext = do addIns $ ICall n refs return $ Temp 0 (-1) Just typ -> do - r <- genTemp (sizeof typ) + r <- genTempForType typ addIns $ ICallr r n refs return r setTerm $ IJmp nextnext @@ -283,7 +293,7 @@ convertExpression (ELit (LStruct ms) stype) nextnext = do setTerm $ IJmp nextnext return ref convertExpression (EBin BOAnd e1 e2 _) nextnext = do - destref <- genTemp (sizeof TInt) + destref <- genTempForType TInt bl2 <- newBlockNoSwitch blTryR <- newBlockNoSwitch bl3 <- newBlockNoSwitch @@ -317,7 +327,7 @@ convertExpression (EBin bo e1 e2 _) nextnext = do bl3 <- newBlockNoSwitch ref2 <- convertExpression e2 bl3 switchBlock bl3 - ref <- genTemp (sizeof $ fromJust $ retTypeBO bo (fromJust $ typeof e1) (fromJust $ typeof e2)) + ref <- genTempForType (fromJust $ retTypeBO bo (fromJust $ typeof e1) (fromJust $ typeof e2)) case bo of BOAdd -> addIns $ IAri AAdd ref ref1 ref2 BOSub -> addIns $ IAri ASub ref ref1 ref2 @@ -343,7 +353,7 @@ convertExpression (EUn UONot e mt) nextnext = convertExpression (EUn UONeg e mt) nextnext = convertExpression (EBin BOSub (ELit (LInt 0) (typeof e)) e mt) nextnext convertExpression (ESubscript arr sub t) nextnext = do - let elemsz = sizeof $ fromJust t + let elemtype = fromJust t bl2 <- newBlockNoSwitch arrref <- convertExpression arr bl2 switchBlock bl2 @@ -352,8 +362,8 @@ convertExpression (ESubscript arr sub t) nextnext = do switchBlock bl3 offref <- genTemp (refSize subref) elemptr <- genTemp (refSize arrref) - arrszptr <- genTemp (sizeof TInt) - arrsz <- genTemp (sizeof TInt) + arrszptr <- genTempForType TInt + arrsz <- genTempForType TInt errbl <- gets errorBlock @@ -363,21 +373,19 @@ convertExpression (ESubscript arr sub t) nextnext = do setTerm $ IJcc CUGeq subref arrsz errbl bl4 switchBlock bl4 - addIns $ IAri AMul offref subref (Constant (refSize subref) (fromIntegral elemsz)) + addIns $ IAri AMul offref subref (Constant (refSize subref) (fromIntegral $ sizeof elemtype)) addIns $ IAri AAdd elemptr arrref offref - ref <- genTemp elemsz + ref <- genTempForType elemtype addIns $ ILoad ref elemptr setTerm $ IJmp nextnext return ref convertExpression (EGet st n t) nextnext = do - let elemsz = sizeof $ fromJust t + let elemtype = fromJust t + assertM $ structMemberType (fromJust $ typeof st) n == elemtype bl2 <- newBlockNoSwitch stref <- convertExpression st bl2 switchBlock bl2 - let subtype = structMemberType (fromJust $ typeof st) n - eref <- case subtype of - TStruct _ -> genStructTemp elemsz - _ -> genTemp elemsz + eref <- genTempForType elemtype addIns $ IGet eref stref (offsetInStruct (fromJust $ typeof st) n) setTerm $ IJmp nextnext return eref @@ -391,7 +399,7 @@ convertExpression (ECast dt e) nextnext = do when (not $ isIntegralType typ && isIntegralType dt) $ error $ "convertExpression: unimplemented cast from " ++ pretty typ ++ " to " ++ pretty dt - ref <- genTemp (sizeof dt) + ref <- genTempForType dt bl <- newBlockNoSwitch eref <- convertExpression e bl switchBlock bl @@ -404,10 +412,10 @@ convertExpression (ENew t sze) nextnext = do bl2 <- newBlockNoSwitch szref <- convertExpression sze bl2 switchBlock bl2 - ref' <- genTemp (sizeof $ TArr t Nothing) - ref <- genTemp (sizeof $ TArr t Nothing) - argref' <- genTemp (sizeof TInt) - argref <- genTemp (sizeof TInt) + ref' <- genTempForType (TArr t Nothing) + ref <- genTempForType (TArr t Nothing) + argref' <- genTempForType TInt + argref <- genTempForType TInt addIns $ IAri AMul argref' szref (Constant (sizeof TInt) (fromIntegral $ sizeof t)) addIns $ IAri AAdd argref argref' (Constant (sizeof TInt) (fromIntegral $ sizeof TInt)) addIns $ ICallr ref' "_builtin_malloc" [argref] @@ -433,7 +441,7 @@ convertAsExpression topae@(AEGet _ _ _) valueref nextnext = do addIns $ ISet vref offset valueref aesubscript@(AESubscript _ _ _) -> do elemptr <- getAESubscriptStoreRef aesubscript - fieldptr <- genTemp (refSize elemptr) + fieldptr <- genTempLike elemptr addIns $ IAri AAdd fieldptr elemptr (Constant (refSize elemptr) (fromIntegral offset)) addIns $ IStore fieldptr valueref AEGet _ _ _ -> undefined @@ -461,10 +469,10 @@ getAESubscriptStoreRef (AESubscript ae2 expr mrt) = do bl2 <- newBlockNoSwitch subref <- convertExpression expr bl2 switchBlock bl2 - offref <- genTemp (sizeof TInt) - elemptr <- genTemp (sizeof TInt) - arrszptr <- genTemp (sizeof TInt) - arrsz <- genTemp (sizeof TInt) + offref <- genTempForType TInt + elemptr <- genTempForType TInt + arrszptr <- genTempForType TInt + arrsz <- genTempForType TInt errbl <- gets errorBlock @@ -486,19 +494,19 @@ getAESubscriptStoreRef (AESubscript ae2 expr mrt) = do Just (_, (r, t)) -> return (r, t) Nothing -> throwError $ "Undefined variable '" ++ n ++ "'" ++ " used in assignment expression" - ref <- genTemp (sizeof t) + ref <- genTempForType t addIns $ IMov ref vref return ref goLoad (AESubscript ae expr' _) = do - let elemsz = sizeof $ fromJust $ typeof ae + let elemtype = fromJust $ typeof ae ref <- goLoad ae bl2 <- newBlockNoSwitch eref <- convertExpression expr' bl2 switchBlock bl2 - offref <- genTemp (sizeof TInt) - elemptr <- genTemp (sizeof TInt) - arrszptr <- genTemp (sizeof TInt) - arrsz <- genTemp (sizeof TInt) + offref <- genTempForType TInt + elemptr <- genTempForType TInt + arrszptr <- genTempForType TInt + arrsz <- genTempForType TInt errbl <- gets errorBlock @@ -508,15 +516,15 @@ getAESubscriptStoreRef (AESubscript ae2 expr mrt) = do setTerm $ IJcc CUGeq eref arrsz errbl bl3 switchBlock bl3 - addIns $ IAri AMul offref eref (Constant (sizeof TInt) (fromIntegral elemsz)) + addIns $ IAri AMul offref eref (Constant (sizeof TInt) (fromIntegral $ sizeof elemtype)) addIns $ IAri AAdd elemptr ref offref - dstref <- genTemp elemsz + dstref <- genTempForType elemtype addIns $ ILoad dstref elemptr return dstref goLoad topae@(AEGet topup _ _) = do let (core, _, offset) = collectAESets topae coreref <- goLoad core - ref <- genTemp (sizeof $ fromJust $ typeof topup) + ref <- genTempForType (fromJust $ typeof topup) addIns $ IGet ref coreref offset return ref getAESubscriptStoreRef _ = undefined @@ -255,8 +255,7 @@ codegenIns :: AllocMap -> IRIns -> CGMonad () codegenIns m (IMov d s) | dm == sm = return () | X64.isXMem dm && X64.isXMem sm = do - addIns $ mkmov (XReg (fromIntegral $ refSize s) RAX) sm - addIns $ mkmov dm (XReg (fromIntegral $ refSize d) RAX) + emitmemcpy dm sm | otherwise = addIns $ mkmov dm sm where dm = mkxref d m sm = mkxref s m @@ -320,9 +319,17 @@ codegenIns m (IGet d s off) codegenIns m (IAri AMul d s1 s2) | X64.isXImm s1m && X64.isXImm s2m = undefined | X64.isXImm s1m = codegenIns m (IAri AMul d s2 s1) + | dm == s2m = + if dm == s1m + then if X64.isXMem dm + then do + addIns $ mkmov (XReg sz RAX) dm + addIns $ IMUL (xref $ XReg sz RAX) (xref $ XReg sz RAX) + addIns $ mkmov dm (XReg sz RAX) + else addIns $ IMUL (xref dm) (xref dm) + else codegenIns m (IAri AMul d s2 s1) | otherwise = do -- regmem dm, regmem s1m, regmemimm s2m - let sz = fromIntegral $ refSize d if X64.isXImm s2m then if X64.isXMem dm then do -- mem dm, regmem s1m, imm s2m @@ -344,6 +351,7 @@ codegenIns m (IAri AMul d s1 s2) where dm = mkxref d m s1m = mkxref s1 m s2m = mkxref s2 m + sz = fromIntegral $ refSize d codegenIns m (IAri ADiv d s1 s2) = do let sz = fromIntegral $ refSize d addIns $ XOR (xref $ XReg 4 RDX) (xref $ XReg 4 RDX) diff --git a/Intermediate.hs b/Intermediate.hs index dde941d..d6ad1cd 100644 --- a/Intermediate.hs +++ b/Intermediate.hs @@ -92,7 +92,7 @@ instance Pretty IRProgram where instance Pretty IRFunc where prettyI i (IRFunc mt n al bbs sid) = "irfunc" ++ maybe "" ((' ' :) . prettyI i) mt ++ " " ++ n ++ "(" ++ - intercalate "," + intercalate ", " (map (\(at,an) -> prettyI i at ++ " " ++ an) al) ++ ")\n" ++ indent i ++ intercalate ("\n" ++ indent i) (map (prettyI i) sorted) @@ -32,7 +32,7 @@ performCompile :: String -> IO () performCompile source = do let eres = return source >>= parseProgram <?> "Parse error" - >>= return . tracePrettyId + -- >>= return . tracePrettyId >>= typeCheck <?> "Type error" >>= buildIR <?> "IR building error" >>= optimise <?> "Error while optimising" diff --git a/Optimiser.hs b/Optimiser.hs index 408bd24..f94441c 100644 --- a/Optimiser.hs +++ b/Optimiser.hs @@ -28,6 +28,12 @@ optimise prog = fst $ fromJust $ find (uncurry (==)) $ zip passreslist (tail passreslist) else return $ reslist !! 5 where + -- optimisations = map funcopt + -- [chainJumps, removeUnusedBlocks] + -- optimisations = map funcopt + -- [chainJumps, mergeTerminators, looseJumps, + -- removeUnusedBlocks, + -- constantPropagate, movPush] optimisations = map funcopt [chainJumps, mergeTerminators, looseJumps, removeUnusedBlocks, removeDuplicateBlocks, @@ -150,16 +156,20 @@ constantPropagate :: FuncOptimisation constantPropagate (IRFunc rt name al bbs sid) = IRFunc rt name al bbs' sid where alltemps = findAllTempsBBList bbs + alltempsmuts = Map.fromList $ map (\ref -> (ref, findMutations' bbs ref)) alltemps consttemps = catMaybes $ flip map alltemps $ \ref -> - let locs = findMutations' bbs ref + let locs = fromJust $ Map.lookup ref alltempsmuts loc = head locs ins = insAt bbs loc + usedrefs = findAllRefsIns ins readlocs = findMentions' bbs ref \\ locs readinss = map (insAt' bbs) readlocs allimov = all (maybe False isIMov) readinss - in if length locs == 1 && (isIMov ins || ((isILoad ins || isIAri ins || isIResize ins) && allimov)) - then Just (loc, ins) - else Nothing + in if length locs == 1 && -- check necessary because it shouldn't be 0 + all (maybe True ((<=1) . length) . flip Map.lookup alltempsmuts) usedrefs && + (isIMov ins || ((isILoad ins || isIAri ins || isIResize ins) && allimov)) + then Just (loc, ins) + else Nothing bbs' = case consttemps of [] -> bbs @@ -416,7 +426,7 @@ removeUnusedInstructions (IRFunc rt name al bbs sid) = IRFunc rt name al (map go goI ins@(IGet d _ _) = pureInstruction d ins goI ins@(IAri _ d _ _) = pureInstruction d ins goI ins@(ICall _ _) = Just ins - goI ins@(ICallr _ _ _) = Just ins + goI ins@(ICallr d f a) = if length (findMentions' bbs d) == 1 then Just (ICall f a) else Just ins goI ins@(IResize d _) = pureInstruction d ins goI IDebugger = Just IDebugger goI INop = Nothing @@ -537,6 +547,7 @@ findMutations (BB _ inss _) ref = catMaybes $ flip map (zip inss [0..]) $ \(ins, idx) -> case ins of (IMov r _) | r == ref -> Just idx (ILoad r _) | r == ref -> Just idx + (ISet r _ _) | r == ref -> Just idx (IAri _ r _ _) | r == ref -> Just idx (ICallr r _ _) | r == ref -> Just idx (IResize r _) | r == ref -> Just idx @@ -14,3 +14,7 @@ contains l v = isJust $ find (== v) l roundUp :: Integral a => a -> a -> a roundUp n sz = (n + sz - 1) `div` sz * sz + +assertM :: Monad m => Bool -> m () +assertM True = return () +assertM False = error "assertM failed" diff --git a/opttest.lang b/opttest.lang new file mode 100644 index 0000000..9f87e78 --- /dev/null +++ b/opttest.lang @@ -0,0 +1,8 @@ +func int main() { + int a := 1; + int b := 2; + int x := a + b; + b = 100; + putint(x); putc('\n'); + return 0; +} diff --git a/struct.lang b/struct.lang index 4f89e52..00b3442 100644 --- a/struct.lang +++ b/struct.lang @@ -11,7 +11,7 @@ func f(int iets1, S s, int iets2) { } func int main() { - global.x = 3 * global.x + int(global.y); + /*global.x = 3 * global.x + int(global.y); putint(global.x + 1); putc(global.y); putc('\n'); int a := getc(); int b := getc(); @@ -19,5 +19,16 @@ func int main() { S ding := {x = 2*a, y = 'a'}; // return ding.x; f(123, ding, 456); - return int(ding.y) + a + b; + S ding2 := ding; + ding2.x = ding2.x; + // ding2.y = ding2.y; + f(234, ding2, 567); + return int(ding.y) + a + b;*/ + + int a := getc(); + getc(); // newline + S ding := {x = 2*a, y = 'a'}; + S ding2 := ding; + f(123, ding2, 456); + return 0; } |