suzanne.soy/tock-mirror
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Got the C++ backend working again, on the cgtests at least

Browse Source
This commit is contained in:
Neil Brown 2009-04-01 15:25:18 +00:00
parent e91c075bcf
commit e9730bfe1e
6 changed files with 100 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
backends/GenerateC.hs
View File

@ -670,9 +670,11 @@ cgenVariableWithAM checkValid v am fct
tell [")->data))"] tell [")->data))"]
, Pointer $ innerCT) , Pointer $ innerCT)
_ -> inner v _ -> inner v
inner (A.DirectedVariable _ dir v) inner wholeV@(A.DirectedVariable m dir v)
= do (cg, ct) <- inner v = do (cg, _) <- inner v
t <- astTypeOf v t <- astTypeOf v
wholeT <- astTypeOf wholeV
ct <- call getCType m wholeT A.Original
return (call genDirectedVariable m t cg dir, ct) return (call genDirectedVariable m t cg dir, ct)
inner (A.VariableSizes m (A.Variable _ n)) inner (A.VariableSizes m (A.Variable _ n))
= do t <- astTypeOf 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 -- Channel arrays are a special case, because they are arrays of pointers
-- to channels (so that an abbreviated array of channels, and an array -- to channels (so that an abbreviated array of channels, and an array
-- of abbreviations of channels, both look the same) -- of abbreviations of channels, both look the same)
(A.Array _ (A.Chan {}), _, False, _) (A.Array _ t@(A.Chan {}), _, False, _)
-> return $ Pointer $ Pointer $ Plain "Channel" -> call getCType m t A.Original >>* (Pointer . Pointer)
(A.Array _ (A.ChanEnd {}), _, False, _) (A.Array _ t@(A.ChanEnd {}), _, False, _)
-> return $ Pointer $ Pointer $ Plain "Channel" -> call getCType m t A.Original >>* (Pointer . Pointer)
-- All abbrev modes: -- All abbrev modes:
(A.Array _ t, _, False, _) (A.Array _ t, _, False, _)

14
backends/GenerateCBased.hs
View File

