# HG changeset patch # User unc0rr # Date 1335814540 -14400 # Node ID 1224c6fb36c3c7cc5f051a3866ef6cbc80271ac0 # Parent eda4f63bec41de7d554ec9594eeb384fb682faab Support recurrent function calls. The code is kinda hackish and ugly, but I really spent a few hours thinking on a good solution. diff -r eda4f63bec41 -r 1224c6fb36c3 hedgewars/pas2c.h --- a/hedgewars/pas2c.h Mon Apr 30 20:12:43 2012 +0200 +++ b/hedgewars/pas2c.h Mon Apr 30 23:35:40 2012 +0400 @@ -63,7 +63,7 @@ string255 copy(string255 a, int s, int l); string255 delete(string255 a, int s, int l); -#define STRINIT(a) {.len = sizeof(a), .str = a} +#define STRINIT(a) {.len = sizeof(a) - 1, .str = a} typedef int file; extern int FileMode; diff -r eda4f63bec41 -r 1224c6fb36c3 hedgewars/pas2cSystem.pas --- a/hedgewars/pas2cSystem.pas Mon Apr 30 20:12:43 2012 +0200 +++ b/hedgewars/pas2cSystem.pas Mon Apr 30 23:35:40 2012 +0400 @@ -65,7 +65,7 @@ trunc, round : function : integer; Abs, Sqr : function : integer; - StrPas, FormatDateTime, copy, delete, str, pos, trim : function : shortstring; + StrPas, FormatDateTime, copy, delete, str, pos, trim, LowerCase : function : shortstring; Length, StrToInt : function : integer; SetLength, val : procedure; _pchar : function : PChar; @@ -122,7 +122,7 @@ glbegin, glend, gltexcoord2f, glvertex2d, gl_true, gl_false, glcolormask, gl_projection, gl_texture_priority, glenum, gl_clamp_to_edge, - gl_extensions : procedure; + gl_extensions, gl_bgra : procedure; TThreadId : function : integer; BeginThread, ThreadSwitch : procedure; diff -r eda4f63bec41 -r 1224c6fb36c3 tools/PascalUnitSyntaxTree.hs --- a/tools/PascalUnitSyntaxTree.hs Mon Apr 30 20:12:43 2012 +0200 +++ b/tools/PascalUnitSyntaxTree.hs Mon Apr 30 23:35:40 2012 +0400 @@ -106,6 +106,7 @@ | BTRecord [(String, BaseType)] | BTArray Range BaseType BaseType | BTFunction BaseType + | BTFunctionReturn String BaseType | BTPointerTo BaseType | BTUnresolved String | BTSet BaseType diff -r eda4f63bec41 -r 1224c6fb36c3 tools/pas2c.hs --- a/tools/pas2c.hs Mon Apr 30 20:12:43 2012 +0200 +++ b/tools/pas2c.hs Mon Apr 30 23:35:40 2012 +0400 @@ -304,16 +304,18 @@ resolveType (Set t) = liftM BTSet $ resolveType t -fromPointer :: String -> BaseType -> State RenderState BaseType -fromPointer s (BTPointerTo t) = f t - where - f (BTUnresolved s) = do - v <- gets $ find (\(a, _) -> a == s) . currentScope - if isJust v then - f . snd . snd . fromJust $ v - else - error $ "Unknown type " ++ show t ++ "\n" ++ s - f t = return t +resolve :: String -> BaseType -> State RenderState BaseType +resolve s (BTUnresolved t) = do + v <- gets $ find (\(a, _) -> a == t) . currentScope + if isJust v then + resolve s . snd . snd . fromJust $ v + else + error $ "Unknown type " ++ show t ++ "\n" ++ s +resolve _ t = return t + +fromPointer :: String -> BaseType -> State RenderState BaseType +fromPointer s (BTPointerTo t) = resolve s t +fromPointer s (BTFunctionReturn _ (BTPointerTo t)) = resolve s t fromPointer s t = do ns <- gets currentScope error $ "Dereferencing from non-pointer type " ++ show t ++ "\n" ++ s ++ "\n\n" ++ show (take 100 ns) @@ -334,7 +336,7 @@ t <- type2C returnType t'<- gets lastType n <- id2C IOInsert $ setBaseType (BTFunction t') name - (p, ph) <- withState' (\st -> st{currentScope = (map toLower rv, (render res, t')) : currentScope st}) $ do + (p, ph) <- withState' (\st -> st{currentScope = (map toLower rv, (render res, BTFunctionReturn (render n) t')) : currentScope st}) $ do p <- functionParams2C params ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase) return (p, ph) @@ -672,6 +674,8 @@ ns <- gets currentScope case t of (BTArray _ _ t') -> modify (\st -> st{lastType = t'}) + (BTFunctionReturn _ (BTArray _ _ t')) -> modify (\st -> st{lastType = t'}) + (BTFunctionReturn _ (BTString)) -> modify (\st -> st{lastType = BTChar}) (BTString) -> modify (\st -> st{lastType = BTChar}) (BTPointerTo t) -> do t'' <- fromPointer (show t) =<< gets lastType @@ -698,8 +702,9 @@ t <- gets lastType ns <- gets currentScope r2 <- case t of + BTFunctionReturn s (BTRecord rs) -> withRecordNamespace "" rs $ ref2C ref2 BTRecord rs -> withRecordNamespace "" rs $ ref2C ref2 - BTUnit -> withLastIdNamespace $ ref2C ref2 + BTUnit -> withLastIdNamespace $ ref2C ref2 a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf ++ "\n" ++ show (take 100 ns) return $ r1 <> text "." <> r2 @@ -716,6 +721,10 @@ ps <- liftM (parens . hsep . punctuate (char ',')) $ mapM expr2C params modify (\s -> s{lastType = t'}) return $ r <> ps + BTFunctionReturn r t' -> do + ps <- liftM (parens . hsep . punctuate (char ',')) $ mapM expr2C params + modify (\s -> s{lastType = t'}) + return $ text r <> ps _ -> case (ref, params) of (SimpleReference i, [p]) -> ref2C $ TypeCast i p _ -> error $ "ref2C FunCall erroneous type cast detected: " ++ show f ++ "\nType detected: " ++ show t