- Pas2C: make use of 'external' function decorator
authorunc0rr
Tue, 11 Feb 2014 01:19:44 +0400
changeset 10129 cd2a64a1f4aa
parent 10128 0f6878b5395a
child 10130 a9d509848390
- Pas2C: make use of 'external' function decorator - Fixes to rtl - Some work here and there
hedgewars/pas2cSystem.pas
hedgewars/uPhysFSLayer.pas
hedgewars/uScript.pas
hedgewars/uStore.pas
misc/libphyslayer/physfsrwops.h
project_files/hwc/CMakeLists.txt
project_files/hwc/rtl/fpcrtl.h
project_files/hwc/rtl/misc.c
project_files/hwc/rtl/misc.h
tools/pas2c/Pas2C.hs
tools/pas2c/PascalParser.hs
tools/pas2c/PascalUnitSyntaxTree.hs
--- a/hedgewars/pas2cSystem.pas	Mon Feb 10 23:02:49 2014 +0400
+++ b/hedgewars/pas2cSystem.pas	Tue Feb 11 01:19:44 2014 +0400
@@ -127,7 +127,7 @@
     clear_filelist_hook, add_file_hook, idb_loader_hook, mainloop_hook, drawworld_hook : procedure;
     SDL_InitPatch : procedure;
 
-    PHYSFS_init, PHYSFS_deinit, PHYSFS_mount, PHYSFS_readBytes : function : LongInt;
+    PHYSFS_init, PHYSFS_deinit, PHYSFS_mount, PHYSFS_readBytes, PHYSFS_read : function : LongInt;
     PHYSFSRWOPS_openRead, PHYSFSRWOPS_openWrite, PHYSFS_openRead : function : pointer;
     PHYSFS_eof, PHYSFS_close, PHYSFS_exists : function : boolean;
     PHYSFS_getLastError : function : PChar;
--- a/hedgewars/uPhysFSLayer.pas	Mon Feb 10 23:02:49 2014 +0400
+++ b/hedgewars/uPhysFSLayer.pas	Tue Feb 11 01:19:44 2014 +0400
@@ -1,3 +1,5 @@
+{$INCLUDE "options.inc"}
+
 unit uPhysFSLayer;
 
 interface
@@ -29,21 +31,19 @@
 
 function pfsExists(fname: shortstring): boolean;
 
-{$IFNDEF PAS2C}
 function  physfsReader(L: Plua_State; f: PFSFile; sz: Psize_t) : PChar; cdecl; external PhyslayerLibName;
 procedure physfsReaderSetBuffer(buf: pointer); cdecl; external PhyslayerLibName;
 procedure hedgewarsMountPackage(filename: PChar); cdecl; external PhyslayerLibName;
-{$ENDIF}
 
 implementation
-uses uConsts, uUtils, uVariables{$IFNDEF PAS2C}, sysutils{$ENDIF};
+uses uConsts, uUtils, uVariables{$IFNDEF PAS2C}, sysutils{$ELSE}, physfs{$ENDIF};
 
-{$IFNDEF PAS2C}
-function PHYSFS_init(argv0: PChar) : LongInt; cdecl; external PhysfsLibName;
-function PHYSFS_deinit() : LongInt; cdecl; external PhysfsLibName;
 function PHYSFSRWOPS_openRead(fname: PChar): PSDL_RWops; cdecl; external PhyslayerLibName;
 function PHYSFSRWOPS_openWrite(fname: PChar): PSDL_RWops; cdecl; external PhyslayerLibName;
-
+procedure hedgewarsMountPackages(); cdecl; external PhyslayerLibName;
+{$IFNDEF PAS2C}
+function PHYSFS_init(argv0: PChar): LongInt; cdecl; external PhysfsLibName;
+function PHYSFS_deinit(): LongInt; cdecl; external PhysfsLibName;
 function PHYSFS_mount(newDir, mountPoint: PChar; appendToPath: LongBool) : LongBool; cdecl; external PhysfsLibName;
 function PHYSFS_openRead(fname: PChar): PFSFile; cdecl; external PhysfsLibName;
 function PHYSFS_eof(f: PFSFile): LongBool; cdecl; external PhysfsLibName;