@ -242,7 +242,7 @@ data CType
= Plain String = Plain String
| Pointer CType | Pointer CType
| Const CType | Const CType
| Template String [CType] | Template String [Either CType A.Expression]
-- | Subscript CType -- | Subscript CType
deriving (Eq) deriving (Eq)
@ -250,7 +250,7 @@ instance Show CType where
show (Plain s) = s show (Plain s) = s
show (Pointer t) = show t ++ "*" show (Pointer t) = show t ++ "*"
show (Const t) = show t ++ " const" 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])" -- show (Subscript t) = "(" ++ show t ++ "[n])"
stripPointers :: CType -> CType stripPointers :: CType -> CType
@ -265,7 +265,11 @@ closeEnough t (Const t') = closeEnough t t'
closeEnough (Pointer t) (Pointer t') = closeEnough t t' closeEnough (Pointer t) (Pointer t') = closeEnough t t'
closeEnough (Plain s) (Plain s') = s == s' closeEnough (Plain s) (Plain s') = s == s'
closeEnough (Template wr cts) (Template wr' cts') 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 closeEnough _ _ = False
-- Given some code to generate, and its type, and the type that you actually want, -- 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) t'
dressUp m (gen, t) (Const t') dressUp m (gen, t) (Const t')
= dressUp m (gen, t) 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 (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 (tell ["*"] >> gen, t) t'
dressUp m (gen, t) t' dressUp m (gen, t) t'
= dieP m $ "Types cannot be brought together: " ++ show t ++ " and " ++ show t' = dieP m $ "Types cannot be brought together: " ++ show t ++ " and " ++ show t'

81
backends/GenerateCPPCSP.hs
View File

@ -650,20 +650,24 @@ cppgetScalarType _ = Nothing
-- | Changed from GenerateC to change the arrays and the channels -- | Changed from GenerateC to change the arrays and the channels
--Also changed to add counted arrays and user protocols --Also changed to add counted arrays and user protocols
cppgetCType :: Meta -> A.Type -> A.AbbrevMode -> CGen CType 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 cppgetCType m t am | isChan t
= do let (chanType, innerT) = case t of = do let (chanType, innerT, extra) = case t of
A.ChanEnd A.DirInput _ innerT -> ("csp::AltChanin", innerT) A.ChanEnd A.DirInput _ innerT -> ("csp::AltChanin", innerT, extraEnd)
A.ChanEnd A.DirOutput _ innerT -> ("csp::Chanout", innerT) A.ChanEnd A.DirOutput _ innerT -> ("csp::Chanout", innerT, extraEnd)
A.Chan attr innerT -> ( A.Chan attr innerT -> (
case (A.caWritingShared attr,A.caReadingShared attr) of case (A.caWritingShared attr,A.caReadingShared attr) of
(A.Unshared,A.Unshared) -> "csp::One2OneChannel" (A.Unshared,A.Unshared) -> "csp::One2OneChannel"
(A.Unshared,A.Shared) -> "csp::One2AnyChannel" (A.Unshared,A.Shared) -> "csp::One2AnyChannel"
(A.Shared,A.Unshared) -> "csp::Any2OneChannel" (A.Shared,A.Unshared) -> "csp::Any2OneChannel"
(A.Shared,A.Shared) -> "csp::Any2AnyChannel" (A.Shared,A.Shared) -> "csp::Any2AnyChannel"
, innerT) , innerT, extraChan)
innerCT <- cppTypeInsideChannel innerT innerCT <- cppTypeInsideChannel innerT
return $ Template chanType [innerCT] return $ extra $ Template chanType [Left innerCT]
where where
extraEnd = id
extraChan = if am == A.Original then id else Pointer
isChan :: A.Type -> Bool isChan :: A.Type -> Bool
isChan (A.Chan _ _) = True isChan (A.Chan _ _) = True
isChan (A.ChanEnd _ _ _) = True isChan (A.ChanEnd _ _ _) = True
@ -674,18 +678,75 @@ cppgetCType m t am | isChan t
cppTypeInsideChannel (A.Counted _ _) = return $ Plain "tockSendableArrayOfBytes" cppTypeInsideChannel (A.Counted _ _) = return $ Plain "tockSendableArrayOfBytes"
cppTypeInsideChannel (A.UserProtocol _) = return $ Plain "tockSendableArrayOfBytes" cppTypeInsideChannel (A.UserProtocol _) = return $ Plain "tockSendableArrayOfBytes"
cppTypeInsideChannel (A.Array ds t) cppTypeInsideChannel (A.Array ds t)
= do tell ["tockSendableArray<"] = do ct <- call getCType m t A.Original
ct <- call getCType m t A.Original
return $ Template "tockSendableArray" return $ Template "tockSendableArray"
[ct [Left ct
,Plain $ error "cppTypeInsideChannel-TODO" -- intersperse "*" [call genExpression n | A.Dimension n <- ds] ,Right $ foldl1 (A.Dyadic m A.Mul) [n | A.Dimension n <- ds]
] ]
cppTypeInsideChannel t = call getCType m t A.Original cppTypeInsideChannel t = call getCType m t A.Original
cppgetCType m (A.List t) am cppgetCType m (A.List t) am
= do ct <- call getCType m 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 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 :: A.Variable -> A.Expression -> CGen ()
cppgenListAssign v e cppgenListAssign v e
= do call genVariable v A.Original = do call genVariable v A.Original

16
support/tock_support.h
View File

@ -303,14 +303,14 @@ static inline int occam_check_retype (int src, int dest, const char *pos) {
} }
#define MAKE_STRINGTO(type, occname, flag) \ #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(occam_extra_param 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* error, type* n, const unsigned char* string) { \
*error = 1 != sscanf((const char*)string, flag, n); \ *error = 1 != sscanf((const char*)string, flag, n); \
} }
#define MAKE_STRINGTO_SMALL(type, occname, flag) \ #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(occam_extra_param 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* error, type* n, const unsigned char* string) { \
int t; \ int t; \
*error = 1 != sscanf((const char*)string, flag, &t) || (int)(type)t != t; \ *error = 1 != sscanf((const char*)string, flag, &t) || (int)(type)t != t; \
*n = (type)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_32 MAKE_STRINGTO
#define MAKE_STRINGTO_64 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(occam_extra_param 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* len, unsigned char* str, const BOOL b) {
if (b) { if (b) {
memcpy(str,"TRUE",4*sizeof(char)); memcpy(str,"TRUE",4*sizeof(char));
*len = 4; *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(occam_extra_param 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* error, BOOL* b, const unsigned char* str) {
if (memcmp("TRUE", str, 4*sizeof(char)) == 0) { if (memcmp("TRUE", str, 4*sizeof(char)) == 0) {
*b = true; *b = true;
*error = false; *error = false;

2
support/tock_support_cif.h
View File

@ -38,6 +38,8 @@
} while (0) } while (0)
//}}} //}}}
#define occam_extra_param Workspace wptr,
#include <tock_support.h> #include <tock_support.h>
//{{{ Process starting and stopping //{{{ Process starting and stopping

2
support/tock_support_cppcsp.h
View File

@ -38,6 +38,8 @@ public:
throw StopException(buffer); \ throw StopException(buffer); \
} while (0) } while (0)
#define occam_extra_param
#include <tock_support.h> #include <tock_support.h>
#include <cppcsp/cppcsp.h> #include <cppcsp/cppcsp.h>