tools/pas2c/Pas2C.hs
branchwebgl
changeset 8020 00b1facf2805
parent 8001 379063958821
child 8444 75db7bb8dce8
--- a/tools/pas2c/Pas2C.hs	Sun Nov 11 15:14:18 2012 +0100
+++ b/tools/pas2c/Pas2C.hs	Sun Nov 11 16:44:40 2012 +0100
@@ -42,10 +42,12 @@
         currentScope :: Records,
         lastIdentifier :: String,
         lastType :: BaseType,
+        isFunctionType :: Bool, -- set to true if the current function parameter is functiontype
         lastIdTypeDecl :: Doc,
         stringConsts :: [(String, String)],
         uniqCounter :: Int,
         toMangle :: Set.Set String,
+        enums :: [(String, [String])], -- store all declared enums
         currentUnit :: String,
         currentFunctionResult :: String,
         namespaces :: Map.Map String Records
@@ -53,7 +55,7 @@
 
 rec2Records = map (\(a, b) -> Record a b empty)
 
-emptyState = RenderState Map.empty "" BTUnknown empty [] 0 Set.empty "" ""
+emptyState = RenderState Map.empty "" BTUnknown False empty [] 0 Set.empty [] "" ""
 
 getUniq :: State RenderState Int
 getUniq = do
@@ -153,7 +155,6 @@
     toNamespace nss (Unit (Identifier i _) interface _ _ _) =
         currentScope $ execState (interface2C interface True) (emptyState nss){currentUnit = map toLower i ++ "_"}
 
-
 withState' :: (RenderState -> RenderState) -> State RenderState a -> State RenderState a
 withState' f sf = do
     st <- liftM f get
@@ -189,13 +190,38 @@
     toCFiles' (fn, (Unit unitId@(Identifier i _) interface implementation _ _)) = do
         let (a, s) = runState (id2C IOInsert (setBaseType BTUnit unitId) >> interface2C interface True) initialState{currentUnit = map toLower i ++ "_"}
             (a', s') = runState (id2C IOInsert (setBaseType BTUnit unitId) >> interface2C interface False) initialState{currentUnit = map toLower i ++ "_"}
