aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--AST.hs2
-rw-r--r--BuildIR.hs82
-rw-r--r--CodeGen.hs14
-rw-r--r--Intermediate.hs2
-rw-r--r--Main.hs2
-rw-r--r--Optimiser.hs21
-rw-r--r--Utils.hs4
-rw-r--r--opttest.lang8
-rw-r--r--struct.lang15
9 files changed, 100 insertions, 50 deletions
diff --git a/AST.hs b/AST.hs
index b42f1af..43cca5f 100644
--- a/AST.hs
+++ b/AST.hs
@@ -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
diff --git a/BuildIR.hs b/BuildIR.hs
index f40e141..c70d538 100644
--- a/BuildIR.hs
+++ b/BuildIR.hs
@@ -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
diff --git a/CodeGen.hs b/CodeGen.hs
index bcc49a0..41f37b2 100644
--- a/CodeGen.hs
+++ b/CodeGen.hs
@@ -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)
diff --git a/Main.hs b/Main.hs
index a31c79d..eb84072 100644
--- a/Main.hs
+++ b/Main.hs
@@ -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
diff --git a/Utils.hs b/Utils.hs
index 51eecf8..1d34a5c 100644
--- a/Utils.hs
+++ b/Utils.hs
@@ -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;
}