diff options
| -rw-r--r-- | AST.hs | 6 | ||||
| -rw-r--r-- | BuildIR.hs | 27 | ||||
| -rw-r--r-- | CodeGen.hs | 13 | ||||
| -rw-r--r-- | Intermediate.hs | 2 | ||||
| -rw-r--r-- | Main.hs | 2 | ||||
| -rw-r--r-- | Optimiser.hs | 8 | ||||
| -rw-r--r-- | ProgramParser.hs | 19 | ||||
| -rw-r--r-- | ReplaceRefs.hs | 1 | ||||
| -rw-r--r-- | TypeCheck.hs | 6 | ||||
| -rw-r--r-- | X64.hs | 7 | ||||
| -rw-r--r-- | bf.lang | 1 | ||||
| -rw-r--r-- | primes.bf | 194 |
12 files changed, 273 insertions, 13 deletions
@@ -63,6 +63,7 @@ data Literal | LChar Char | LVar Name | LCall Name [Expression] + | LStr String deriving (Show, Eq) @@ -74,8 +75,8 @@ sizeof (TArr _ _) = 8 instance Pretty Program where prettyI i (Program vars funcs) = - concatMap (++ ("\n" ++ indent i)) $ - map (prettyI i) vars ++ map (prettyI i) funcs + intercalate ("\n" ++ indent i) (map (prettyI i) vars ++ map (prettyI i) funcs) + ++ "\n" where indent n = replicate (2*n) ' ' @@ -182,3 +183,4 @@ instance Pretty Literal where prettyI _ (LVar n) = n prettyI i (LCall n al) = n ++ "(" ++ intercalate ", " (map (prettyI i) al) ++ ")" + prettyI _ (LStr s) = show s @@ -24,7 +24,8 @@ data BuildState = BuildState loopStack :: [Id], currentBlock :: Id, errorBlock :: Id, - blockMap :: Map.Map Id BB } + blockMap :: Map.Map Id BB, + internedStrings :: [(Name, String)] } initBuildState :: BuildState initBuildState = BuildState @@ -33,7 +34,8 @@ initBuildState = BuildState loopStack = [], currentBlock = undefined, errorBlock = undefined, - blockMap = Map.empty } + blockMap = Map.empty, + internedStrings = [] } newtype BuildM a = BuildM {unBuildM :: StateT BuildState (Except String) a} deriving (Functor, Applicative, Monad, MonadState BuildState, MonadError String) @@ -116,6 +118,14 @@ findVar n = do return $ fmap (\idx -> (idx, fromJust (results !! idx))) $ findIndex isJust results +internString :: String -> BuildM Ref +internString str = do + i <- genId + let n = "__str_cnst_" ++ show i + ref <- genTemp (sizeof TInt) + addIns $ ILea ref n + state $ \s -> (ref, s {internedStrings = internedStrings s ++ [(n, str)]}) + buildIR :: Program -> Error IRProgram buildIR (Program vars funcs) = @@ -123,7 +133,7 @@ buildIR (Program vars funcs) = where goDFunc :: DFunc -> BuildM IRFunc goDFunc (DFunc rt n al bl) = do - clearBlockMap + clearBlockMap firstid <- newBlock lastid <- newBlockNoSwitch makeErrorBlock >>= setErrorBlock @@ -147,7 +157,12 @@ buildIR (Program vars funcs) = result = do withScope $ do mapM_ (\(DVar t n _) -> scopeInsert n (Global (sizeof t) n) t) vars - IRProgram vars <$> mapM goDFunc funcs + funcs' <- mapM goDFunc funcs + ns <- gets internedStrings + let strvars = flip map ns $ \(n, str) -> + let t = TArr TChar (Just $ fromIntegral $ length str) + in DVar t n (ELit (LStr str) (Just t)) + return $ IRProgram (vars ++ strvars) funcs' convertBlock :: Block -> Id -> BuildM () convertBlock (Block sts) nextnext = do @@ -250,6 +265,10 @@ convertExpression (ELit (LCall n al) mrt) nextnext = do return r setTerm $ IJmp nextnext return destref +convertExpression (ELit (LStr s) _) nextnext = do + ref <- internString s + setTerm $ IJmp nextnext + return ref convertExpression (EBin BOAnd e1 e2 _) nextnext = do destref <- genTemp (sizeof TInt) bl2 <- newBlockNoSwitch @@ -5,6 +5,7 @@ module CodeGen(codegen) where import Control.Monad import Control.Monad.Except import Control.Monad.State.Strict +import Data.Char import Data.List import Data.Maybe import Data.Map.Strict ((!)) @@ -73,6 +74,10 @@ codegen (IRProgram vars funcs) = do codegenVar :: DVar -> Error String codegenVar (DVar TInt n (ELit (LInt i) (Just TInt))) = Right $ n ++ ": dq " ++ show i +codegenVar (DVar (TArr TChar _) n (ELit (LStr s) _)) = Right $ + n ++ ":\n" ++ + "\tdq " ++ show (length s + 1) ++ "\n" ++ + "\tdb " ++ (intercalate ", " $ map show $ map ord s ++ [0]) codegenVar _ = Left "Unsupported global variable declaration" @@ -196,6 +201,13 @@ codegenIns m (IMov d s) | otherwise = addIns $ mkmov dm sm where dm = mkxref d m sm = mkxref s m +codegenIns m (ILea d n) + | X64.isXMem dm = do + addIns $ LEA (xref $ XReg (fromIntegral $ refSize d) RAX) (xref sm) + addIns $ mkmov dm (XReg (fromIntegral $ refSize d) RAX) + | otherwise = addIns $ LEA (xref dm) (xref sm) + where dm = mkxref d m + sm = mkxref (Global 8 n) m codegenIns m (IStore d s) = do sourcexref <- if X64.isXMem sm then do @@ -394,6 +406,7 @@ collectTempRefs bbs = where listRefsIns :: IRIns -> [[LA.Access Ref]] listRefsIns (IMov a b) = [[LA.Read b], [LA.Write a]] + listRefsIns (ILea a _) = [[LA.Write a]] listRefsIns (IStore a b) = [[LA.Read a, LA.Read b]] listRefsIns (ILoad a b) = [[LA.Read b], [LA.Write a]] listRefsIns (IAri at a b c) diff --git a/Intermediate.hs b/Intermediate.hs index 6cbccda..d2ac549 100644 --- a/Intermediate.hs +++ b/Intermediate.hs @@ -23,6 +23,7 @@ data IRFunc = IRFunc (Maybe Type) Name [(Type, Name)] [BB] Id data IRIns = IMov Ref Ref + | ILea Ref Name | IStore Ref Ref | ILoad Ref Ref | IAri ArithType Ref Ref Ref -- destination, operand 1, operand 2 @@ -99,6 +100,7 @@ instance Pretty IRFunc where instance Pretty IRIns where prettyI _ (IMov d s) = "mov " ++ pretty d ++ " <- " ++ pretty s + prettyI _ (ILea d s) = "lea " ++ pretty d ++ " <- &[" ++ s ++ "]" prettyI _ (IStore d s) = "store *" ++ pretty d ++ " <- " ++ pretty s prettyI _ (ILoad d s) = "load " ++ pretty d ++ " <- *" ++ pretty s prettyI _ (IAri at d s1 s2) = @@ -8,6 +8,7 @@ import Debug.Trace import BuildIR import CodeGen import Defs +import InternStrings import Optimiser import Pretty import ProgramParser @@ -33,6 +34,7 @@ performCompile source = do let eres = return source >>= parseProgram <?> "Parse error" >>= typeCheck <?> "Type error" + -- >>= internStrings <?> "Error interning strings" >>= buildIR <?> "IR building error" >>= optimise <?> "Error while optimising" >>= return . traceShowId diff --git a/Optimiser.hs b/Optimiser.hs index 531bc7d..cea0601 100644 --- a/Optimiser.hs +++ b/Optimiser.hs @@ -203,6 +203,9 @@ movPush (IRFunc rt name al bbs sid) = IRFunc rt name al (map goBB bbs) sid | d' == d = if d' == s' then push mov rest term else push (d', s') rest term | d' == s = IMov d s : push (d', replaceRef d s s') rest term | otherwise = IMov d' (replaceRef d s s') : push mov rest term + push mov@(d, _) (ILea d' n : rest) term + | d' == d = ILea d' n : go rest term + | otherwise = ILea d' n : push mov rest term push mov@(d, s) (IResize d' s' : rest) term | d' == d = IResize d' (replaceRef d s s') : go rest term | d' == s = IMov d s : IResize d' (replaceRef d s s') : go rest term @@ -306,6 +309,9 @@ arithPush (IRFunc rt name al allbbs sid) = IRFunc rt name al resbbs sid propagate ari@(_, d, s1, s2) (Left ins@(IResize md _) : rest) | d /= md && md /= s1 && md /= s2 = fmap (Left ins :) $ propagate ari rest | otherwise = (False, Left ins : rest) + propagate ari@(_, d, s1, s2) (Left ins@(ILea md _) : rest) + | d /= md && md /= s1 && md /= s2 = fmap (Left ins :) $ propagate ari rest + | otherwise = (False, Left ins : rest) propagate ari (Left INop : rest) = propagate ari rest propagate (at, d, s1, s2) (Right term@(IJcc ct r1 r2 i1 i2) : rest) | (r1 == d || r2 == d) && @@ -389,6 +395,7 @@ removeUnusedInstructions (IRFunc rt name al bbs sid) = IRFunc rt name al (map go goI :: IRIns -> Maybe IRIns goI ins@(IMov d _) = pureInstruction d ins + goI ins@(ILea d _) = pureInstruction d ins goI ins@(IStore _ _) = Just ins goI ins@(ILoad d _) = pureInstruction d ins goI ins@(IAri _ d _ _) = pureInstruction d ins @@ -560,6 +567,7 @@ findAllRefsInss inss = uniq $ sort $ concatMap findAllRefsIns inss findAllRefsIns :: IRIns -> [Ref] findAllRefsIns (IMov a b) = [a, b] +findAllRefsIns (ILea a _) = [a] findAllRefsIns (IStore a b) = [a, b] findAllRefsIns (ILoad a b) = [a, b] findAllRefsIns (IAri _ a b c) = [a, b, c] diff --git a/ProgramParser.hs b/ProgramParser.hs index 34b5ce7..a71d07e 100644 --- a/ProgramParser.hs +++ b/ProgramParser.hs @@ -204,30 +204,39 @@ pENew = do return $ ENew t e pLiteral :: Parser Literal -pLiteral = (LInt <$> pInteger) <|> (LChar <$> pCharLit) <|> pLCall <|> (LVar <$> pName) +pLiteral = + (LInt <$> pInteger) <|> (LChar <$> pCharLit) <|> (LStr <$> pString) <|> + pLCall <|> (LVar <$> pName) pCharLit :: Parser Char pCharLit = do void $ char '\'' - c <- pStringChar + c <- pStringChar (const False) void $ char '\'' pWhiteComment return c -pStringChar :: Parser Char -pStringChar = +pStringChar :: (Char -> Bool) -> Parser Char +pStringChar avoid = (char '\\' >> ((char 'n' >> return '\n') <|> (char 'r' >> return '\r') <|> (char 't' >> return '\t') <|> (char '0' >> return '\0') <|> (char 'x' >> pHexDigit >>= \a -> pHexDigit >>= \b -> return (chr $ 16 * a + b)))) <|> - anyToken + satisfy (not . avoid) where pHexDigit :: Parser Int pHexDigit = (subtract 48 . fromEnum <$> digit) <|> ((+ (10 - 97)) . ord <$> oneOf "abcdef") <|> ((+ (10 - 65)) . ord <$> oneOf "ABCDEF") +pString :: Parser String +pString = do + void $ char '"' + s <- many (pStringChar (== '"')) + void $ char '"' + return s + pLCall :: Parser Literal pLCall = do n <- try $ pName <* symbol "(" diff --git a/ReplaceRefs.hs b/ReplaceRefs.hs index f9490ef..6e10c90 100644 --- a/ReplaceRefs.hs +++ b/ReplaceRefs.hs @@ -10,6 +10,7 @@ replaceRef = trans replaceRefsIns :: Ref -> Ref -> IRIns -> IRIns replaceRefsIns from to (IMov a b) = IMov (trans from to a) (trans from to b) +replaceRefsIns from to (ILea a n) = ILea (trans from to a) n replaceRefsIns from to (IStore a b) = IStore (trans from to a) (trans from to b) replaceRefsIns from to (ILoad a b) = ILoad (trans from to a) (trans from to b) replaceRefsIns from to (IAri at a b c) = IAri at (trans from to a) (trans from to b) (trans from to c) diff --git a/TypeCheck.hs b/TypeCheck.hs index 66affa4..922731d 100644 --- a/TypeCheck.hs +++ b/TypeCheck.hs @@ -191,15 +191,17 @@ annotateExpr db (ELit (LCall n as) _) = do when (length as' /= length ats) $ Left $ "Function '" ++ n ++ "' expected " ++ show (length ats) ++ " arguments but got " ++ show (length as') - forM_ (zip as' ats) $ \(arg, at) -> do + forM_ (zip3 as' ats [1 :: Int ..]) $ \(arg, at, num) -> do when (isNothing (typeof arg)) $ Left "Use of void value in function argument" if canCoerce (fromJust $ typeof arg) at then return () - else Left $ "Argument of " ++ n ++ " has type " ++ pretty at ++ + else Left $ "Argument " ++ show num ++ " of " ++ n ++ " has type " ++ pretty at ++ " but value of type " ++ pretty (fromJust $ typeof arg) ++ " was given" return $ ELit (LCall n as') mrt +annotateExpr _ (ELit lit@(LStr s) _) = + return $ ELit lit (Just $ TArr TChar (Just $ fromIntegral $ length s)) annotateExpr db (ESubscript arr sub _) = do arr' <- annotateExpr db arr sub' <- annotateExpr db sub @@ -30,6 +30,7 @@ data CondCode = CCA | CCAE | CCB | CCBE | CCC | CCE | CCG | CCGE | CCL | CCLE | data Ins = MOV RegMem RegMemImm | MOVi Reg Imm + | LEA Reg Mem | MOVSX Reg RegMem | ADD RegMem RegMemImm | SUB RegMem RegMemImm @@ -84,6 +85,7 @@ verify (Asm funcs) = mapM_ (\(_, inss) -> mapM_ goI inss) funcs goI :: Ins -> Either String () goI (MOV (RegMem a) (RegMemImm b)) = ckRegMem a >> ckRegMemImm b >> ck2mem a b >> ckSizes a b goI (MOVi (Reg a) (Imm b)) = ckReg a >> ckImm b >> ckSizes64 a b + goI (LEA (Reg a) (Mem b)) = ckReg a >> ckMem b >> ckSizes a b goI (MOVSX (Reg a) (RegMem b)) = ckReg a >> ckRegMem b >> ckMovsx a b goI (ADD (RegMem a) (RegMemImm b)) = ckRegMem a >> ckRegMemImm b >> ck2mem a b >> ckSizes a b goI (SUB (RegMem a) (RegMemImm b)) = ckRegMem a >> ckRegMemImm b >> ck2mem a b >> ckSizes a b @@ -110,6 +112,9 @@ verify (Asm funcs) = mapM_ (\(_, inss) -> mapM_ goI inss) funcs ckReg (XReg _ _) = return () ckReg _ = Left "Argument is not a Reg" + ckMem (XMem _ _ _ _ _) = return () + ckMem _ = Left "Argument is not a Mem" + ckImm (XImm _) = return () ckImm _ = Left "Argument is not an Imm" @@ -230,6 +235,7 @@ instance Stringifiable CondCode where instance Stringifiable Ins where stringify (MOV a b) = "mov " ++ stringify a ++ ", " ++ stringify b stringify (MOVi a b) = "mov " ++ stringify a ++ ", " ++ stringify b + stringify (LEA a b) = "lea " ++ stringify a ++ ", " ++ stringify b stringify (MOVSX a b@(RegMem bx)) = case compare (xrefGetSize bx) 4 of EQ -> "movsxd " ++ stringify a ++ ", " ++ stringify b LT -> "movsx " ++ stringify a ++ ", " ++ stringify b @@ -287,6 +293,7 @@ isXImm _ = False xrefMapM :: Monad m => (XRef -> m XRef) -> Ins -> m Ins xrefMapM f (MOV (RegMem x) (RegMemImm y)) = MOV <$> (RegMem <$> f x) <*> (RegMemImm <$> f y) xrefMapM f (MOVi (Reg x) (Imm y)) = MOVi <$> (Reg <$> f x) <*> (Imm <$> f y) +xrefMapM f (LEA (Reg x) (Mem y)) = LEA <$> (Reg <$> f x) <*> (Mem <$> f y) xrefMapM f (MOVSX (Reg x) (RegMem y)) = MOVSX <$> (Reg <$> f x) <*> (RegMem <$> f y) xrefMapM f (ADD (RegMem x) (RegMemImm y)) = ADD <$> (RegMem <$> f x) <*> (RegMemImm <$> f y) xrefMapM f (SUB (RegMem x) (RegMemImm y)) = SUB <$> (RegMem <$> f x) <*> (RegMemImm <$> f y) @@ -36,6 +36,7 @@ func int[] makejumpmap(char[] src, int srclen) { i = i + 1; } if (stkp != 0) { + putstr("Unmatched opening brackets in BF source\n"); exit(1); } /*i = 0; diff --git a/primes.bf b/primes.bf new file mode 100644 index 0000000..f492705 --- /dev/null +++ b/primes.bf @@ -0,0 +1,194 @@ +compute prime numbers +to use type the max number then push Alt 1 0 +=================================================================== +======================== OUTPUT STRING ============================ +=================================================================== +>++++++++[<++++++++>-]<++++++++++++++++.[-] +>++++++++++[<++++++++++>-]<++++++++++++++.[-] +>++++++++++[<++++++++++>-]<+++++.[-] +>++++++++++[<++++++++++>-]<+++++++++.[-] +>++++++++++[<++++++++++>-]<+.[-] +>++++++++++[<++++++++++>-]<+++++++++++++++.[-] +>+++++[<+++++>-]<+++++++.[-] +>++++++++++[<++++++++++>-]<+++++++++++++++++.[-] +>++++++++++[<++++++++++>-]<++++++++++++.[-] +>+++++[<+++++>-]<+++++++.[-] +>++++++++++[<++++++++++>-]<++++++++++++++++.[-] +>++++++++++[<++++++++++>-]<+++++++++++.[-] +>+++++++[<+++++++>-]<+++++++++.[-] +>+++++[<+++++>-]<+++++++.[-] +=================================================================== +======================== INPUT NUMBER ============================ +=================================================================== +[[[ COMMENT + + cont=1 + [ + - cont=0 + >, + ======SUB10====== + ---------- + + [ not 10 + <+> cont=1 + =====SUB38====== + ---------- + ---------- + ---------- + -------- + > + =====MUL10======= + [>+>+<<-]>>[<<+>>-]< dup + >>>+++++++++ + [ + <<< + [>+>+<<-]>>[<<+>>-]< dup + [<<+>>-] + >>- + ] + <<<[-]< + ======RMOVE1====== + < + [>+<-] + ] + < + ] + >>[<<+>>-]<< +]]] +++++++++++.[-] OUTPUT A NEWLINE +- THE INPUT NUMBER (WE DONT HAVE STDIN YET) +=================================================================== +======================= PROCESS NUMBER =========================== +=================================================================== +==== ==== ==== ==== +numd numu teid teiu +==== ==== ==== ==== +>+<- +[ + >+ + ======DUP====== + [>+>+<<-]>>[<<+>>-]< + >+<-- + >>>>>>>>+<<<<<<<< isprime=1 + [ + >+ + <- + =====DUP3===== + <[>>>+>+<<<<-]>>>>[<<<<+>>>>-]<<< + =====DUP2===== + >[>>+>+<<<-]>>>[<<<+>>>-]<<< < + >>> + ====DIVIDES======= + [>+>+<<-]>>[<<+>>-]< DUP i=div + + << + [ + >>>>>+ bool=1 + <<< + [>+>+<<-]>>[<<+>>-]< DUP + [>>[-]<<-] IF i THEN bool=0 + >> + [ IF i=0 + <<<< + [>+>+<<-]>>[<<+>>-]< i=div + >>> + - bool=0 + ] + <<< + - DEC i + << + - + ] + + +>>[<<[-]>>-]<< + >[-]< CLR div + =====END DIVIDES==== + [>>>>>>[-]<<<<<<-] if divides then isprime=0 + << + >>[-]>[-]<<< + ] + >>>>>>>> + [ + - + <<<<<<<[-]<< + [>>+>+<<<-]>>>[<<<+>>>-]<<< + >> + =================================================================== + ======================== OUTPUT NUMBER =========================== + =================================================================== + [>+<-]> + + [ + ======DUP====== + [>+>+<<-]>>[<<+>>-]< + + + ======MOD10==== + >+++++++++< + [ + >>>+<< bool= 1 + [>+>[-]<<-] bool= ten==0 + >[<+>-] ten = tmp + >[<<++++++++++>>-] if ten=0 ten=10 + <<- dec ten + <- dec num + ] + +++++++++ num=9 + >[<->-]< dec num by ten + + =======RROT====== + [>+<-] + < [>+<-] + < [>+<-] + >>>[<<<+>>>-] + < + + =======DIV10======== + >+++++++++< + [ + >>>+<< bool= 1 + [>+>[-]<<-] bool= ten==0 + >[<+>-] ten = tmp + >[<<++++++++++>>>+<-] if ten=0 ten=10 inc div + <<- dec ten + <- dec num + ] + >>>>[<<<<+>>>>-]<<<< copy div to num + >[-]< clear ten + + =======INC1========= + <+> + ] + + < + [ + =======MOVER========= + [>+<-] + + =======ADD48======== + +++++++[<+++++++>-]<-> + + =======PUTC======= + <.[-]> + + ======MOVEL2======== + >[<<+>>-]< + + <- + ] + + >++++[<++++++++>-]<.[-] + + =================================================================== + =========================== END FOR =============================== + =================================================================== + >>>>>>> + ] + <<<<<<<< + >[-]< + [-] + <<- +] + +======LF======== + +++++++++++.[-] |