--- a/hedgewars/pas2cRedo.pas Fri Feb 07 14:41:49 2014 +0400
+++ b/hedgewars/pas2cRedo.pas Fri Feb 07 15:44:27 2014 +0400
@@ -75,8 +75,9 @@
pos : function : integer;
StrToInt : function : integer;
SetLength, val, StrDispose, StrCopy : procedure;
- _pchar, StrAlloc : function : PChar;
- pchar2str : function : string;
+ _pchar, _pcharA, StrAlloc : function : PChar;
+ pchar2str, astr2str : function : string;
+ pchar2astr, str2astr : function : ansistring;
memcpy : procedure;
StrLength : function : integer;
--- a/hedgewars/pas2cSystem.pas Fri Feb 07 14:41:49 2014 +0400
+++ b/hedgewars/pas2cSystem.pas Fri Feb 07 15:44:27 2014 +0400
@@ -116,6 +116,7 @@
_strconcat, _strappend, _strprepend, _chrconcat : function : string;
_strcompare, _strncompare, _strcomparec : function : boolean;
+ _strconcatA, _strappendA : function : ansistring;
png_structp, png_set_write_fn, png_get_io_ptr,
png_get_libpng_ver, png_create_write_struct,
--- a/hedgewars/uStore.pas Fri Feb 07 14:41:49 2014 +0400
+++ b/hedgewars/uStore.pas Fri Feb 07 15:44:27 2014 +0400
@@ -1272,13 +1272,13 @@
// get description's dimensions
tmpdesc:= description;
-while tmpdesc <> '' do
+while length(tmpdesc) > 0 do
begin
tmpline:= tmpdesc;
SplitByChar(tmpline, tmpdesc, '|');
- if tmpline <> '' then
+ if length(tmpline) > 0 then
begin
- TTF_SizeUTF8(Fontz[font].Handle, Str2PChar(tmpline), @i, @j);
+ TTF_SizeUTF8(Fontz[font].Handle, PChar(tmpline), @i, @j);
if w < (i + wa) then
w:= i + wa;
inc(h, j + ha)
@@ -1315,20 +1315,20 @@
// render all description lines
tmpdesc:= description;
-while tmpdesc <> '' do
+while length(tmpdesc) > 0 do
begin
tmpline:= tmpdesc;
SplitByChar(tmpline, tmpdesc, '|');
r2:= r;
- if tmpline <> '' then
+ if length(tmpline) > 0 then
begin
- r:= WriteInRect(tmpsurf, cFontBorder + 2, r.y + r.h, $ff707070, font, Str2PChar(tmpline));
+ r:= WriteInRect(tmpsurf, cFontBorder + 2, r.y + r.h, $ff707070, font, PChar(tmpline));
// render highlighted caption (if there is a ':')
tmpline2:= _S'';
SplitByChar(tmpline, tmpline2, ':');
- if tmpline2 <> _S'' then
- WriteInRect(tmpsurf, cFontBorder + 2, r2.y + r2.h, $ffc7c7c7, font, Str2PChar(tmpline + ':'));
+ if length(tmpline2) > 0 then
+ WriteInRect(tmpsurf, cFontBorder + 2, r2.y + r2.h, $ffc7c7c7, font, PChar(tmpline + ':'));
end
end;
--- a/hedgewars/uWorld.pas Fri Feb 07 14:41:49 2014 +0400
+++ b/hedgewars/uWorld.pas Fri Feb 07 15:44:27 2014 +0400
@@ -219,7 +219,7 @@
end;
// if the string has been set, show it for (default timeframe) seconds
-if g <> '' then
+if length(g) > 0 then
ShowMission(trgoal[gidCaption], trgoal[gidSubCaption], PChar(g), 1, 0);
cWaveWidth:= SpritesData[sprWater].Width;
--- a/tools/pas2c/Pas2C.hs Fri Feb 07 14:41:49 2014 +0400
+++ b/tools/pas2c/Pas2C.hs Fri Feb 07 15:44:27 2014 +0400
@@ -400,6 +400,7 @@
f "float" = BTFloat
f "char" = BTChar
f "string" = BTString
+ f "ansistring" = BTAString
f _ = error $ "Unknown system type: " ++ show st
resolveType (PointerTo (SimpleType (Identifier i _))) = return . BTPointerTo $ BTUnresolved (map toLower i)
resolveType (PointerTo t) = liftM BTPointerTo $ resolveType t
@@ -427,6 +428,7 @@
resolveType (DeriveType (InitReference (Identifier{}))) = return BTBool -- TODO: derive from actual type
resolveType (DeriveType _) = return BTUnknown
resolveType String = return BTString
+resolveType AString = return BTAString
resolveType VoidType = return BTVoid
resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids
resolveType (RangeType _) = return $ BTVoid
@@ -710,6 +712,7 @@
baseType2C _ BTFloat = text "float"
baseType2C _ BTBool = text "bool"
baseType2C _ BTString = text "string255"
+baseType2C _ BTAString = text "astring"
baseType2C s a = error $ "baseType2C: " ++ show a ++ "\n" ++ s
type2C :: TypeDecl -> State RenderState (Doc -> Doc)
@@ -722,6 +725,7 @@
where
type2C' VoidType = return (text "void" <+>)
type2C' String = return (text "string255" <+>)--return (text ("string" ++ show l) <+>)
+ type2C' AString = return (text "astring" <+>)
type2C' (PointerTo (SimpleType i)) = do
i' <- id2C IODeferred i
lt <- gets lastType
@@ -812,10 +816,28 @@
BTPointerTo _ -> do
e <- expr2C $ Reference $ FunCall [Reference $ RefExpression expr] (SimpleReference (Identifier "pchar2str" BTUnknown))
return $ r <+> text "=" <+> e <> semi
+ BTAString -> do
+ e <- expr2C $ Reference $ FunCall [Reference $ RefExpression expr] (SimpleReference (Identifier "astr2str" BTUnknown))
+ return $ r <+> text "=" <+> e <> semi
BTString -> do
e <- expr2C expr
return $ r <+> text "=" <+> e <> semi
- _ -> error $ "Assignment to string from " ++ show asgn
+ _ -> error $ "Assignment to string from " ++ show lt ++ "\n" ++ show asgn
+ (BTAString, _) -> do
+ void $ 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 "pchar2astr" BTUnknown))
+ return $ r <+> text "=" <+> e <> semi
+ BTString -> do
+ e <- expr2C $ Reference $ FunCall [Reference $ RefExpression expr] (SimpleReference (Identifier "str2astr" BTUnknown))
+ return $ r <+> text "=" <+> e <> semi
+ BTAString -> do
+ e <- expr2C expr
+ return $ r <+> text "=" <+> e <> semi
+ _ -> error $ "Assignment to ansistring from " ++ show lt ++ "\n" ++ show asgn
(BTArray _ _ _, _) -> do
case expr of
Reference er -> do
@@ -913,12 +935,16 @@
expr2C :: Expression -> State RenderState Doc
expr2C (Expression s) = return $ text s
-expr2C (BinOp op expr1 expr2) = do
+expr2C bop@(BinOp op expr1 expr2) = do
e1 <- expr2C expr1
t1 <- gets lastType
e2 <- expr2C expr2
t2 <- gets lastType
case (op2C op, t1, t2) of
+ ("+", BTAString, BTAString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcatA" (BTFunction False [(False, t1), (False, t2)] BTString))
+ ("+", BTAString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strappendA" (BTFunction False [(False, t1), (False, t2)] BTAString))
+ (_, BTAString, _) -> error $ "unhandled bin op with ansistring on the left side: " ++ show bop
+ (_, _, BTAString) -> error $ "unhandled bin op with ansistring on the right side: " ++ show bop
("+", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcat" (BTFunction False [(False, t1), (False, t2)] BTString))
("+", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strappend" (BTFunction False [(False, t1), (False, t2)] BTString))
("+", BTChar, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strprepend" (BTFunction False [(False, t1), (False, t2)] BTString))
@@ -1041,9 +1067,21 @@
modify (\s -> s{lastType = BTInt True})
case lt of
BTString -> return $ text "fpcrtl_Length" <> parens e'
+ BTAString -> return $ text "fpcrtl_LengthA" <> parens e'
BTArray RangeInfinite _ _ -> error $ "length() called on variable size array " ++ show e'
BTArray (RangeFromTo _ n) _ _ -> initExpr2C (BuiltInFunction "succ" [n])
_ -> error $ "length() called on " ++ show lt
+expr2C (BuiltInFunCall [e, e1, e2] (SimpleReference (Identifier "copy" _))) = do
+ e1' <- expr2C e1
+ e2' <- expr2C e2
+ e' <- expr2C e
+ lt <- gets lastType
+ let f name = return $ text name <> parens (hsep $ punctuate (char ',') [e', e1', e2'])
+ case lt of
+ BTString -> f "fpcrtl_copy"
+ BTAString -> f "fpcrtl_copyA"
+ _ -> error $ "copy() called on " ++ show lt
+
expr2C (BuiltInFunCall params ref) = do
r <- ref2C ref
t <- gets lastType
@@ -1091,7 +1129,8 @@
(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})
+ BTString -> modify (\st -> st{lastType = BTChar})
+ BTAString -> modify (\st -> st{lastType = BTChar})
(BTPointerTo t) -> do
t'' <- fromPointer (show t) =<< gets lastType
case t'' of
@@ -1159,6 +1198,7 @@
lt <- expr2C expr >> gets lastType
case (map toLower i, lt) of
("pchar", BTString) -> ref2C $ FunCall [expr] (SimpleReference (Identifier "_pchar" $ BTPointerTo BTChar))
+ ("pchar", BTAString) -> ref2C $ FunCall [expr] (SimpleReference (Identifier "_pcharA" $ BTPointerTo BTChar))
("shortstring", BTPointerTo _) -> ref2C $ FunCall [expr] (SimpleReference (Identifier "pchar2str" $ BTString))
(a, _) -> do
e <- expr2C expr
--- a/tools/pas2c/PascalBasics.hs Fri Feb 07 14:41:49 2014 +0400
+++ b/tools/pas2c/PascalBasics.hs Fri Feb 07 15:44:27 2014 +0400
@@ -17,7 +17,7 @@
string' = void . string
builtin :: [String]
-builtin = ["succ", "pred", "low", "high", "ord", "inc", "dec", "exit", "break", "continue", "length"]
+builtin = ["succ", "pred", "low", "high", "ord", "inc", "dec", "exit", "break", "continue", "length", "copy"]
pascalLanguageDef :: GenLanguageDef String u Identity
pascalLanguageDef
--- a/tools/pas2c/PascalParser.hs Fri Feb 07 14:41:49 2014 +0400
+++ b/tools/pas2c/PascalParser.hs Fri Feb 07 15:44:27 2014 +0400
@@ -138,7 +138,7 @@
char' '^' >> typeDecl >>= return . PointerTo
, try (string' "shortstring") >> return String
, try (string' "string") >> optionMaybe (brackets pas $ integer pas) >> return String
- , try (string' "ansistring") >> optionMaybe (brackets pas $ integer pas) >> return String
+ , try (string' "ansistring") >> optionMaybe (brackets pas $ integer pas) >> return AString
, arrayDecl
, recordDecl
, setDecl
--- a/tools/pas2c/PascalPreprocessor.hs Fri Feb 07 14:41:49 2014 +0400
+++ b/tools/pas2c/PascalPreprocessor.hs Fri Feb 07 15:44:27 2014 +0400
@@ -81,7 +81,9 @@
char' '}'
f <- liftIO (readFile (inputPath ++ ifn)
`E.catch` (\(_ :: E.IOException) -> readFile (alternateInputPath ++ ifn)
- `E.catch` (\(_ :: E.IOException) -> error ("File not found: " ++ fn))))
+ `E.catch` (\(_ :: E.IOException) -> error $ "File not found: " ++ ifn)
+ )
+ )
c <- getInput
setInput $ f ++ c
return ""
--- a/tools/pas2c/PascalUnitSyntaxTree.hs Fri Feb 07 14:41:49 2014 +0400
+++ b/tools/pas2c/PascalUnitSyntaxTree.hs Fri Feb 07 15:44:27 2014 +0400
@@ -26,6 +26,7 @@
| RecordType [TypeVarDeclaration] (Maybe [[TypeVarDeclaration]])
| PointerTo TypeDecl
| String
+ | AString
| Set TypeDecl
| FunctionType TypeDecl [TypeVarDeclaration]
| DeriveType InitExpression
@@ -100,6 +101,7 @@
data BaseType = BTUnknown
| BTChar
| BTString
+ | BTAString
| BTInt Bool -- second param indicates whether signed or not
| BTBool
| BTFloat