From e9730bfe1efe691e26c8b4e7459288c784aa2a06 Mon Sep 17 00:00:00 2001 From: Neil Brown Date: Wed, 1 Apr 2009 15:25:18 +0000 Subject: [PATCH] Got the C++ backend working again, on the cgtests at least --- backends/GenerateC.hs | 14 +++--- backends/GenerateCBased.hs | 14 +++--- backends/GenerateCPPCSP.hs | 81 ++++++++++++++++++++++++++++++----- support/tock_support.h | 16 +++---- support/tock_support_cif.h | 2 + support/tock_support_cppcsp.h | 2 + 6 files changed, 100 insertions(+), 29 deletions(-) diff --git a/backends/GenerateC.hs b/backends/GenerateC.hs index 0b495f3..d18e70c 100644 --- a/backends/GenerateC.hs +++ b/backends/GenerateC.hs @@ -670,9 +670,11 @@ cgenVariableWithAM checkValid v am fct tell [")->data))"] , Pointer $ innerCT) _ -> inner v - inner (A.DirectedVariable _ dir v) - = do (cg, ct) <- inner v + inner wholeV@(A.DirectedVariable m dir v) + = do (cg, _) <- inner v t <- astTypeOf v + wholeT <- astTypeOf wholeV + ct <- call getCType m wholeT A.Original return (call genDirectedVariable m t cg dir, ct) inner (A.VariableSizes m (A.Variable _ n)) = do t <- astTypeOf n @@ -780,10 +782,10 @@ cgetCType m origT am -- Channel arrays are a special case, because they are arrays of pointers -- to channels (so that an abbreviated array of channels, and an array -- of abbreviations of channels, both look the same) - (A.Array _ (A.Chan {}), _, False, _) - -> return $ Pointer $ Pointer $ Plain "Channel" - (A.Array _ (A.ChanEnd {}), _, False, _) - -> return $ Pointer $ Pointer $ Plain "Channel" + (A.Array _ t@(A.Chan {}), _, False, _) + -> call getCType m t A.Original >>* (Pointer . Pointer) + (A.Array _ t@(A.ChanEnd {}), _, False, _) + -> call getCType m t A.Original >>* (Pointer . Pointer) -- All abbrev modes: (A.Array _ t, _, False, _) diff --git a/backends/GenerateCBased.hs b/backends/GenerateCBased.hs index d9b446d..fde4ce9 100644 --- a/backends/GenerateCBased.hs +++ b/backends/GenerateCBased.hs @@ -242,7 +242,7 @@ data CType = Plain String | Pointer CType | Const CType - | Template String [CType] + | Template String [Either CType A.Expression] -- | Subscript CType deriving (Eq) @@ -250,7 +250,7 @@ instance Show CType where show (Plain s) = s show (Pointer t) = show t ++ "*" show (Const t) = show t ++ " const" - show (Template wr cts) = wr ++ "<" ++ concat (intersperse "," $ map show cts) ++ ">/**/" + show (Template wr cts) = wr ++ "<" ++ concat (intersperse "," $ map (either show show) cts) ++ ">/**/" -- show (Subscript t) = "(" ++ show t ++ "[n])" stripPointers :: CType -> CType @@ -265,7 +265,11 @@ closeEnough t (Const t') = closeEnough t t' closeEnough (Pointer t) (Pointer t') = closeEnough t t' closeEnough (Plain s) (Plain s') = s == s' closeEnough (Template wr cts) (Template wr' cts') - = wr == wr' && length cts == length cts' && and (zipWith closeEnough cts cts') + = wr == wr' && length cts == length cts' && and (zipWith closeEnough' cts cts') + where + closeEnough' (Left ct) (Left ct') = closeEnough ct ct' + closeEnough' (Right _) (Right _) = True -- can't really check + closeEnough' _ _ = False closeEnough _ _ = False -- Given some code to generate, and its type, and the type that you actually want, @@ -279,9 +283,9 @@ dressUp m (gen, Const t) t' = dressUp m (gen, t) t' dressUp m (gen, t) (Const t') = dressUp m (gen, t) t' -dressUp m (gen, t@(Plain {})) (Pointer t') +dressUp m (gen, t) (Pointer t') = dressUp m (tell ["&"] >> gen, t) t' -dressUp m (gen, Pointer t) t'@(Plain {}) +dressUp m (gen, Pointer t) t' = dressUp m (tell ["*"] >> gen, t) t' dressUp m (gen, t) t' = dieP m $ "Types cannot be brought together: " ++ show t ++ " and " ++ show t' diff --git a/backends/GenerateCPPCSP.hs b/backends/GenerateCPPCSP.hs index c3fe27b..a05157f 100644 --- a/backends/GenerateCPPCSP.hs +++ b/backends/GenerateCPPCSP.hs @@ -650,20 +650,24 @@ cppgetScalarType _ = Nothing -- | Changed from GenerateC to change the arrays and the channels --Also changed to add counted arrays and user protocols cppgetCType :: Meta -> A.Type -> A.AbbrevMode -> CGen CType +cppgetCType m (A.Array _ t@(A.ChanEnd {})) _ = call getCType m t A.Original >>* Pointer cppgetCType m t am | isChan t - = do let (chanType, innerT) = case t of - A.ChanEnd A.DirInput _ innerT -> ("csp::AltChanin", innerT) - A.ChanEnd A.DirOutput _ innerT -> ("csp::Chanout", innerT) + = do let (chanType, innerT, extra) = case t of + A.ChanEnd A.DirInput _ innerT -> ("csp::AltChanin", innerT, extraEnd) + A.ChanEnd A.DirOutput _ innerT -> ("csp::Chanout", innerT, extraEnd) A.Chan attr innerT -> ( case (A.caWritingShared attr,A.caReadingShared attr) of (A.Unshared,A.Unshared) -> "csp::One2OneChannel" (A.Unshared,A.Shared) -> "csp::One2AnyChannel" (A.Shared,A.Unshared) -> "csp::Any2OneChannel" (A.Shared,A.Shared) -> "csp::Any2AnyChannel" - , innerT) + , innerT, extraChan) innerCT <- cppTypeInsideChannel innerT - return $ Template chanType [innerCT] + return $ extra $ Template chanType [Left innerCT] where + extraEnd = id + extraChan = if am == A.Original then id else Pointer + isChan :: A.Type -> Bool isChan (A.Chan _ _) = True isChan (A.ChanEnd _ _ _) = True @@ -674,18 +678,75 @@ cppgetCType m t am | isChan t cppTypeInsideChannel (A.Counted _ _) = return $ Plain "tockSendableArrayOfBytes" cppTypeInsideChannel (A.UserProtocol _) = return $ Plain "tockSendableArrayOfBytes" cppTypeInsideChannel (A.Array ds t) - = do tell ["tockSendableArray<"] - ct <- call getCType m t A.Original + = do ct <- call getCType m t A.Original return $ Template "tockSendableArray" - [ct - ,Plain $ error "cppTypeInsideChannel-TODO" -- intersperse "*" [call genExpression n | A.Dimension n <- ds] + [Left ct + ,Right $ foldl1 (A.Dyadic m A.Mul) [n | A.Dimension n <- ds] ] cppTypeInsideChannel t = call getCType m t A.Original cppgetCType m (A.List t) am = do ct <- call getCType m t am - return $ Template "tockList" [ct] + return $ Template "tockList" [Left ct] +--cppgetCType m (A.Array _ t) am | isChan t +-- = cal cppgetCType m t am = cgetCType m t am +{- +cgetCType :: Meta -> A.Type -> A.AbbrevMode -> CGen CType +cgetCType m origT am + = do (isMobile, t) <- unwrapMobileType origT + sc <- fget getScalarType >>* ($ t) + case (t, sc, isMobile, am) of + -- Channel arrays are a special case, because they are arrays of pointers + -- to channels (so that an abbreviated array of channels, and an array + -- of abbreviations of channels, both look the same) + (A.Array _ (A.Chan {}), _, False, _) + -> return $ Pointer $ Pointer $ Plain "Channel" + (A.Array _ (A.ChanEnd {}), _, False, _) + -> return $ Pointer $ Pointer $ Plain "Channel" + + -- All abbrev modes: + (A.Array _ t, _, False, _) + -> call getCType m t A.Original >>* (Pointer . const) + (A.Array {}, _, True, A.Abbrev) -> return $ Pointer $ Pointer $ Plain "mt_array_t" + (A.Array {}, _, True, _) -> return $ Pointer $ Plain "mt_array_t" + (A.Record n, _, False, A.Original) -> return $ Plain $ nameString n + -- Abbrev and ValAbbrev, and mobile: + (A.Record n, _, False, _) -> return $ Const . Pointer $ const $ Plain $ nameString n + (A.Record n, _, True, A.Abbrev) -> return $ Pointer $ Pointer $ Plain $ nameString n + (A.Record n, _, True, _) -> return $ Pointer $ const $ Plain $ nameString n + + (A.Chan (A.ChanAttributes A.Shared A.Shared) _, _, False, _) + -> return $ Pointer $ Plain "mt_cb_t" + (A.ChanEnd _ A.Shared _, _, False, _) -> return $ Pointer $ Plain "mt_cb_t" + + (A.Chan {}, _, False, A.Original) -> return $ Plain "Channel" + (A.Chan {}, _, False, _) -> return $ Pointer $ Plain "Channel" + (A.ChanEnd {}, _, False, _) -> return $ Pointer $ Plain "Channel" + + (A.ChanDataType {}, _, _, _) -> return $ Pointer $ Plain "mt_cb_t" + + -- Scalar types: + (_, Just pl, False, A.Original) -> return $ Plain pl + (_, Just pl, False, A.Abbrev) -> return $ Const $ Pointer $ Plain pl + (_, Just pl, False, A.ValAbbrev) -> return $ Const $ Plain pl + + -- Mobile scalar types: + (_, Just pl, True, A.Original) -> return $ Pointer $ Plain pl + (_, Just pl, True, A.Abbrev) -> return $ Pointer $ Pointer $ Plain pl + (_, Just pl, True, A.ValAbbrev) -> return $ Pointer $ Const $ Plain pl + + -- This shouldn't happen, but no harm: + (A.UserDataType {}, _, _, _) -> do t' <- resolveUserType m t + cgetCType m t' am + + -- Must have missed one: + (_,_,_,am) -> diePC m $ formatCode ("Cannot work out the C type for: % (" + ++ show (origT, am) ++ ")") origT + where + const = if am == A.ValAbbrev then Const else id + +-} cppgenListAssign :: A.Variable -> A.Expression -> CGen () cppgenListAssign v e = do call genVariable v A.Original diff --git a/support/tock_support.h b/support/tock_support.h index bd5433a..0dd5002 100644 --- a/support/tock_support.h +++ b/support/tock_support.h @@ -303,14 +303,14 @@ static inline int occam_check_retype (int src, int dest, const char *pos) { } #define MAKE_STRINGTO(type, occname, flag) \ - static inline void occam_STRINGTO##occname(Workspace, BOOL*, type*, const unsigned char*) occam_unused; \ - static inline void occam_STRINGTO##occname(Workspace wptr, BOOL* error, type* n, const unsigned char* string) { \ + static inline void occam_STRINGTO##occname(occam_extra_param BOOL*, type*, const unsigned char*) occam_unused; \ + static inline void occam_STRINGTO##occname(occam_extra_param BOOL* error, type* n, const unsigned char* string) { \ *error = 1 != sscanf((const char*)string, flag, n); \ } #define MAKE_STRINGTO_SMALL(type, occname, flag) \ - static inline void occam_STRINGTO##occname(Workspace, BOOL*, type*, const unsigned char*) occam_unused; \ - static inline void occam_STRINGTO##occname(Workspace wptr, BOOL* error, type* n, const unsigned char* string) { \ + static inline void occam_STRINGTO##occname(occam_extra_param BOOL*, type*, const unsigned char*) occam_unused; \ + static inline void occam_STRINGTO##occname(occam_extra_param BOOL* error, type* n, const unsigned char* string) { \ int t; \ *error = 1 != sscanf((const char*)string, flag, &t) || (int)(type)t != t; \ *n = (type)t; \ @@ -322,8 +322,8 @@ static inline int occam_check_retype (int src, int dest, const char *pos) { #define MAKE_STRINGTO_32 MAKE_STRINGTO #define MAKE_STRINGTO_64 MAKE_STRINGTO -static inline void occam_BOOLTOSTRING(Workspace, INT*, unsigned char*, const BOOL) occam_unused; -static inline void occam_BOOLTOSTRING(Workspace wptr, INT* len, unsigned char* str, const BOOL b) { +static inline void occam_BOOLTOSTRING(occam_extra_param INT*, unsigned char*, const BOOL) occam_unused; +static inline void occam_BOOLTOSTRING(occam_extra_param INT* len, unsigned char* str, const BOOL b) { if (b) { memcpy(str,"TRUE",4*sizeof(char)); *len = 4; @@ -333,8 +333,8 @@ static inline void occam_BOOLTOSTRING(Workspace wptr, INT* len, unsigned char* s } } -static inline void occam_STRINGTOBOOL(Workspace, BOOL*, BOOL*, const unsigned char*) occam_unused; -static inline void occam_STRINGTOBOOL(Workspace wptr, BOOL* error, BOOL* b, const unsigned char* str) { +static inline void occam_STRINGTOBOOL(occam_extra_param BOOL*, BOOL*, const unsigned char*) occam_unused; +static inline void occam_STRINGTOBOOL(occam_extra_param BOOL* error, BOOL* b, const unsigned char* str) { if (memcmp("TRUE", str, 4*sizeof(char)) == 0) { *b = true; *error = false; diff --git a/support/tock_support_cif.h b/support/tock_support_cif.h index 517fb60..15209ae 100644 --- a/support/tock_support_cif.h +++ b/support/tock_support_cif.h @@ -38,6 +38,8 @@ } while (0) //}}} +#define occam_extra_param Workspace wptr, + #include //{{{ Process starting and stopping diff --git a/support/tock_support_cppcsp.h b/support/tock_support_cppcsp.h index 2cd23da..f6ad741 100644 --- a/support/tock_support_cppcsp.h +++ b/support/tock_support_cppcsp.h @@ -38,6 +38,8 @@ public: throw StopException(buffer); \ } while (0) +#define occam_extra_param + #include #include