blob: c3d5f3f76a85d143195c68b9894629981e236990 [file] [log] [blame]
--
-- Copyright 2018, Data61
-- Commonwealth Scientific and Industrial Research Organisation (CSIRO)
-- ABN 41 687 119 230.
--
-- This software may be distributed and modified according to the terms of
-- the GNU General Public License version 2. Note that NO WARRANTY is provided.
-- See "LICENSE_GPLv2.txt" for details.
--
-- @TAG(DATA61_GPL)
--
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE DataKinds #-}
module Cogent.Dargent.CodeGen where
import Cogent.C.Monad
import Cogent.C.Type (genType, typeCId, simplifyType)
import Cogent.C.Syntax
import Cogent.Common.Syntax (FieldName, FunName, VarName, Size)
import Cogent.Common.Types (Sigil (..))
import Cogent.Compiler
( __fixme
, __impossible
, __todo
, __assert_
, Architecture (..)
, __cogent_arch
)
import Cogent.Core (Type (..))
import Cogent.Dargent.Allocation
import Cogent.Dargent.Core
( DataLayout' (..)
, DataLayout (..)
, alignLayout'
, alignLayoutToBytes'
, dataLayoutSizeInBytes'
)
import Cogent.Dargent.Util
import Data.Nat
import qualified Data.OMap as OMap
import Control.Monad.Writer.Class (tell)
import Data.List (foldl', scanl')
import Data.Map
( (!)
, fromList
, insert
)
import Lens.Micro
( (^.)
, at
, (&)
)
import Lens.Micro.GHC -- orphan instances for 'Micro.Lens.at'
import Lens.Micro.Mtl
( (%=)
, (?=)
, use
)
import Debug.Trace
-- * Getter/setter generation
{-|
Returns a getter/setter function C expression for a field of a boxed record.
Will generate the getter/setter function if it has not yet been generated
(ie. checks to see if it is already recorded in the GenState)
-}
genBoxedGetSetField
:: CogentType
-- ^ Cogent type of a boxed record.
-> FieldName
-- ^ Name of field in the boxed record to extract.
-> GetOrSet
-- ^ The type of function to generate
-> Gen v FunName
-- ^
-- The 'FunName' which is the name of the getter/setter function
-- for the field of the record.
genBoxedGetSetField cogentType fieldName getOrSet = do
boxedRecordGetterSetter <- use ((case getOrSet of Get -> boxedRecordGetters; Set -> boxedRecordSetters) . at (StrlCogentType cogentType, fieldName))
case boxedRecordGetterSetter of
Just getSetFieldFunction -> return getSetFieldFunction
Nothing ->
case cogentType of
TRecord _ fieldTypes (Boxed _ (Layout (RecordLayout fieldLayouts))) ->
do
let fieldType = fst $ (fromList fieldTypes) ! fieldName
fieldLayout = alignLayout' $ fieldLayouts ! fieldName
boxCType <- genType cogentType
cid <- typeCId cogentType
getSetFieldFunction <- genBoxedGetterSetter True boxCType fieldType fieldLayout [fieldName] getOrSet
((case getOrSet of Get -> boxedRecordGetters; Set -> boxedRecordSetters) . at (StrlCogentType cogentType, fieldName))
?= getSetFieldFunction
let updGS Get f (Nothing, s) = (Just f, s)
updGS Get f (Just g , s) = __assert_ (f == g) "genBoxedGetSetField: different getter for the same field" (Just g, s)
updGS Set f (g, Nothing) = (g, Just f)
updGS Set f (g, Just s ) = __assert_ (f == s) "genBoxedGetSetField: different setter for the same field" (g, Just s)
updSort (SRecord ss (Just as)) =
SRecord ss $ Just $ OMap.adjust (updGS getOrSet getSetFieldFunction) fieldName as -- it only updates the functions
typeCorres' %= (OMap.adjust updSort cid)
return getSetFieldFunction
TRecord _ fieldTypes (Boxed _ CLayout) ->
error "genBoxedGetSetField: tried to gen a getter/setter for a c-type"
{-|
Returns a getter/setter function C expression for a part of a boxed record.
Will always generate the getter/setter function and record it in the GenState.
-}
genBoxedGetterSetter
:: IsStruct
-- ^ Whether the c-type of the box is of struct or of byte-array
-> CType
-- ^
-- The CType for the root boxed type which contains
-- the embedded value that we would like to extract.
-> CogentType
-- ^ The Cogent type of the embedded value that we would like to extract
-> DataLayout' [AlignedBitRange]
-- ^
-- The part of the root boxed type's DataLayout corresponding to
-- the embedded value that we would like to extract.
-> [String]
-- ^ Path in structure to value being get or set, to create readable function name
-> GetOrSet
-- ^ Whether to generate a getter or a setter
-> Gen v FunName
-- ^
-- The 'FunName' is the name of the generated getter function
-- for the field of the record.
genBoxedGetterSetter isStruct boxType embeddedType@(TCon _ _ _) PrimLayout{bitsDL = bitRanges} path getOrSet =
genComposedAlignedRangeGetterSetter isStruct bitRanges boxType embeddedType path getOrSet
genBoxedGetterSetter isStruct boxType embeddedType@(TPrim _) (PrimLayout bitRanges) path getOrSet =
genComposedAlignedRangeGetterSetter isStruct bitRanges boxType embeddedType path getOrSet
genBoxedGetterSetter isStruct boxType embeddedType@(TRecord _ fields Boxed{}) (PrimLayout bitRanges) path getOrSet =
genComposedAlignedRangeGetterSetter isStruct bitRanges boxType embeddedType path getOrSet
genBoxedGetterSetter isStruct boxType embeddedTypeCogent@(TSum alternatives) SumLayout{tagDL, alternativesDL} path getOrSet = do
embeddedTypeC <- genType embeddedTypeCogent
functionName <- genGetterSetterName path getOrSet
tagGetterSetter <- genComposedAlignedRangeGetterSetter' isStruct tagDL boxType unsignedIntType (path ++ ["tag"]) getOrSet -- Must add check to restrict number of alternatives to MAX_INT)
alternativesGettersSetters <-
mapM
(\(alternativeName, (alternativeType, _)) -> do
let (boxedTagValue, alternativeLayout) = alternativesDL ! alternativeName
getterSetter <- genBoxedGetterSetter isStruct boxType alternativeType alternativeLayout (path ++ [alternativeName]) getOrSet
return (alternativeName, boxedTagValue, getterSetter)
)
alternatives
declareSetterOrGetter $ variantGetterSetter tagGetterSetter alternativesGettersSetters boxType embeddedTypeC functionName getOrSet
return functionName
genBoxedGetterSetter isStruct boxType embeddedTypeCogent@(TRecord _ fields Unboxed) RecordLayout{ fieldsDL } path getOrSet = do
embeddedTypeC <- genType embeddedTypeCogent
functionName <- genGetterSetterName path getOrSet
fieldGettersSetters <-
mapM
(\(fieldName, (fieldType, _)) -> do
let fieldLayout = fieldsDL ! fieldName
getterSetter <- genBoxedGetterSetter isStruct boxType fieldType fieldLayout (path ++ [fieldName]) getOrSet
return (fieldName, getterSetter)
)
fields
declareSetterOrGetter $ recordGetterSetter fieldGettersSetters boxType embeddedTypeC functionName getOrSet
return functionName
genBoxedGetterSetter isStruct boxType TUnit UnitLayout path getOrSet = do
functionName <- genGetterSetterName path getOrSet
declareSetterOrGetter $ unitGetterSetter boxType functionName getOrSet
return functionName
#ifdef BUILTIN_ARRAYS
genBoxedGetterSetter isStruct box tau@(TArray t l (Boxed {}) _) (PrimLayout ranges) path getOrSet =
genComposedAlignedRangeGetterSetter isStruct ranges box tau path getOrSet
#endif
genBoxedGetterSetter isStruct boxType tau range _ _ = do
traceM $ show tau ++ ", " ++ show range
__impossible $ "Cogent.Dargent.CodeGen: genBoxedGetterSetter: Type checking should restrict the types which can be embedded in boxed records, and ensure that the data layouts match the types."
#ifdef BUILTIN_ARRAYS
{-|
Returns a getter/setter function C expression for a part of a boxed array.
We want all layout definition aligned to bytes and we don't want padding bytes between elements,
thus we use bytearray here.
-}
genBoxedArrayGetSet
:: CogentType
-- ^
-- CogentType for the array.
-> GetOrSet
-- ^
-- The type of function to generate.
-> Gen v FunName
-- ^
-- The 'FunName' is the name of the getter/setter function
-- for the field of the record.
genBoxedArrayGetSet cogentType getOrSet = do
mf <- use ((case getOrSet of Get -> boxedArrayGetters; Set -> boxedArraySetters) . at cogentType)
case mf of
Just f -> return f
Nothing ->
case cogentType of
-- NOTE: do we need to check layout within elt here?
TArray elemType _ (Boxed _ (Layout (ArrayLayout elemLayout))) _ -> do
let elemSize = dataLayoutSizeInBytes' elemLayout
elemLayout' = alignLayoutToBytes' elemLayout
-- we get rid of unused info here, e.g. array length, hole location
f' <- genArrayGetterSetter cogentType elemType elemSize elemLayout' getOrSet
((case getOrSet of Get -> boxedArrayGetters; Set -> boxedArraySetters) . at (simplifyType cogentType))
?= f'
return f'
_ -> __impossible $
"Cogent.Dargent.CodeGen: genBoxedArrayGetSet: this function should only be called with boxed array with boxed types " ++
"with layout provided, check caller."
genArrayGetterSetter
:: CogentType
-> CogentType
-> Size
-> DataLayout' [AlignedBitRange]
-> GetOrSet
-> Gen v FunName
genArrayGetterSetter arrType elemType elemSize elemLayout' getOrSet = do
functionIdentifier <- genGetterSetterName [] getOrSet
arrCType <- genType arrType
elemCType <- genType elemType
elemGetterSetter <- genBoxedGetterSetter False (CPtr unsignedCharType) elemType elemLayout' [] getOrSet
((case getOrSet of Get -> boxedArrayElemGetters; Set -> boxedArrayElemSetters) . at (simplifyType arrType))
?= elemGetterSetter
declareSetterOrGetter $ arrayGetterSetter arrCType elemCType elemSize functionIdentifier elemGetterSetter getOrSet
return functionIdentifier
#endif
{-|
Declares in the Gen state a C function which gets/sets the contents
of a list of aligned bitranges in a boxed value which concatenate to
a value of the given embedded type.
Calls the function `composedAlignedRangeGetterSetter` to generate the function.
-}
genComposedAlignedRangeGetterSetter :: IsStruct -> [AlignedBitRange] -> CType -> CogentType -> [String] -> GetOrSet -> Gen v FunName
genComposedAlignedRangeGetterSetter isStruct bitRanges boxType embeddedTypeCogent path getOrSet = do
embeddedTypeC <- genType embeddedTypeCogent
genComposedAlignedRangeGetterSetter' isStruct bitRanges boxType embeddedTypeC path getOrSet
genComposedAlignedRangeGetterSetter' :: IsStruct -> [AlignedBitRange] -> CType -> CType -> [String] -> GetOrSet -> Gen v FunName
genComposedAlignedRangeGetterSetter' isStruct bitRanges boxType embeddedTypeC path getOrSet = do
functionName <- genGetterSetterName path getOrSet
rangesGetters <- mapM (\(range, index) -> genAlignedRangeGetterSetter isStruct boxType (path ++ ["part" ++ show index]) getOrSet range) (zip bitRanges [0..])
declareSetterOrGetter $ composedAlignedRangeGetterSetter (zip bitRanges rangesGetters) boxType embeddedTypeC functionName getOrSet
return functionName
{-|
Declares in the Gen state a C function to extract/set the contents of an
AlignedBitRange from/in a Cogent boxed type.
Calls the function `alignedRangeGetterSetter` to generate the function.
-}
genAlignedRangeGetterSetter :: IsStruct -> CType -> [String] -> GetOrSet -> AlignedBitRange -> Gen v FunName
genAlignedRangeGetterSetter isStruct boxType path getOrSet bitRange = do
functionIdentifier <- genGetterSetterName path getOrSet
declareSetterOrGetter $ alignedRangeGetterSetter isStruct boxType bitRange functionIdentifier getOrSet
return functionIdentifier
{-|
Generates a unique function name for the getter or setter which is also readable.
-}
genGetterSetterName
:: [String] -- ^ Path in structure to value being get or set
-> GetOrSet -- ^ Whether to generate a getter or setter function
-> Gen v CId -- ^ The CId for the function, which is guaranteed to be unique
genGetterSetterName path getOrSet =
let pathString = concatMap ('_' :) path
getOrSetString = (case getOrSet of Get -> "_get" ; Set -> "_set")
in (++ (getOrSetString ++ pathString)) <$> freshGlobalCId 'd'
-- * Getter/setter function declarations
{-|
Calling
@variantGetterSetter [(alt1, alt1TagValue, alt1Getter), ...] boxType embeddedType recordGetter Get@ will return
the C Syntax for the following function.
@
static inline embeddedType variantGetter(boxType p) {
return
(tagGetter(p) == alt1TagValue)
? (embeddedType)
{ .tag = TAG_ENUM_`alt1`
, .alt1 = alt1Getter(p);
}
: (tagGetter(p) == alt2TagValue)
? (embeddedType)
{ .tag = TAG_ENUM_`alt2`
, .alt2 = alt2Getter(p);
}
: ...
}
@
Calling
@variantGetterSetter [(alt0, alt0TagValue, alt0Setter), ...] boxType embeddedType recordSetter Set@ will return
the C Syntax for the following function.
@
static inline void variantSetter(boxType p, embeddedType v) {
if (v.tag == TAG_ENUM_`alt0`) {
tagSetter(p, alt0TagValue);
alt0Setter(p, v.alt0);
} else if (v.tag == TAG_ENUM_`alt1`) {
tagSetter(p, alt1TagValue);
alt1Setter(p, v.alt1);
} else if
...
}
}
@
-}
variantGetterSetter
:: FunName -- Name of the setter/getter function for the tag
-> [(CId, Integer, FunName)]
-- ^
-- ( Name of the alternative of the variant,
-- , Tag value for this alternative in the boxed structure
-- , Name of the getter/setter function for the alternative
-- )
-> CType
-- ^ The C type of the box.
-> CType
-- ^ The C type of the embedded data.
-> CId
-- ^ The name to give the generated getter function
-> GetOrSet
-- ^ Whether to generate a getter or setter
-> CExtDecl
-- ^ The C syntax tree for a function which extracts the embedded data from the box.
variantGetterSetter tagGetterSetter ((firstAltName, firstTagValue, firstAltGetterSetter) : otherAlts) boxType embeddedType functionName getOrSet =
getterSetterDecl boxType embeddedType functionName getOrSet
-- Get statements
[ CBIStmt $ CReturn $ Just $
foldl'
(\accumExpr (altName, tagValue, altGetter) ->
CCondExpr
(CBinOp
Eq
(CEFnCall (variable tagGetterSetter) [boxVariable])
(CConst $ CNumConst tagValue unsignedIntType DEC))
(getUnboxedAlt altName altGetter)
accumExpr
)
(getUnboxedAlt firstAltName firstAltGetterSetter)
otherAlts
]
-- Set statements
(if otherAlts == []
then (setUnboxedAlt firstAltName firstTagValue firstAltGetterSetter)
else
[CBIStmt $ foldl'
(\accumBlockItems (altName, tagValue, altGetter) ->
CIfStmt
(CBinOp
Eq
(CStructDot valueVariable fieldTag)
(variable $ tagEnum altName))
(CBlock $ setUnboxedAlt altName tagValue altGetter)
accumBlockItems
)
(CBlock $ setUnboxedAlt firstAltName firstTagValue firstAltGetterSetter)
otherAlts
]
)
where
getUnboxedAlt :: CId -> FunName -> CExpr
getUnboxedAlt altName altGetter =
CCompLit embeddedType
[ ([CDesignFld fieldTag], CInitE $ variable (tagEnum altName))
, ([CDesignFld altName] , CInitE $ CEFnCall (variable altGetter) [boxVariable])
]
setUnboxedAlt :: CId -> Integer -> FunName -> [CBlockItem]
setUnboxedAlt altName tagValue altSetter = fmap CBIStmt
[ CAssignFnCall Nothing (variable tagGetterSetter) [boxVariable, CConst $ CNumConst tagValue unsignedIntType DEC]
, CAssignFnCall Nothing (variable altSetter) [boxVariable, CStructDot valueVariable altName]
]
{-|
Calling
@recordGetterSetter [(field1, field1Getter), ...] boxType embeddedType recordGetter Get@ will return
the C Syntax for the following function.
@
static inline embeddedType recordGetter(boxType p) {
return (embeddedType)
{ .field1 = field1Getter(p)
, .field2 = field2Getter(p)
, ...
};
}
@
Calling
@recordGetterSetter [(field1, field1Setter), ...] boxType embeddedType recordSetter Set@ will return
the C Syntax for the following function.
@
static inline void recordSetter(boxType p, embeddedType v) {
field1Setter(p, v.field1);
field2Setter(p, v.field2);
...
}
@
-}
recordGetterSetter
:: [(CId, FunName)]
-- ^
-- ( Name of the field in the struct for the embedded data
-- , Name of the getter/setter function which will extract that field from the boxed data
-- )
-> CType
-- ^ The C type of the box.
-> CType
-- ^ The C type of the embedded data.
-> CId
-- ^ The name to give the generated getter/setter function
-> GetOrSet
-- ^ Whether to generate getter or setter
-> CExtDecl
-- ^ The C syntax tree for a function which puts/extracts the embedded data from the box.
recordGetterSetter fields boxType embeddedType functionName getOrSet =
getterSetterDecl boxType embeddedType functionName getOrSet
-- Get statements
[ CBIStmt $ CReturn $ Just $ CCompLit embeddedType $
fmap
(\(fieldName, fieldGetter) -> ([CDesignFld fieldName], CInitE $ CEFnCall (variable fieldGetter) [boxVariable]))
fields
]
-- Set statements
( fmap
(\(fieldName, fieldSetter) ->
CBIStmt $ CAssignFnCall Nothing (variable fieldSetter) [boxVariable, CStructDot valueVariable fieldName])
fields
)
unitGetterSetter
:: CType
-- ^ The C type of the box.
-> CId
-- ^ The name to give the generated getter/setter function
-> GetOrSet
-- ^ Whether to generate getter or setter
-> CExtDecl
-- ^ The C syntax tree for a function which puts/extracts the embedded data from the box.
unitGetterSetter boxType functionName getOrSet =
getterSetterDecl boxType unitType functionName getOrSet
-- Get statements
-- Not sure if need to initialise field of unit values to a given number
[ CBIStmt $ CReturn $ Just $
CCompLit unitType [([CDesignFld dummyField], CInitE $ CConst $ CNumConst 0 signedIntType DEC)]
]
-- Set statements
-- Intentionally empty
[]
{-|
Creates a C function which either:
* gets the contents of a list of aligned bitranges
out of a boxed value and concatenates the retrieved values
to produce a value of the given embedded value type.
* sets the contents of a list of aligned bitranges
in a boxed value from the pieces of a value of the given embedded value type.
@composedAlignedRangeGetter
((firstBitSize, firstGeterFunction) : bitRanges)
boxType
embeddedType
functionName
Get@
will return the C syntax for the C function
@
static inline `embeddedType` `functionName`(`boxType` p) {
return (`embeddedType`) (
(((`embeddedIntType`)`getBR0Identifier`(p)) << `0`) |
(((`embeddedIntType`)`getBR1Identifier`(p)) << `0 + firstBitSize`) |
(((`embeddedIntType`)`getBR2Identifier`(p)) << `0 + firstBitSize + secondBitSize`) |
...);
}
@
@composedAlignedRangeSetter
bitRanges
boxType
embeddedType
functionName
Set@
will return the C syntax for the C function
@
static inline void `functionName`(`boxType` b, `embeddedType` v) {
`setBR0Identifier`(b, (v >> `0`) & `bitSize0`);
`setBR1Identifier`(b, (v >> `0 + bitSize0`) & `bitSize1`);
`setBR2Identifier`(b, (v >> `0 + bitSize0 + bitSize1`) & `bitSize2`);
...
}
@
-}
composedAlignedRangeGetterSetter
:: [(AlignedBitRange, FunName)]
-- ^
-- The bit ranges and the 'FunName' which is
-- the name of the getter/setter function for the corresponding
-- bit range.
-> CType
-- ^ The C type of the box.
-> CType
-- ^ The C type of the embedded data.
-> CId
-- ^ The name to give the generated getter/setter function
-> GetOrSet
-- ^ Whether to generate a getter or setter
-> CExtDecl
-- ^ The C syntax tree for a function which extracts/puts the embedded data from/in the box.
composedAlignedRangeGetterSetter
bitRanges@((firstRange, firstGetterFunction) : bitRangesTail)
boxType
embeddedType
functionName
getOrSet
=
getterSetterDecl boxType embeddedType functionName getOrSet
-- Get statements
[ CBIStmt $ CReturn $ Just $ fromIntValue embeddedType $ snd $ foldl'
(\ (accumulatedBitOffset, accumulatedExpr) (range, rangeGetterFunction) ->
( accumulatedBitOffset + bitSizeABR range
, CBinOp Or accumulatedExpr
( genGetAlignedRangeAtBitOffset rangeGetterFunction accumulatedBitOffset )
)
)
(bitSizeABR firstRange, genGetAlignedRangeAtBitOffset firstGetterFunction 0)
bitRangesTail
]
-- Set statements
( fmap
(\((bitRange, setRangeFunction), offset) ->
CBIStmt (genSetAlignedRangeAtBitOffset setRangeFunction offset (bitSizeABR bitRange))
)
$ zip bitRanges
$ scanl' (+) 0
$ fmap (bitSizeABR . fst) bitRanges
)
where
-- If embeddedType is a boxed type, we cast valueVariable to the integer type of the correct size
-- If it is a boolean type, we extract the boolean value
valueExpression = toIntValue embeddedType valueVariable
{-
@genGetAlignedRangeAtBitOffset getRangeFunction offset@ will return the 'CExpr'
@
((`embeddedType`) `getRangeFunction`(b)) << `offset`
@
-}
genGetAlignedRangeAtBitOffset :: FunName -> Integer -> CExpr
genGetAlignedRangeAtBitOffset getRangeFunction offset =
CBinOp Lsh
( CTypeCast (intTypeForType embeddedType) (CEFnCall (variable getRangeFunction) [boxVariable]) )
( unsignedIntLiteral offset )
{-
@genSetAlignedRangeAtBitOffset setRangeFunction offset size@ will return the 'CExpr'
@
`setRangeFunction`(b, (unsigned int) ((v >> `offset`) & `size`))
@
-}
genSetAlignedRangeAtBitOffset :: FunName -> Integer -> Integer -> CStmt
genSetAlignedRangeAtBitOffset setRangeFunction offset size =
CAssignFnCall Nothing (variable setRangeFunction)
[ boxVariable
, CTypeCast
unsignedIntType
( CBinOp And
( CBinOp Rsh valueExpression (unsignedIntLiteral offset) )
( unsignedIntLiteral (sizeToMask size) )
)
]
composedAlignedRangeGetterSetter _ _ _ _ _ = __impossible $ "composedAlignedRangeGetter should never be called on an empty list of ranges!"
{-|
Creates a C function to extract/set the contents of an
AlignedBitRange from/in a Cogent boxed type.
@alignedRangeGetter boxType AlignedBitRange { bitSizeABR, bitOffsetABR, wordOffsetABR} functionNameIdentifier Get@
should be the C function
@
static inline unsigned int get`functionNameIdentifier`(`boxType` p) {
return (p.data[`wordOffsetABR`] >> `bitOffsetABR`) & `mask bitSizeABR`;
}
@
or
@
static inline unsigned int get`functionNameIdentifier`(char *p) {
return (p[`wordOffsetABR` * 4] >> `bitOffsetABR`) & `mask bitSizeABR`;
}
@
@alignedRangeSetter boxType AlignedBitRange { bitSizeABR, bitOffsetABR, wordOffsetABR} functionNameIdentifier Set@
should be the C function
@
static inline void set`functionNameIdentifier`(`boxType` p, unsigned int v) {
p->data[`wordOffsetABR`]
= p->data[`wordOffsetABR`]
// clear the bits
& ~(`sizeToMask bitSizeABR` << `bitOffsetABR`))
// set the bits
| ((`sizeToMask bitSizeABR` & v) << `bitOffsetABR`);
}
@
or
@
static inline void set`functionNameIdentifier`(char *p, unsigned int v) {
p[`wordOffsetABR` * 4]
= p[`wordOffsetABR` * 4]
& ~(`sizeToMask bitSizeABR` << `bitOffsetABR`)
| ((`sizeToMask bitSizeABR` & v) << `bitOffsetABR`);
}
@
-}
alignedRangeGetterSetter :: IsStruct -> CType -> AlignedBitRange -> CId -> GetOrSet -> CExtDecl
alignedRangeGetterSetter
isStruct
boxType
algnBR
functionName
getOrSet
=
getterSetterDecl boxType unsignedIntType functionName getOrSet
-- Get statements
[ CBIStmt $ CReturn $ Just
( CBinOp And
( CBinOp Rsh dataLocExpr bitOffsetLiteral )
maskLiteral
)
]
-- Set statements
[ CBIStmt
( CAssign
dataLocExpr
( CBinOp Or
( CBinOp And
dataLocExpr
( CUnOp Not ( CBinOp Lsh maskLiteral bitOffsetLiteral ) )
)
( CBinOp Lsh
( CBinOp And maskLiteral valueVariable )
bitOffsetLiteral
)
)
)
]
where
bitSizeABR' = bitSizeABR algnBR
bitOffsetABR' = bitOffsetABR algnBR
wordOffsetABR' = wordOffsetABR algnBR
bitOffsetLiteral = unsignedIntLiteral bitOffsetABR'
maskLiteral = unsignedIntMask $ sizeToMask bitSizeABR'
dataLocExpr = case isStruct of
True -> genBoxWordExpr boxVariable wordOffsetABR'
False -> CArrayDeref boxVariable (unsignedIntLiteral $ wordOffsetABR')
-- | Returns a function declaration for setter or getter.
getterSetterDecl
:: CType -- ^ Box type
-> CType -- ^ Embedded type
-> CId -- ^ Function name
-> GetOrSet -- ^ Whether to generate getter or setter
-> [CBlockItem] -- ^ Statements for getter
-> [CBlockItem] -- ^ Statements for setter
-> CExtDecl -- ^ The setter or getter function declaration
getterSetterDecl boxType embeddedType functionName Get getStatements _ =
( CFnDefn
( embeddedType, functionName ) -- (return type, function name)
[ ( boxType, boxIdentifier ) ] -- [(param type, param name)]
getStatements
staticInlineFnSpec
)
getterSetterDecl boxType embeddedType functionName Set _ setStatements =
( CFnDefn
( CVoid, functionName ) -- (return type, function name)
-- [(param type, param name)]
[ ( boxType, boxIdentifier )
, ( embeddedType, valueIdentifier )
]
setStatements
staticInlineFnSpec
)
arrayGetterSetter
:: CType
-> CType
-> Size
-> CId
-> FunName
-> GetOrSet
-> CExtDecl
arrayGetterSetter arrType elemType elemSize functionName elemGetterSetter Get =
( CFnDefn
( elemType, functionName ) -- (return type, function name)
-- [(param type, param name)]
[ ( arrType, arrIdentifier )
, ( unsignedIntType, idxIdentifier ) -- NOTE: type unverified
]
[ CBIStmt $ CReturn $ Just
( CEFnCall (variable elemGetterSetter)
[( CBinOp Add
( CTypeCast ( CPtr unsignedCharType ) arrVariable )
( CBinOp Mul idxVariable ( unsignedIntLiteral elemSize ) )
)]
)
]
staticInlineFnSpec
)
arrayGetterSetter arrType elemType elemSize functionName elemGetterSetter Set =
( CFnDefn
( CVoid, functionName ) -- (return type, function name)
-- [(param type, param name)]
[ ( arrType, arrIdentifier )
, ( unsignedIntType, idxIdentifier )
, ( elemType, valueIdentifier )
]
[ CBIStmt $ CReturn $ Just
( CEFnCall (variable elemGetterSetter)
[ ( CBinOp Add
( CTypeCast ( CPtr unsignedCharType ) arrVariable )
( CBinOp Mul idxVariable ( unsignedIntLiteral elemSize ) )
)
, valueVariable
]
)
]
staticInlineFnSpec
)
-- * Auxilliary functions, definitions and constants
-- | @sizeToMask n@ is an integer whose binary representation has
-- exactly @n@ 1s in the @2^0@ to @2^(n-1)@ places
sizeToMask :: Integer -> Integer
sizeToMask n
| 0 <= n && n <= wordSizeBits = 2^n - 1
| otherwise = __impossible $ "Dargent.CodeGen: sizeToMask " ++ show n ++ ": n not in range [0, " ++ show wordSizeBits ++ "] after alignment"
{-|
Saves the given setter or getter function
C syntax tree into the Gen state.
-}
declareSetterOrGetter :: CExtDecl -> Gen v ()
declareSetterOrGetter function = tell [function]
{-|
@genBoxWordExpr boxExpr wordOffset@
returns syntax for the 'CExpr'
@
`boxExpr`.data[`wordOffset`]
@
-}
genBoxWordExpr :: CExpr -> Integer -> CExpr
genBoxWordExpr boxExpr wordOffset =
CArrayDeref (CStructDot (CDeref boxExpr) boxFieldName) (unsignedIntLiteral wordOffset)
-- ALTERNATELY: CDeref ( CBinOp Add (CStructDot boxExpr "data") (unsignedIntLiteral wordOffset))
boxFieldName :: CId
boxFieldName = "data"
{- | The first parameter to all setters/getters -}
boxIdentifier = "b"
boxVariable = variable boxIdentifier
{- | The second parameter to setters -}
valueIdentifier = "v"
valueVariable = variable valueIdentifier
-- | Below for array related operations
arrIdentifier = "a"
arrVariable = variable arrIdentifier
idxIdentifier = "i"
idxVariable = variable idxIdentifier
-- | Produces a C expression for an unsigned integer literal with the given integer value.
unsignedIntLiteral :: Integer -> CExpr
unsignedIntLiteral n = CConst $ CNumConst n unsignedIntType DEC
unsignedIntMask :: Integer -> CExpr
unsignedIntMask n = CConst $ CNumConst n unsignedIntType (__fixme DEC) {- TODO: Change DEC to BIN. Requires implementing this in cLitConst function of Render.hs -}
unsignedLongType = CInt False CLongT
unsignedIntType = CInt False CIntT
unsignedCharType = CInt False CCharT
signedIntType = CInt True CIntT
unitType = CIdent unitT
tagType = CIdent tagsT
toIntValue :: CType -> CExpr -> CExpr
toIntValue (CInt _ _) cexpr = cexpr
toIntValue (CIdent t) cexpr
| t == boolT = CStructDot cexpr boolField
| t `elem` ["u8", "u16", "u32", "u64"] = cexpr
toIntValue _ cexpr = CTypeCast intTypeForPointer cexpr
fromIntValue :: CType -> CExpr -> CExpr
fromIntValue (CInt _ _) cexpr = cexpr
fromIntValue (CIdent t) cexpr
| t == boolT = CCompLit (CIdent boolT) [([CDesignFld boolField], CInitE cexpr)]
| t `elem` ["u8", "u16", "u32", "u64"] = cexpr
fromIntValue ctype cexpr = CTypeCast ctype cexpr
{-
Given the CType of an embedded value (leaf of composite type tree) to extract,
returns the corresponding integer type it should be extracted as before casting.
-}
intTypeForType :: CType -> CType
intTypeForType ctype@(CInt _ _) = ctype
intTypeForType (CIdent t)
| t == boolT = unsignedCharType-- embedded boolean
| t == tagsT = unsignedIntType
| t `elem` ["u8", "u16", "u32", "u64"] = CIdent t
intTypeForType _ = intTypeForPointer -- embedded boxed abstract type/record
type CogentType = Type 'Zero VarName
intTypeForPointer = case __cogent_arch of
X86_64 -> unsignedLongType
X86_32 -> unsignedIntType
ARM32 -> unsignedIntType
data GetOrSet = Get | Set
type IsStruct = Bool