diff options
| -rw-r--r-- | AST.hs | 1 | ||||
| -rw-r--r-- | CodeGen.hs | 82 | ||||
| -rw-r--r-- | X64.hs | 10 | ||||
| -rw-r--r-- | struct.lang | 4 |
4 files changed, 74 insertions, 23 deletions
@@ -42,6 +42,7 @@ data Statement data AsExpression = AEVar Name (Maybe Type) | AESubscript AsExpression Expression (Maybe Type) + -- | AESet deriving (Show, Eq) data Expression @@ -75,11 +75,26 @@ 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" ++ +codegenVar (DVar TInt n (ELit (LInt i) _)) = return $ n ++ ": dq " ++ show i +codegenVar (DVar TChar n (ELit (LChar c) _)) = return $ n ++ ": db " ++ show (ord c) +codegenVar (DVar (TArr TChar _) n (ELit (LStr s) _)) = return $ + "$" ++ n ++ ":\n" ++ "\tdq " ++ show (length s + 1) ++ "\n" ++ "\tdb " ++ (intercalate ", " $ map show $ map ord s ++ [0]) +codegenVar (DVar t@(TStruct _) n e@(ELit (LStruct _) _)) = + (("$" ++ n ++ ":\n") ++) <$> genDataFor t e + where + genDataFor :: Type -> Expression -> Error String + genDataFor TInt (ELit (LInt i) _) = return $ "dq " ++ show i + genDataFor TChar (ELit (LChar c) _) = return $ "db " ++ show (ord c) + genDataFor (TStruct ms') (ELit (LStruct exprtups') _) = + liftM (intercalate "\n" . map ('\t' :) . concatMap lines) $ + forM (zip ms' exprtups') $ \((typ, name), (name2, expr)) -> + if name /= name2 + then Left $ "Invalid struct literal member order somewhere " ++ + "in a global variable declaration" + else genDataFor typ expr + genDataFor _ _ = Left "Unsupported expression in struct literal in global variable declaration" codegenVar _ = Left "Unsupported global variable declaration" @@ -95,7 +110,7 @@ codegenFunc (IRFunc _ name al bbs sid) = do aliascandidates = findAliasCandidates bbs :: [(Ref, Ref)] - gpRegs = [R8, R9, R10, R11, R12, R13, R14, R15] + gpRegs = [R8, R9, R10, R11, R12, R13, R14, R15, RDI, RSI] -- gpRegs = [R8] allocation = regalloc lifespans gpRegs aliascandidates :: Map.Map Ref (Allocation Register) @@ -255,8 +270,8 @@ codegenIns m (ILea d n) codegenIns m (IStore d s) = do sourcexref <- if X64.isXMem sm then do - addIns $ mkmov (XReg sz RBX) sm - return $ XReg sz RBX + addIns $ mkmov (XReg sz RDX) sm + return $ XReg sz RDX else return sm destxref <- case dm of XReg _ r -> return $ XMem sz (Just r) (0, RAX) Nothing 0 @@ -302,26 +317,57 @@ codegenIns m (IGet d s off) where dm = mkxref d m sm = X64.xrefSetSize sz $ X64.offsetXMem (fromIntegral off) $ mkxref s m sz = fromIntegral $ refSize d -codegenIns m (IAri AMul d s1 s2) = do - let sz = fromIntegral $ refSize d - addIns $ mkmov (XReg sz RAX) (mkxref s1 m) - addIns $ mkmov (XReg sz RBX) (mkxref s2 m) - addIns $ IMULDA (xref $ XReg sz RBX) - addIns $ mkmov (mkxref d m) (XReg sz RAX) +codegenIns m (IAri AMul d s1 s2) + | X64.isXImm s1m && X64.isXImm s2m = undefined + | X64.isXImm s1m = 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 + addIns $ IMUL3 (xref $ XReg sz RAX) (xref s1m) (xref s2m) + addIns $ mkmov dm (XReg sz RAX) + else do -- reg dm, regmem s1m, imm s2m + addIns $ IMUL3 (xref dm) (xref s1m) (xref s2m) + else if X64.isXMem dm + then do -- mem dm, regmem s1m, regmem s2m + addIns $ mkmov (XReg sz RAX) s1m + addIns $ IMUL (xref $ XReg sz RAX) (xref s2m) + addIns $ mkmov dm (XReg sz RAX) + else if dm == s1m + then do -- reg dm = reg s1m, regmem s2m + addIns $ IMUL (xref dm) (xref s2m) + else do -- reg dm, regmem s1m, regmem s2m + addIns $ mkmov dm s1m + addIns $ IMUL (xref dm) (xref s2m) + where dm = mkxref d m + s1m = mkxref s1 m + s2m = mkxref s2 m codegenIns m (IAri ADiv d s1 s2) = do let sz = fromIntegral $ refSize d addIns $ XOR (xref $ XReg 4 RDX) (xref $ XReg 4 RDX) addIns $ mkmov (XReg sz RAX) (mkxref s1 m) - addIns $ mkmov (XReg sz RBX) (mkxref s2 m) - addIns $ IDIVDA (xref $ XReg sz RBX) + arg <- if X64.isXImm s2m + then do + addIns $ mkmov (XReg sz RBX) s2m + return (XReg sz RBX) + else return s2m + addIns $ IDIVDA (xref arg) addIns $ mkmov (mkxref d m) (XReg sz RAX) + where s2m = mkxref s2 m codegenIns m (IAri AMod d s1 s2) = do let sz = fromIntegral $ refSize d addIns $ XOR (xref $ XReg 4 RDX) (xref $ XReg 4 RDX) addIns $ mkmov (XReg sz RAX) (mkxref s1 m) - addIns $ mkmov (XReg sz RBX) (mkxref s2 m) - addIns $ IDIVDA (xref $ XReg sz RBX) + arg <- if X64.isXImm s2m + then do + addIns $ mkmov (XReg sz RBX) s2m + return (XReg sz RBX) + else return s2m + addIns $ IDIVDA (xref arg) addIns $ mkmov (mkxref d m) (XReg sz RDX) + where s2m = mkxref s2 m codegenIns m (IAri at d s1 s2) = case arithTypeToCondCode at of Just cc -> do arg2 <- if X64.isXMem s1m && X64.isXMem s2m @@ -349,8 +395,8 @@ codegenIns m (IAri at d s1 s2) = case arithTypeToCondCode at of else return s2m' when (dm /= s1m') $ if X64.isXMem dm && X64.isXMem s1m' then do - addIns $ mkmov (XReg (fromIntegral $ refSize s1') RBX) s1m' - addIns $ mkmov dm (XReg (fromIntegral $ refSize s1') RBX) + addIns $ mkmov (XReg (fromIntegral $ refSize s1') RDX) s1m' + addIns $ mkmov dm (XReg (fromIntegral $ refSize s1') RDX) else do addIns $ mkmov dm s1m' addIns $ fromJust (arithTypeToIns at) dm arg2 @@ -203,7 +203,7 @@ stringify_only_xmem_brackets (XMem _ mr pair lab off) = goR1 (Just r) = Just $ stringify (XReg 8 r) goPair (0, _) = Nothing goPair (mult, r) = Just $ show mult ++ "*" ++ stringify (XReg 8 r) - goLab = id + goLab = fmap ('$' :) goOff o | o > 0 = '+' : show o | o < 0 = show o | otherwise = "" @@ -259,11 +259,11 @@ instance Stringifiable Ins where stringify (CMP a b) = "cmp " ++ stringify a ++ ", " ++ stringify b stringify (CMPi a b) = "cmp " ++ stringify a ++ ", " ++ stringify b stringify (SETCC cc a) = "set" ++ stringify cc ++ " " ++ stringify a - stringify (CALL a) = "call " ++ a + stringify (CALL a) = "call $" ++ a stringify (PUSH a) = "push " ++ stringify a stringify (POP a) = "pop " ++ stringify a - stringify (JMP s) = "jmp " ++ s - stringify (JCC cc s) = "j" ++ stringify cc ++ " " ++ s + stringify (JMP s) = "jmp $" ++ s + stringify (JCC cc s) = "j" ++ stringify cc ++ " $" ++ s stringify RET = "ret" stringify INT3 = "int3" @@ -271,7 +271,7 @@ instance Stringifiable Asm where stringify (Asm funcs) = intercalate "\n" $ map goF funcs where goF :: (String, [Ins]) -> String - goF (name, inss) = name ++ ":\n" ++ unlines (map (('\t' :) . stringify) inss) + goF (name, inss) = "$" ++ name ++ ":\n" ++ unlines (map (('\t' :) . stringify) inss) xrefGetSize :: XRef -> Int xrefGetSize (XReg s _) = s diff --git a/struct.lang b/struct.lang index 3297939..5bd38c4 100644 --- a/struct.lang +++ b/struct.lang @@ -3,12 +3,16 @@ type S := struct { char y; }; +S global := {x = 1, y = '!'}; + func f(int iets1, S s, int iets2) { putint(s.x); putc(s.y); putc('\n'); putint(iets1); putc(' '); putint(iets2); putc('\n'); } func int main() { + // global.x = 3 * global.x + int(global.y); + putint(global.x + 1); putc(global.y); putc('\n'); int a := getc(); int b := getc(); getc(); // newline |