Some improvements to pas2c
authorunc0rr
Mon, 28 May 2012 17:54:23 +0400
changeset 7134 beb16926ae5c
parent 7132 baf3351646f4
child 7137 5587ab553f32
Some improvements to pas2c
hedgewars/pas2c.h
hedgewars/pas2cSystem.pas
hedgewars/uAIAmmoTests.pas
hedgewars/uConsole.pas
hedgewars/uDebug.pas
hedgewars/uStore.pas
tools/pas2c.hs
--- a/hedgewars/pas2c.h	Fri May 25 15:35:48 2012 +0400
+++ b/hedgewars/pas2c.h	Mon May 28 17:54:23 2012 +0400
@@ -1,5 +1,6 @@
 #pragma once
 
+#include <stddef.h>
 #include <stdint.h>
 #include <stdbool.h>
 #include <wchar.h>
@@ -56,17 +57,6 @@
 typedef int PtrInt;
 typedef wchar_t widechar;
 
-#ifdef __GNUG__
-#define NULL __null
-#else   /* G++ */
-/* shield NULL definition for non-gnu parsers */
-#ifndef __cplusplus
-#define NULL ((void *)0)
-#else
-#define NULL 0
-#endif  /* __cplusplus */
-#endif  /* G++ */
-
 #define new(a) __new((void **)&a, sizeof(*(a)))
 void __new(void ** p, int size);
 #define dispose(a) __dispose(a, sizeof(*(a)))
@@ -85,6 +75,7 @@
 bool _strcomparec(string255 a, char b);
 bool _strncompare(string255 a, string255 b);
 char * _pchar(string255 s);
+string255 pchar2str(char * s);
 
 int Length(string255 a);
 string255 copy(string255 a, int s, int l);
@@ -113,6 +104,7 @@
 void close(int f);
 
 void write(string255 s);
+void writeLn(string255 s);
 
 bool DirectoryExists(string255 dir);
 bool FileExists(string255 filename);
--- a/hedgewars/pas2cSystem.pas	Fri May 25 15:35:48 2012 +0400
+++ b/hedgewars/pas2cSystem.pas	Mon May 28 17:54:23 2012 +0400
@@ -68,6 +68,7 @@
     Length, StrToInt : function : integer;
     SetLength, val : procedure;
     _pchar : function : PChar;
+    pchar2str : function : string;
     memcpy : procedure;
 
     assign, rewrite, reset, flush, BlockWrite, BlockRead, close : procedure;
--- a/hedgewars/uAIAmmoTests.pas	Fri May 25 15:35:48 2012 +0400
+++ b/hedgewars/uAIAmmoTests.pas	Mon May 28 17:54:23 2012 +0400
@@ -663,14 +663,15 @@
     x, y: real;
 begin
 Level:= Level; // avoid compiler hint
+TestFirePunch:= BadTurn;
 ap.ExplR:= 0;
 ap.Time:= 0;
 ap.Power:= 1;
 ap.Angle:= hwSign(Me^.dX);
 x:= hwFloat2Float(Me^.X);
 y:= hwFloat2Float(Me^.Y);
-if (Abs(trunc(x) - Targ.X) > 25)
-or (Abs(trunc(y) - 50 - Targ.Y) > 50) then
+if (Abs(trunc(x) - Targ.X) < 25)
+    and (Abs(trunc(y) - 50 - Targ.Y) < 50) then
     begin
 // TODO - find out WTH this works.
     if TestColl(trunc(x), trunc(y) - 16, 6) and 
--- a/hedgewars/uConsole.pas	Fri May 25 15:35:48 2012 +0400
+++ b/hedgewars/uConsole.pas	Mon May 28 17:54:23 2012 +0400
@@ -49,8 +49,10 @@
 end;
 
 procedure WriteToConsole(s: shortstring);
+{$IFNDEF NOCONSOLE}
 var Len: LongInt;
     done: boolean;
+{$ENDIF}
 begin
 {$IFNDEF NOCONSOLE}
 AddFileLog('[Con] ' + s);
--- a/hedgewars/uDebug.pas	Fri May 25 15:35:48 2012 +0400
+++ b/hedgewars/uDebug.pas	Mon May 28 17:54:23 2012 +0400
@@ -47,9 +47,13 @@
 end;
 
 procedure SDLTry(Assert: boolean; isFatal: boolean);
+var s: shortstring;
 begin
 if not Assert then
-    OutError(SDL_GetError, isFatal)
+    begin
+    s:= SDL_GetError();
+    OutError(s, isFatal)
+    end
 end;
 
 end.