@@ -51,8 +51,11 @@
 function PHYSFS_close(f: PFSFile): LongBool; cdecl; external PhysfsLibName;
 function PHYSFS_exists(fname: PChar): LongBool; cdecl; external PhysfsLibName;
 function PHYSFS_getLastError(): PChar; cdecl; external PhysfsLibName;
-
-procedure hedgewarsMountPackages(); cdecl; external PhyslayerLibName;
+{$ELSE}
+function PHYSFS_readBytes(f: PFSFile; buffer: pointer; len: Int64): Int64;
+begin
+    PHYSFS_readBytes:= PHYSFS_read(f, buffer, 1, len);
+end;
 {$ENDIF}
 
 function rwopsOpenRead(fname: shortstring): PSDL_RWops;
@@ -142,7 +145,7 @@
 
 procedure pfsMountAtRoot(path: ansistring);
 begin
-    pfsMount(path, PChar('/'));
+    pfsMount(path, PChar(_S'/'));
 end;
 
 procedure initModule;
--- a/hedgewars/uScript.pas	Mon Feb 10 23:02:49 2014 +0400
+++ b/hedgewars/uScript.pas	Tue Feb 11 01:19:44 2014 +0400
@@ -86,9 +86,7 @@
     uVisualGearsList,
     uGearsHandlersMess,
     uPhysFSLayer
-{$IFDEF PAS2C}
-    , hwpacksmounter
-{$ELSE}
+{$IFNDEF PAS2C}
     , typinfo
 {$ENDIF}
     ;
--- a/hedgewars/uStore.pas	Mon Feb 10 23:02:49 2014 +0400
+++ b/hedgewars/uStore.pas	Tue Feb 11 01:19:44 2014 +0400
@@ -600,7 +600,8 @@
 
     if tmpsurf = nil then
         begin
-        OutError(msgFailed, (imageFlags and ifCritical) <> 0);
+        OutError(msgFailed, false);
+        SDLTry(false, (imageFlags and ifCritical) <> 0);
         exit;
         end;
 
--- a/misc/libphyslayer/physfsrwops.h	Mon Feb 10 23:02:49 2014 +0400
+++ b/misc/libphyslayer/physfsrwops.h	Tue Feb 11 01:19:44 2014 +0400
@@ -24,6 +24,7 @@
 #define _INCLUDE_PHYSFSRWOPS_H_
 
 #include "physfs.h"
+
 #include "SDL.h"
 
 #include "physfscompat.h"
--- a/project_files/hwc/CMakeLists.txt	Mon Feb 10 23:02:49 2014 +0400
+++ b/project_files/hwc/CMakeLists.txt	Tue Feb 11 01:19:44 2014 +0400
@@ -13,6 +13,7 @@
 include_directories(${PHYSFS_INCLUDE_DIR})
 include_directories(${PHYSLAYER_INCLUDE_DIR})
 include_directories(${LUA_INCLUDE_DIR})
+include_directories(${SDL_INCLUDE_DIR})
 add_subdirectory(rtl)
 
 configure_file(${CMAKE_SOURCE_DIR}/hedgewars/config.inc.in ${CMAKE_CURRENT_BINARY_DIR}/config.inc)
--- a/project_files/hwc/rtl/fpcrtl.h	Mon Feb 10 23:02:49 2014 +0400
+++ b/project_files/hwc/rtl/fpcrtl.h	Tue Feb 11 01:19:44 2014 +0400
@@ -148,8 +148,8 @@
 #define sdlh_SDL_WaitThread                 SDL_WaitThread
 #define sdlh_SDL_CreateMutex                SDL_CreateMutex
 #define sdlh_SDL_DestroyMutex               SDL_DestroyMutex
