From 2a54765a590e1d393442262002885adcbfe156cd Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Fri, 1 Sep 2017 23:09:41 +0200
Subject: Global structs, better imul/idiv
---
AST.hs | 1 +
CodeGen.hs | 82 +++++++++++++++++++++++++++++++++++++++++++++++--------------
X64.hs | 10 ++++----
struct.lang | 4 +++
4 files changed, 74 insertions(+), 23 deletions(-)
diff --git a/AST.hs b/AST.hs
index ccad05d..7a76208 100644
--- a/AST.hs
+++ b/AST.hs
@@ -42,6 +42,7 @@ data Statement
data AsExpression
= AEVar Name (Maybe Type)
| AESubscript AsExpression Expression (Maybe Type)
+ -- | AESet
deriving (Show, Eq)
data Expression
diff --git a/CodeGen.hs b/CodeGen.hs
index 450f887..bcc49a0 100644
--- a/CodeGen.hs
+++ b/CodeGen.hs
@@ -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
diff --git a/X64.hs b/X64.hs
index 0cbf4fc..c2cbf81 100644
--- a/X64.hs
+++ b/X64.hs
@@ -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
--
cgit v1.2.3-70-g09d2