-        writeFile (outputPath ++ fn ++ ".h") $ "#pragma once\n\n#include \"pas2c.h\"\n\n" ++ (render (a $+$ text ""))
-        writeFile (outputPath ++ fn ++ ".c") $ "#include \"fpcrtl.h\"\n\n#include \"" ++ fn ++ ".h\"\n" ++ render (a' $+$ text "") ++ (render2C s . implementation2C) implementation
+            enumDecl = (renderEnum2Strs (enums s) False)
+            enumImpl = (renderEnum2Strs (enums s) True)
+        writeFile (outputPath ++ fn ++ ".h") $ "#pragma once\n\n#include \"pas2c.h\"\n\n" ++ (render (a $+$ text "")) ++ "\n" ++ enumDecl
+        writeFile (outputPath ++ fn ++ ".c") $ "#include \"fpcrtl.h\"\n\n#include \"" ++ fn ++ ".h\"\n" ++ render (a' $+$ text "") ++ (render2C s . implementation2C) implementation ++ "\n" ++ enumImpl
     initialState = emptyState ns
 
     render2C :: RenderState -> State RenderState Doc -> String
-    render2C a = render . ($+$ empty) . flip evalState a
+    render2C st p =
+        let (a, s) = runState p st in
+        render a
 
+renderEnum2Strs :: [(String, [String])] -> Bool -> String
+renderEnum2Strs enums implement =
+    render $ foldl ($+$) empty $ map (\en -> let d = decl (fst en) in if implement then d $+$ enum2strBlock (snd en) else d <> semi) enums
+    where
+    decl id = text "string255 __attribute__((overloadable)) fpcrtl_GetEnumName" <> parens (text "int dummy, const" <+> text id <+> text "enumvar") 
+    enum2strBlock en = 
+            text "{"
+            $+$
+            (nest 4 $
+                text "switch(enumvar){"
+                $+$
+                (foldl ($+$) empty $ map (\e -> text "case" <+> text e <> colon $+$ (nest 4 $ text "return fpcrtl_make_string" <> (parens $ doubleQuotes $ text e) <> semi $+$ text "break;")) en)
+                $+$
+                text "default: assert(0);"
+                $+$
+                (nest 4 $ text "return fpcrtl_make_string(\"nonsense\");")
+                $+$
+                text "}"
+            )
+            $+$
+            text "}"
 
 usesFiles :: PascalUnit -> [String]
 usesFiles (Program _ (Implementation uses _) _) = ["pas2cSystem", "pas2cRedo"] ++ uses2List uses
@@ -209,7 +235,8 @@
 
 pascal2C (Program _ implementation mainFunction) = do
     impl <- implementation2C implementation
-    [main] <- tvar2C True False True True (FunctionDeclaration (Identifier "main" BTInt) False (SimpleType $ Identifier "int" BTInt) [VarDeclaration False False ([Identifier "argc" BTInt], SimpleType (Identifier "Integer" BTInt)) 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 (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
 
 
@@ -240,7 +267,7 @@
     where
         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
@@ -279,7 +306,7 @@
     tom <- gets (Set.member n . toMangle)
     cu <- gets currentUnit
     let (i', t') = case (t, tom) of
-            (BTFunction _ p _, True) -> (cu ++ i ++ ('_' : show p), t)
+            (BTFunction _ p _, True) -> (cu ++ i ++ ('_' : show (length p)), t)
             (BTFunction _ _ _, _) -> (cu ++ i, t)
             (BTVarParam t', _) -> ('(' : '*' : i ++ ")" , t')
             _ -> (i, t)
@@ -300,7 +327,7 @@
         let vv = fromMaybe (head $ fromJust v) . find checkParam $ fromJust v in
             modify (setLastIdValues vv) >> (return . text . lcaseId $ vv)
     where
-        checkParam (Record _ (BTFunction _ p _) _) = p == params
+        checkParam (Record _ (BTFunction _ p _) _) = (length p) == params
         checkParam _ = False
 id2C IODeferred (Identifier i t) = do
     let i' = map toLower i
@@ -321,6 +348,7 @@
         let vv = f $ fromJust v in modify (setLastIdValues vv) >> (return . text . lcaseId $ vv)
 
 
+
 id2CTyped :: TypeDecl -> Identifier -> State RenderState Doc
 id2CTyped = id2CTyped2 Nothing
 
@@ -340,14 +368,29 @@
                 Nothing -> id2C IOInsert (Identifier i tb)
                 Just ts -> id2C (IOInsertWithType ts) (Identifier i tb)
 
-
+typeVarDecl2BaseType :: [TypeVarDeclaration] -> State RenderState [(Bool, BaseType)]
+typeVarDecl2BaseType d = do
+    st <- get
+    result <- sequence $ concat $ map resolveType' d
+    put st -- restore state (not sure if necessary)
+    return result
+    where
+        resolveType' :: TypeVarDeclaration -> [State RenderState (Bool, BaseType)]
+        resolveType' (VarDeclaration isVar _ (ids, t) _) = replicate (length ids) (resolveTypeHelper' (resolveType t) isVar)
+        resolveType' _ = error "typeVarDecl2BaseType: not a VarDeclaration"
+        resolveTypeHelper' :: State RenderState BaseType -> Bool -> State RenderState (Bool, BaseType)
+        resolveTypeHelper' st b = do
+            bt <- st
+            return (b, bt)
+	
 resolveType :: TypeDecl -> State RenderState BaseType
 resolveType st@(SimpleType (Identifier i _)) = do
     let i' = map toLower i
     v <- gets $ Map.lookup i' . currentScope
     if isJust v then return . baseType . head $ fromJust v else return $ f i'
     where
-    f "integer" = BTInt
+    f "uinteger" = BTInt False
+    f "integer" = BTInt True
     f "pointer" = BTPointerTo BTVoid
     f "boolean" = BTBool
     f "float" = BTFloat
@@ -364,16 +407,18 @@
         f (VarDeclaration _ _ (ids, td) _) = mapM (\(Identifier i _) -> liftM ((,) i) $ resolveType td) ids
 resolveType (ArrayDecl (Just i) t) = do
     t' <- resolveType t
-    return $ BTArray i BTInt t'
-resolveType (ArrayDecl Nothing t) = liftM (BTArray RangeInfinite BTInt) $ resolveType t
-resolveType (FunctionType t a) = liftM (BTFunction False (length a)) $ resolveType t
-resolveType (DeriveType (InitHexNumber _)) = return BTInt
-resolveType (DeriveType (InitNumber _)) = return BTInt
+    return $ BTArray i (BTInt True) t'
+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
+resolveType (DeriveType (InitHexNumber _)) = return (BTInt True)
+resolveType (DeriveType (InitNumber _)) = return (BTInt True)
 resolveType (DeriveType (InitFloat _)) = return BTFloat
 resolveType (DeriveType (InitString _)) = return BTString
-resolveType (DeriveType (InitBinOp {})) = return BTInt
+resolveType (DeriveType (InitBinOp {})) = return (BTInt True)
 resolveType (DeriveType (InitPrefixOp _ e)) = initExpr2C e >> gets lastType
-resolveType (DeriveType (BuiltInFunction{})) = return BTInt
+resolveType (DeriveType (BuiltInFunction{})) = return (BTInt True)
 resolveType (DeriveType (InitReference (Identifier{}))) = return BTBool -- TODO: derive from actual type
 resolveType (DeriveType _) = return BTUnknown
 resolveType (String _) = return BTString
@@ -428,34 +473,34 @@
         ps = zip ['a'..] (toIsVarList params)
 
 fun2C :: Bool -> String -> TypeVarDeclaration -> State RenderState [Doc]
-fun2C _ _ (FunctionDeclaration name inline returnType params Nothing) = do
+fun2C _ _ (FunctionDeclaration name inline overload 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 hasVars (numberOfDeclarations params) t') name
-    let decor = if inline then text "inline" else empty
-    if hasVars then
-        return [funWithVarsToDefine n params $+$ decor <+> t empty <+> text (n ++ "__vars") <> parens p]
-        else
-        return [decor <+> t empty <+> text n <> parens p]
-    where
-        hasVars = hasPassByReference params
+    n <- liftM render . id2C IOInsert $ setBaseType (BTFunction False 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 returnType params (Just (tvars, phrase))) = do
-    let res = docToLower $ text rv <> text "_result"
-    t <- type2C returnType
-    t'<- gets lastType
-
-    notDeclared <- liftM isNothing . gets $ Map.lookup (map toLower i) . currentScope
-
-    n <- liftM render . id2C IOInsert $ setBaseType (BTFunction hasVars (numberOfDeclarations params) t') name
-
+fun2C True rv (FunctionDeclaration name@(Identifier i bt) inline overload returnType params (Just (tvars, phrase))) = do
     let isVoid = case returnType of
             VoidType -> True
             _ -> False
 
-    (p, ph) <- withState' (\st -> st{currentScope = Map.insertWith un (map toLower rv) [Record (render res) t' empty] $ currentScope st
+    let res = docToLower $ text rv <> if isVoid then empty else text "_result"
+    t <- type2C returnType
+    t' <- gets lastType
+
+    bts <- typeVarDecl2BaseType params
+    cu <- gets currentUnit
+    notDeclared <- liftM isNothing . gets $ Map.lookup (map toLower i) . currentScope
+
+    n <- liftM render . id2C IOInsert $ setBaseType (BTFunction hasVars 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
             , currentFunctionResult = if isVoid then [] else render res}) $ do
         p <- functionParams2C params
         ph <- liftM2 ($+$) (typesAndVars2C False False True tvars) (phrase2C' phrase)
@@ -463,12 +508,16 @@
 
     let phrasesBlock = if isVoid then ph else t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi
     let define = if hasVars then text "#ifndef" <+> text n $+$ funWithVarsToDefine n params $+$ text "#endif" else empty
-    let decor = if inline then text "inline" else empty
+    let inlineDecor = if inline then case notDeclared of
+                                    True -> text "static inline"
+                                    False -> text "inline"
+                          else empty
+        overloadDecor = if overload then text "__attribute__((overloadable))" else empty
     return [
-        define
-        $+$
+        --define
+        -- $+$
         --(if notDeclared && hasVars then funWithVarsToDefine n params else empty) $+$
-        decor <+> t empty <+> text (if hasVars then n ++ "__vars" else n) <> parens p
+        inlineDecor <+> t empty <+> overloadDecor <+> text n <> parens p
         $+$
         text "{"
         $+$
@@ -481,20 +530,25 @@
     un [a] b = a : b
     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 _ td@(TypeDeclaration i' t) = do
     i <- id2CTyped t i'
     tp <- type2C t
-    return $ if includeType then [text "typedef" <+> tp i] else []
+    let res = if includeType then [text "typedef" <+> tp i] else []
+    case t of
+        (Sequence ids) -> do
+            modify(\s -> s{enums = (render i, map (\(Identifier i _) -> i) ids) : enums s})
+            return res
+        _ -> return res
 
 tvar2C _ _ _ _ (VarDeclaration True _ (ids, t) Nothing) = do
     t' <- liftM ((empty <+>) . ) $ type2C t
@@ -508,7 +562,7 @@
     ie <- initExpr mInitExpr
     lt <- gets lastType
     case (isConst, lt, ids, mInitExpr) of
-         (True, BTInt, [i], Just _) -> do
+         (True, BTInt _, [i], Just _) -> do
              i' <- id2CTyped t i
              return $ if includeType then [text "enum" <> braces (i' <+> ie)] else []
          (True, BTFloat, [i], Just e) -> do
@@ -548,7 +602,7 @@
 
 tvar2C f _ _ _ (OperatorDeclaration op (Identifier i _) inline ret params body) = do
     r <- op2CTyped op (extractTypes params)
-    fun2C f i (FunctionDeclaration r inline ret params body)
+    fun2C f i (FunctionDeclaration r inline False ret params body)
 
 
 op2CTyped :: String -> [TypeDecl] -> State RenderState Identifier
@@ -583,14 +637,16 @@
     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
     e1 <- initExpr2C' expr1
     e2 <- initExpr2C' expr2
     return $ parens $ e1 <+> text (op2C op) <+> e2
-initExpr2C' (InitNumber s) = return $ text s
+initExpr2C' (InitNumber s) = do
+								modify(\s -> s{lastType = (BTInt True)})
+								return $ text s
 initExpr2C' (InitFloat s) = return $ text s
 initExpr2C' (InitHexNumber s) = return $ text "0x" <> (text . map toLower $ s)
 initExpr2C' (InitString [a]) = return . quotes $ text [a]
@@ -606,7 +662,7 @@
     t <- gets lastType
     case t of
          BTEnum s -> return . int $ length s
-         BTInt -> case i' of
+         BTInt _ -> case i' of
                        "byte" -> return $ int 256
                        _ -> error $ "InitRange identifier: " ++ i'
          _ -> error $ "InitRange: " ++ show r
@@ -716,7 +772,7 @@
     ps <- mapM phrase2C p
     return $ text "{" $+$ (nest 4 . vcat $ ps) $+$ text "}"
 phrase2C (ProcCall f@(FunCall {}) []) = liftM (<> semi) $ ref2C f
-phrase2C (ProcCall ref []) = liftM (<> semi) $ ref2CF ref
+phrase2C (ProcCall ref []) = liftM (<> semi) $ ref2CF ref True
 phrase2C (ProcCall ref params) = error $ "ProcCall"{-do
     r <- ref2C ref
     ps <- mapM expr2C params
@@ -815,7 +871,7 @@
         $$
         iType <+> iEnd <+> text "=" <+> e2 <> semi
         $$ 
-        text "if" <+> (parens $ i <+> text "<=" <+> iEnd) <+> text "do" <+> ph <+>
+        text "if" <+> (parens $ i <+> text (if up then "<=" else ">=") <+> iEnd) <+> text "do" <+> ph <+>
         text "while" <> parens (i <+> text "!=" <+> iEnd <+> text add) <> semi
     where
         appendPhrase p (Phrases ps) = Phrases $ ps ++ [p]
@@ -823,6 +879,7 @@
     e <- expr2C e'
     p <- phrase2C (Phrases p')
     return $ text "do" <+> p <+> text "while" <> parens (text "!" <> parens e) <> semi
+
 phrase2C NOP = return $ text ";"
 
 phrase2C (BuiltInFunctionCall [] (SimpleReference (Identifier "exit" BTUnknown))) = do
@@ -851,19 +908,27 @@
     e2 <- expr2C expr2
     t2 <- gets lastType
     case (op2C op, t1, t2) of
-        ("+", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcat" (BTFunction False 2 BTString))
-        ("+", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strappend" (BTFunction False 2 BTString))
-        ("+", BTChar, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strprepend" (BTFunction False 2 BTString))
-        ("+", BTChar, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_chrconcat" (BTFunction False 2 BTString))
-        ("==", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcomparec" (BTFunction False 2 BTBool))
-        ("==", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcompare" (BTFunction False 2 BTBool))
-        ("!=", BTString, _) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (BTFunction False 2 BTBool))
+        ("+", 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))
+
+        -- for function/procedure comparision
+        ("==", BTVoid, _) -> procCompare expr1 expr2 "=="
+        ("==", BTFunction _ _ _, _) -> procCompare expr1 expr2 "=="
+
+        ("!=", BTVoid, _) -> 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))
         ("&", BTBool, _) -> return $ parens e1 <+> text "&&" <+> parens e2
         ("|", BTBool, _) -> return $ parens e1 <+> text "||" <+> parens e2
         (_, BTRecord t1 _, BTRecord t2 _) -> do
             i <- op2CTyped op [SimpleType (Identifier t1 undefined), SimpleType (Identifier t2 undefined)]
             ref2C $ FunCall [expr1, expr2] (SimpleReference i)
-        (_, BTRecord t1 _, BTInt) -> do
+        (_, BTRecord t1 _, BTInt _) -> do
             -- aw, "LongInt" here is hwengine-specific hack
             i <- op2CTyped op [SimpleType (Identifier t1 undefined), SimpleType (Identifier "LongInt" undefined)]
             ref2C $ FunCall [expr1, expr2] (SimpleReference i)
@@ -882,16 +947,24 @@
                             "/(float)" -> text "/(float)" -- pascal returns real value
                             _ -> text o
                         e1' <- return $ case (o, t1, t2) of
-                                ("-", BTInt, BTInt) -> parens $ text "(int64_t)" <+> parens e1
+                                ("-", BTInt False, BTInt False) -> parens $ text "(int64_t)" <+> parens e1
                                 _ -> parens e1
                         e2' <- return $ case (o, t1, t2) of
-                                ("-", BTInt, BTInt) -> parens $ text "(int64_t)" <+> parens e2
+                                ("-", BTInt False, BTInt False) -> parens $ text "(int64_t)" <+> parens e2
                                 _ -> parens e2
                         return $ e1' <+> o' <+> e2'
     where
         boolOps = ["==", "!=", "<", ">", "<=", ">="]
+        procCompare expr1 expr2 op =
+            case (expr1, expr2) of
+                (Reference r1, Reference r2) -> do
+                    id1 <- ref2C r1
+                    id2 <- ref2C r2
+                    return $ (parens id1) <+> text op <+> (parens id2)
+                (_, _) -> error $ "Two non reference type vars are compared but they have type of BTVoid or BTFunction\n" ++ show expr1 ++ "\n" ++ show expr2
+
 expr2C (NumberLiteral s) = do
-    modify(\s -> s{lastType = BTInt})
+    modify(\s -> s{lastType = BTInt True})
     return $ text s
 expr2C (FloatLiteral s) = return $ text s
 expr2C (HexNumber s) = return $ text "0x" <> (text . map toLower $ s)
@@ -903,7 +976,10 @@
         escape a = [a]-}
 expr2C (StringLiteral s) = addStringConst s
 expr2C (PCharLiteral s) = return . doubleQuotes $ text s
-expr2C (Reference ref) = ref2CF ref
+expr2C (Reference ref) = do
+   isfunc <- gets isFunctionType
+   modify(\s -> s{isFunctionType = False}) -- reset
+   if isfunc then ref2CF ref False else ref2CF ref True
 expr2C (PrefixOp op expr) = do
     e <- expr2C expr
     lt <- gets lastType
@@ -929,7 +1005,7 @@
     lt <- gets lastType
     case lt of
          BTEnum a -> return $ int 0
-         BTInt -> case e' of
+         BTInt _ -> case e' of
                   "longint" -> return $ int (-2147483648)
          BTArray {} -> return $ int 0
          _ -> error $ "BuiltInFunCall 'low' from " ++ show e ++ "\ntype: " ++ show lt
@@ -938,18 +1014,20 @@
     lt <- gets lastType
     case lt of
          BTEnum a -> return . int $ length a - 1
-         BTInt -> case e' of
+         BTInt _ -> case e' of
                   "longint" -> return $ int (2147483647)
          BTString -> return $ int 255
          BTArray (RangeFromTo _ n) _ _ -> initExpr2C n
          _ -> error $ "BuiltInFunCall 'high' from " ++ show e ++ "\ntype: " ++ show lt
 expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "ord" _))) = liftM parens $ expr2C e
 expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "succ" _))) = liftM (<> text " + 1") $ expr2C e
-expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "pred" _))) = liftM (<> text " - (int64_t)1") $ expr2C e
+expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "pred" _))) = do
+    e'<- expr2C e
+    return $ text "(int)" <> parens e' <> text " - 1"
 expr2C (BuiltInFunCall [e] (SimpleReference (Identifier "length" _))) = do
     e' <- expr2C e
     lt <- gets lastType
-    modify (\s -> s{lastType = BTInt})
+    modify (\s -> s{lastType = BTInt True})
     case lt of
          BTString -> return $ text "fpcrtl_Length" <> parens e'
          BTArray RangeInfinite _ _ -> error $ "length() called on variable size array " ++ show e'
@@ -967,24 +1045,24 @@
         r <> parens (hsep . punctuate (char ',') $ ps)
 expr2C a = error $ "Don't know how to render " ++ show a
 
-ref2CF :: Reference -> State RenderState Doc
-ref2CF (SimpleReference name) = do
+ref2CF :: Reference -> Bool -> State RenderState Doc
+ref2CF (SimpleReference name) addParens = do
     i <- id2C IOLookup name
     t <- gets lastType
     case t of
          BTFunction _ _ rt -> do
              modify(\s -> s{lastType = rt})
-             return $ i <> parens empty --xymeng: removed parens
+             return $ if addParens then i <> parens empty else i --xymeng: removed parens
          _ -> return $ i
-ref2CF r@(RecordField (SimpleReference _) (SimpleReference _)) = do
+ref2CF r@(RecordField (SimpleReference _) (SimpleReference _)) addParens = do
     i <- ref2C r
     t <- gets lastType
     case t of
          BTFunction _ _ rt -> do
              modify(\s -> s{lastType = rt})
-             return $ i <> parens empty
+             return $ if addParens then i <> parens empty else i 
          _ -> return $ i
-ref2CF r = ref2C r
+ref2CF r _ = ref2C r
 
 ref2C :: Reference -> State RenderState Doc
 -- rewrite into proper form
@@ -1040,22 +1118,31 @@
     r <- fref2C ref
     t <- gets lastType
     case t of
-        BTFunction _ _ t' -> do
-            ps <- liftM (parens . hsep . punctuate (char ',')) $ mapM expr2C params
+        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 
+                        mapM expr2CHelper (zip params bts)
+                    else mapM expr2C params
             modify (\s -> s{lastType = t'})
             return $ 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
+                  _ -> error $ "ref2C FunCall erroneous type cast detected: " ++ show f ++ "\nType detected: " ++ show t ++ "\n" ++ show ref ++ "\n" ++ show params ++ "\n" ++ show t
     where
     fref2C (SimpleReference name) = id2C (IOLookupFunction $ length params) name
     fref2C a = ref2C a
+    expr2CHelper :: (Expression, (Bool, BaseType)) -> State RenderState Doc
+    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
 
 ref2C (Address ref) = do
     r <- ref2C ref
     lt <- gets lastType
     case lt of
-        BTFunction True _ _ -> return $ text "&" <> parens (r <> text "__vars")
+        BTFunction True _ _ -> return $ text "&" <> parens r
         _ -> return $ text "&" <> parens r
 ref2C (TypeCast t'@(Identifier i _) expr) = do
     lt <- expr2C expr >> gets lastType