-#define sdlh_SDL_LockMutex                  SDL_mutexP
-#define sdlh_SDL_UnlockMutex                SDL_mutexV
+#define SDL_LockMutex                       SDL_mutexP
+#define SDL_UnlockMutex                     SDL_mutexV
 #ifndef EMSCRIPTEN
 #define sdlh_SDL_ShowCursor                 SDL_ShowCursor
 #else
@@ -181,6 +181,14 @@
 #define sdlh_TTF_SetFontStyle               TTF_SetFontStyle
 #define sdlh_TTF_SizeUTF8                   TTF_SizeUTF8
 
+#define uphysfslayer_physfsReaderSetBuffer  physfsReaderSetBuffer
+#define uphysfslayer_physfsReader           physfsReader
+#define uphysfslayer_hedgewarsMountPackage  hedgewarsMountPackage
+#define uphysfslayer_hedgewarsMountPackages hedgewarsMountPackages
+
+#define uphysfslayer_PHYSFSRWOPS_openRead   PHYSFSRWOPS_openRead
+#define uphysfslayer_PHYSFSRWOPS_openWrite  PHYSFSRWOPS_openWrite
+
 #define _strconcat                          fpcrtl_strconcat
 #define _strappend                          fpcrtl_strappend
 #define _strprepend                         fpcrtl_strprepend
--- a/project_files/hwc/rtl/misc.c	Mon Feb 10 23:02:49 2014 +0400
+++ b/project_files/hwc/rtl/misc.c	Tue Feb 11 01:19:44 2014 +0400
@@ -57,7 +57,7 @@
     int newlen = str1.len + str2.len;
     if(newlen > MAX_ANSISTRING_LENGTH) newlen = MAX_ANSISTRING_LENGTH;
 
-    memcpy(&(str1.s[str1.len + 1]), str2.s[1], newlen - str1.len);
+    memcpy(&(str1.s[str1.len + 1]), &str2.s[1], newlen - str1.len);
     str1.len = newlen;
 
     return str1;