--- a/hedgewars/uStore.pas	Fri May 25 15:35:48 2012 +0400
+++ b/hedgewars/uStore.pas	Mon May 28 17:54:23 2012 +0400
@@ -825,7 +825,7 @@
 if caption = '' then
     caption:= '???';
 if subcaption = '' then
-    subcaption:= ' ';
+    subcaption:= _S' ';
 
 font:= CheckCJKFont(caption,fnt16);
 font:= CheckCJKFont(subcaption,font);
@@ -909,9 +909,9 @@
         r:= WriteInRect(tmpsurf, cFontBorder + 2, r.y + r.h, $ff707070, font, tmpline);
 
         // render highlighted caption (if there is a ':')
-        tmpline2:= '';
+        tmpline2:= _S'';
         SplitByChar(tmpline, tmpline2, ':');
-        if tmpline2 <> '' then
+        if tmpline2 <> _S'' then
             WriteInRect(tmpsurf, cFontBorder + 2, r2.y + r2.h, $ffc7c7c7, font, tmpline + ':');
         end
     end;
@@ -954,7 +954,7 @@
 r.h:= 32;
 
 // default (no extra text)
-extra:= '';
+extra:= _S'';
 extracolor:= 0;
 
 if (CurrentTeam <> nil) and (Ammoz[atype].SkipTurns >= CurrentTeam^.Clan^.TurnNumber) then // weapon or utility is not yet available
@@ -969,7 +969,7 @@
     end
 else
     begin
-    extra:= '';
+    extra:= _S'';
     extracolor:= 0;
     end;
 
--- a/tools/pas2c.hs	Fri May 25 15:35:48 2012 +0400
+++ b/tools/pas2c.hs	Mon May 28 17:54:23 2012 +0400
@@ -39,10 +39,11 @@
         uniqCounter :: Int,
         toMangle :: Set.Set String,
         currentUnit :: String,
+        currentFunctionResult :: String,
         namespaces :: Map.Map String Records
     }
     
-emptyState = RenderState Map.empty "" BTUnknown [] 0 Set.empty ""
+emptyState = RenderState Map.empty "" BTUnknown [] 0 Set.empty "" ""
 
 getUniq :: State RenderState Int
 getUniq = do
@@ -381,13 +382,19 @@
     t <- type2C returnType
     t'<- gets lastType
     n <- id2C IOInsert $ setBaseType (BTFunction (numberOfDeclarations params) t') name
-    (p, ph) <- withState' (\st -> st{currentScope = Map.insertWith un (map toLower rv) [(render res, t')] $ currentScope st}) $ do
+    
+    let isVoid = case returnType of
+            VoidType -> True
+            _ -> False
+            
+    (p, ph) <- withState' (\st -> st{currentScope = Map.insertWith un (map toLower rv) [(render res, t')] $ currentScope st
+            , currentFunctionResult = if isVoid then [] else render res}) $ do
         p <- functionParams2C params
         ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase)
         return (p, ph)
-    let phrasesBlock = case returnType of
-            VoidType -> ph
-            _ -> t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi
+        
+    let phrasesBlock = if isVoid then ph else t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi
+    
     return [ 
         t empty <+> n <> parens p
         $+$
@@ -615,6 +622,18 @@
         (BTFunction {}, (Reference r')) -> do
             e <- ref2C r'
             return $ r <+> text "=" <+> e <> semi
+        (BTString, _) -> do
+            e <- expr2C expr
+            lt <- gets lastType
+            case lt of
+                -- assume pointer to char for simplicity
+                BTPointerTo _ -> do
+                    e <- expr2C $ Reference $ FunCall [Reference $ RefExpression expr] (SimpleReference (Identifier "pchar2str" BTUnknown))
+                    return $ r <+> text "=" <+> e <> semi
+                BTString -> do
+                    e <- expr2C expr
+                    return $ r <+> text "=" <+> e <> semi
+                _ -> error $ "Assignment to string from " ++ show lt
         (BTArray (Range _) _ _, _) -> phrase2C $ 
             ProcCall (FunCall
                 [
@@ -671,7 +690,12 @@
     return $ text "do" <+> p <+> text "while" <> parens (text "!" <> parens e) <> semi
 phrase2C NOP = return $ text ";"
 
-phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "exit" BTUnknown))) = return $ text "return" <> semi
+phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "exit" BTUnknown))) = do
+    f <- gets currentFunctionResult
+    if null f then
+        return $ text "return" <> semi
+        else
+        return $ text "return" <+> text f <> semi
 phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "break" BTUnknown))) = return $ text "break" <> semi
 phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "continue" BTUnknown))) = return $ text "continue" <> semi
 phrase2C (BuiltInFunctionCall [e] (SimpleReference (Identifier "exit" BTUnknown))) = liftM (\e -> text "return" <+> e <> semi) $ expr2C e