Global structs, better imul/idiv

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