@@ -67,8 +67,8 @@
 {
     if(s.len < 255)
     {
+        ++s.len;
         s.s[s.len] = c;
-        ++s.len;
     }
 
     return s;
@@ -195,16 +195,9 @@
 
 char* fpcrtl__pchar__vars(string255 * s)
 {
-    if(s->len < 255)
-    {
-        s->s[s->len] = 0;
-        return &s->s[1];
-    } else
-    {
-        memcpy(__pcharBuf, s->s[1], 255);
-        __pcharBuf[255] = 0;
-        return &__pcharBuf;
-    }
+    memcpy(__pcharBuf, &s->s[1], s->len);
+    __pcharBuf[s->len] = 0;
+    return __pcharBuf;
 }
 
 char* fpcrtl__pcharA__vars(astring * s)
--- a/project_files/hwc/rtl/misc.h	Mon Feb 10 23:02:49 2014 +0400
+++ b/project_files/hwc/rtl/misc.h	Tue Feb 11 01:19:44 2014 +0400
@@ -51,6 +51,7 @@
 #define     fpcrtl__pchar(s)                    fpcrtl__pchar__vars(&(s))
 #define     fpcrtl__pcharA(s)                   fpcrtl__pcharA__vars(&(s))
 char*       fpcrtl__pchar__vars(string255 * s);
+char*       fpcrtl__pcharA__vars(astring * s);
 string255   fpcrtl_pchar2str(const char *s);
 astring     fpcrtl_pchar2astr(const char *s);
 astring     fpcrtl_str2astr(string255 s);
--- a/tools/pas2c/Pas2C.hs	Mon Feb 10 23:02:49 2014 +0400
+++ b/tools/pas2c/Pas2C.hs	Tue Feb 11 01:19:44 2014 +0400
@@ -237,7 +237,7 @@
 
 pascal2C (Program _ implementation mainFunction) = do
     impl <- implementation2C implementation
-    [main] <- tvar2C True False True True (FunctionDeclaration (Identifier "main" (BTInt True)) False False (SimpleType $ Identifier "int" (BTInt True)) [VarDeclaration False False ([Identifier "argc" (BTInt True)], SimpleType (Identifier "Integer" (BTInt True))) Nothing, VarDeclaration False False ([Identifier "argv" BTUnknown], SimpleType (Identifier "PPChar" BTUnknown)) Nothing] (Just (TypesAndVars [], mainFunction)))
+    [main] <- tvar2C True False True True (FunctionDeclaration (Identifier "main" (BTInt True)) False False False (SimpleType $ Identifier "int" (BTInt True)) [VarDeclaration False False ([Identifier "argc" (BTInt True)], SimpleType (Identifier "Integer" (BTInt True))) Nothing, VarDeclaration False False ([Identifier "argv" BTUnknown], SimpleType (Identifier "PPChar" BTUnknown)) Nothing] (Just (TypesAndVars [], mainFunction)))
 
     return $ impl $+$ main
 
@@ -271,7 +271,7 @@
         initMap :: Map.Map String Int
         initMap = Map.empty
         --initMap = Map.fromList [("reset", 2)]
-        ins (FunctionDeclaration (Identifier i _) _ _ _ _ _) m = Map.insertWith (+) (map toLower i) 1 m
+        ins (FunctionDeclaration (Identifier i _) _ _ _ _ _ _) m = Map.insertWith (+) (map toLower i) 1 m
         ins _ m = m
 
 -- the second bool indicates whether declare variable as extern or not
@@ -310,8 +310,8 @@
     tom <- gets (Set.member n . toMangle)
     cu <- gets currentUnit
     let (i', t') = case (t, tom) of
-            (BTFunction _ p _, True) -> (cu ++ i ++ ('_' : show (length p)), t)
-            (BTFunction _ _ _, _) -> (cu ++ i, t)
+            (BTFunction _ e p _, True) -> ((if e then id else (++) cu) $ i ++ ('_' : show (length p)), t)
+            (BTFunction _ e _ _, _) -> ((if e then id else (++) cu) i, t)
             (BTVarParam t'', _) -> ('(' : '*' : i ++ ")" , t'')
             _ -> (i, t)
     modify (\s -> s{currentScope = Map.insertWith (++) n [Record i' t' d] (currentScope s), lastIdentifier = n})
@@ -331,7 +331,7 @@
         let vv = fromMaybe (head $ fromJust v) . find checkParam $ fromJust v in
             modify (setLastIdValues vv) >> (return . text . lcaseId $ vv)
     where
-        checkParam (Record _ (BTFunction _ p _) _) = (length p) == params
+        checkParam (Record _ (BTFunction _ _ p _) _) = (length p) == params
         checkParam _ = False
 id2C IODeferred (Identifier i _) = do
     let i' = map toLower i
@@ -417,7 +417,7 @@
 resolveType (ArrayDecl Nothing t) = liftM (BTArray RangeInfinite (BTInt True)) $ resolveType t
 resolveType (FunctionType t a) = do
     bts <- typeVarDecl2BaseType a
-    liftM (BTFunction False bts) $ resolveType t
+    liftM (BTFunction False False bts) $ resolveType t
 resolveType (DeriveType (InitHexNumber _)) = return (BTInt True)
 resolveType (DeriveType (InitNumber _)) = return (BTInt True)
 resolveType (DeriveType (InitFloat _)) = return BTFloat
@@ -481,16 +481,16 @@
         ps = zip ['a'..] (toIsVarList params)
 
 fun2C :: Bool -> String -> TypeVarDeclaration -> State RenderState [Doc]
-fun2C _ _ (FunctionDeclaration name _ overload returnType params Nothing) = do
+fun2C _ _ (FunctionDeclaration name _ overload external returnType params Nothing) = do
     t <- type2C returnType
     t'<- gets lastType
     bts <- typeVarDecl2BaseType params
     p <- withState' id $ functionParams2C params
-    n <- liftM render . id2C IOInsert $ setBaseType (BTFunction False bts t') name
+    n <- liftM render . id2C IOInsert $ setBaseType (BTFunction False external bts t') name
     let decor = if overload then text "__attribute__((overloadable))" else empty
     return [t empty <+> decor <+> text n <> parens p]
 
-fun2C True rv (FunctionDeclaration name@(Identifier i _) inline overload returnType params (Just (tvars, phrase))) = do
+fun2C True rv (FunctionDeclaration name@(Identifier i _) inline overload external returnType params (Just (tvars, phrase))) = do
     let isVoid = case returnType of
             VoidType -> True
             _ -> False
@@ -503,12 +503,12 @@
     --cu <- gets currentUnit
     notDeclared <- liftM isNothing . gets $ Map.lookup (map toLower i) . currentScope
 
-    n <- liftM render . id2C IOInsert $ setBaseType (BTFunction hasVars bts t') name
+    n <- liftM render . id2C IOInsert $ setBaseType (BTFunction hasVars external bts t') name
     let resultId = if isVoid
                     then n -- void type doesn't have result, solving recursive procedure calls
                     else (render res)
 
-    (p, ph) <- withState' (\st -> st{currentScope = Map.insertWith un (map toLower rv) [Record resultId (if isVoid then (BTFunction hasVars bts t') else t') empty] $ currentScope st
+    (p, ph) <- withState' (\st -> st{currentScope = Map.insertWith un (map toLower rv) [Record resultId (if isVoid then (BTFunction hasVars False bts t') else t') empty] $ currentScope st
             , currentFunctionResult = if isVoid then [] else render res}) $ do
         p <- functionParams2C params
         ph <- liftM2 ($+$) (typesAndVars2C False False True tvars) (phrase2C' phrase)
@@ -539,14 +539,14 @@
     un _ _ = error "fun2C u: pattern not matched"
     hasVars = hasPassByReference params
 
-fun2C False _ (FunctionDeclaration (Identifier name _) _ _ _ _ _) = error $ "nested functions not allowed: " ++ name
+fun2C False _ (FunctionDeclaration (Identifier name _) _ _ _ _ _ _) = error $ "nested functions not allowed: " ++ name
 fun2C _ tv _ = error $ "fun2C: I don't render " ++ show tv
 
 -- the second bool indicates whether declare variable as extern or not
 -- the third bool indicates whether include types or not
 -- the fourth bool indicates whether ignore initialization or not (basically for dynamic arrays since we cannot do initialization in function params)
 tvar2C :: Bool -> Bool -> Bool -> Bool -> TypeVarDeclaration -> State RenderState [Doc]
-tvar2C b _ includeType _ f@(FunctionDeclaration (Identifier name _) _ _ _ _ _) = do
+tvar2C b _ includeType _ f@(FunctionDeclaration (Identifier name _) _ _ _ _ _ _) = do
     t <- fun2C b name f
     if includeType then return t else return []
 tvar2C _ _ includeType _ (TypeDeclaration i' t) = do
@@ -612,7 +612,7 @@
 
 tvar2C f _ _ _ (OperatorDeclaration op (Identifier i _) inline ret params body) = do
     r <- op2CTyped op (extractTypes params)
-    fun2C f i (FunctionDeclaration r inline False ret params body)
+    fun2C f i (FunctionDeclaration r inline False False ret params body)
 
 
 op2CTyped :: String -> [TypeDecl] -> State RenderState Identifier
@@ -647,7 +647,7 @@
     ie <- initExpr2C' expr
     lt <- gets lastType
     case lt of
-        BTFunction True _ _ -> return $ text "&" <> ie -- <> text "__vars"
+        BTFunction True _ _ _ -> return $ text "&" <> ie -- <> text "__vars"
         _ -> return $ text "&" <> ie
 initExpr2C' (InitPrefixOp op expr) = liftM (text (op2C op) <>) (initExpr2C' expr)
 initExpr2C' (InitBinOp op expr1 expr2) = do
@@ -941,26 +941,26 @@
     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, BTAString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompareA" (BTFunction False [(False, t1), (False, t2)] BTBool))
+        ("+", BTAString, BTAString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcatA" (fff t1 t2 BTString))
+        ("+", BTAString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strappendA" (fff t1 t2  BTAString))
+        ("!=", BTAString, BTAString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompareA" (fff t1 t2  BTBool))
         (_, 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))
-        ("+", BTChar, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_chrconcat" (BTFunction False [(False, t1), (False, t2)] BTString))
-        ("==", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcomparec" (BTFunction False [(False, t1), (False, t2)] BTBool))
+        ("+", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcat" (fff t1 t2  BTString))
+        ("+", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strappend" (fff t1 t2  BTString))
+        ("+", BTChar, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strprepend" (fff t1 t2  BTString))
+        ("+", BTChar, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_chrconcat" (fff t1 t2  BTString))
+        ("==", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcomparec" (fff t1 t2  BTBool))
 
         -- for function/procedure comparision
         ("==", BTVoid, _) -> procCompare expr1 expr2 "=="
-        ("==", BTFunction _ _ _, _) -> procCompare expr1 expr2 "=="
+        ("==", BTFunction _ _ _ _, _) -> procCompare expr1 expr2 "=="
 
         ("!=", BTVoid, _) -> procCompare expr1 expr2 "!="
-        ("!=", BTFunction _ _ _, _) -> procCompare expr1 expr2 "!="
+        ("!=", BTFunction _ _ _ _, _) -> procCompare expr1 expr2 "!="
 
-        ("==", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcompare" (BTFunction False [(False, t1), (False, t2)] BTBool))
-        ("!=", BTString, _) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (BTFunction False [(False, t1), (False, t2)] BTBool))
+        ("==", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcompare" (fff t1 t2  BTBool))
+        ("!=", BTString, _) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (fff t1 t2  BTBool))
         ("&", BTBool, _) -> return $ parens e1 <+> text "&&" <+> parens e2
         ("|", BTBool, _) -> return $ parens e1 <+> text "||" <+> parens e2
         (_, BTRecord t1 _, BTRecord t2 _) -> do
@@ -992,6 +992,7 @@
                                 _ -> parens e2
                         return $ e1' <+> o' <+> e2'
     where
+        fff t1 t2 = BTFunction False False [(False, t1), (False, t2)]
         boolOps = ["==", "!=", "<", ">", "<=", ">="]
         procCompare expr1 expr2 op =
             case (expr1, expr2) of
@@ -1088,7 +1089,7 @@
     t <- gets lastType
     ps <- mapM expr2C params
     case t of
-        BTFunction _ _ t' -> do
+        BTFunction _ _ _ t' -> do
             modify (\s -> s{lastType = t'})
         _ -> error $ "BuiltInFunCall lastType: " ++ show t
     return $
@@ -1100,7 +1101,7 @@
     i <- id2C IOLookup name
     t <- gets lastType
     case t of
-         BTFunction _ _ rt -> do
+         BTFunction _ _ _ rt -> do
              modify(\s -> s{lastType = rt})
              return $ if addParens then i <> parens empty else i --xymeng: removed parens
          _ -> return $ i
@@ -1108,7 +1109,7 @@
     i <- ref2C r
     t <- gets lastType
     case t of
-         BTFunction _ _ rt -> do
+         BTFunction _ _ _ rt -> do
              modify(\s -> s{lastType = rt})
              return $ if addParens then i <> parens empty else i
          _ -> return $ i
@@ -1170,7 +1171,7 @@
     r <- fref2C ref
     t <- gets lastType
     case t of
-        BTFunction _ bts t' -> do
+        BTFunction _ _ bts t' -> do
             ps <- liftM (parens . hsep . punctuate (char ',')) $
                     if (length params) == (length bts) -- hot fix for pas2cSystem and pas2cRedo functions since they don't have params
                     then
@@ -1185,7 +1186,7 @@
     fref2C (SimpleReference name) = id2C (IOLookupFunction $ length params) name
     fref2C a = ref2C a
     expr2CHelper :: (Expression, (Bool, BaseType)) -> State RenderState Doc
-    expr2CHelper (e, (_, BTFunction _ _ _)) = do
+    expr2CHelper (e, (_, BTFunction _ _ _ _)) = do
         modify (\s -> s{isFunctionType = True})
         expr2C e
     expr2CHelper (e, (isVar, _)) = if isVar then liftM (((<>) $ text "&") . parens) $ (expr2C e) else expr2C e
@@ -1194,7 +1195,7 @@
     r <- ref2C ref
     lt <- gets lastType
     case lt of
-        BTFunction True _ _ -> return $ text "&" <> parens r
+        BTFunction True _ _ _ -> return $ text "&" <> parens r
         _ -> return $ text "&" <> parens r
 ref2C (TypeCast t'@(Identifier i _) expr) = do
     lt <- expr2C expr >> gets lastType
--- a/tools/pas2c/PascalParser.hs	Mon Feb 10 23:02:49 2014 +0400
+++ b/tools/pas2c/PascalParser.hs	Tue Feb 11 01:19:44 2014 +0400
@@ -329,11 +329,13 @@
         decorators <- many functionDecorator
         let inline = any (== "inline;") decorators
             overload = any (== "overload;") decorators
-        b <- if isImpl && (not forward) then
+            external = any (== "external;") decorators
+        -- TODO: don't mangle external functions names (and remove fpcrtl.h defines hacks)
+        b <- if isImpl && (not forward) && (not external) then
                 liftM Just functionBody
                 else
                 return Nothing
-        return $ [FunctionDeclaration i inline overload ret vs b]
+        return $ [FunctionDeclaration i inline overload external ret vs b]
 
     functionDecorator = do
         d <- choice [
@@ -342,7 +344,8 @@
             , try $ string "overload;"
             , try $ string "export;"
             , try $ string "varargs;"
-            , try (string' "external") >> comments >> iD >> optional (string' "name" >> comments >> stringLiteral pas) >> string' ";" >> return "external"
+            , try (string' "external") >> comments >> iD >> comments >>
+                optional (string' "name" >> comments >> stringLiteral pas) >> string' ";" >> return "external;"
             ]
         comments
         return d
--- a/tools/pas2c/PascalUnitSyntaxTree.hs	Mon Feb 10 23:02:49 2014 +0400
+++ b/tools/pas2c/PascalUnitSyntaxTree.hs	Tue Feb 11 01:19:44 2014 +0400
@@ -16,7 +16,7 @@
     deriving Show
 data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl
     | VarDeclaration Bool Bool ([Identifier], TypeDecl) (Maybe InitExpression)
-    | FunctionDeclaration Identifier Bool Bool TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase))
+    | FunctionDeclaration Identifier Bool Bool Bool TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase))
     | OperatorDeclaration String Identifier Bool TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase))
     deriving Show
 data TypeDecl = SimpleType Identifier
@@ -107,7 +107,7 @@
     | BTFloat
     | BTRecord String [(String, BaseType)]
     | BTArray Range BaseType BaseType
-    | BTFunction Bool [(Bool, BaseType)] BaseType -- (Bool, BaseType), Bool indiciates whether var or not
+    | BTFunction Bool Bool [(Bool, BaseType)] BaseType -- in (Bool, BaseType), Bool indiciates whether var or not
     | BTPointerTo BaseType
     | BTUnresolved String
     | BTSet BaseType