diff options
Diffstat (limited to 'src/Language/Fiddle/Compiler/Backend/C.hs')
| -rw-r--r-- | src/Language/Fiddle/Compiler/Backend/C.hs | 42 |
1 files changed, 26 insertions, 16 deletions
diff --git a/src/Language/Fiddle/Compiler/Backend/C.hs b/src/Language/Fiddle/Compiler/Backend/C.hs index 26ea065..77eadf6 100644 --- a/src/Language/Fiddle/Compiler/Backend/C.hs +++ b/src/Language/Fiddle/Compiler/Backend/C.hs @@ -273,7 +273,8 @@ writeRegGet }, regFullPath = fullPath } - ) docComms = do + ) + docComms = do let fnName = qualifiedPathToIdentifier fullPath <> "__get" returnType = sizeToType size fieldName = basenamePart fullPath @@ -313,7 +314,8 @@ writeRegSet }, regFullPath = fullPath } - ) docComs = do + ) + docComs = do let fnName = qualifiedPathToIdentifier fullPath <> "__set" setType = sizeToType size fieldName = basenamePart fullPath @@ -370,16 +372,18 @@ pattern DefinedBitsP modifier bitsName bitsFullPath offset typeRef annot <- writeBitsGet :: StructName -> - String -> + QRegMetadata True -> QualifiedPath String -> N Bits -> RegisterBitsTypeRef 'Checked I A -> A -> M SIntf -writeBitsGet structName regName fullPath offset typeRef docComms = do +writeBitsGet structName regmeta fullPath offset typeRef docComms = do let fnName = qualifiedPathToIdentifier fullPath <> "__get" bitsName = basenamePart fullPath retType = typeRefBaseType typeRef + regName = basenamePart (regFullPath regmeta) + regCType = getRegCType regmeta text $ "inline static " <> retType <> " " text fnName @@ -404,13 +408,13 @@ writeBitsGet structName regName fullPath offset typeRef docComms = do withIndent $ do if null shiftArguments then do - text "unsigned shift_ = 0" + text $ regCType <> " shift_ = 0" else do - text "unsigned shift_ = " + text $ regCType <> " shift_ = " text $ Text.intercalate " + " shiftArguments text ";\n" - text "unsigned mask_ = " + text $ regCType <> " mask_ = " text $ typeRefToGetMask typeRef text " << shift_;\n" @@ -467,18 +471,26 @@ writeBitsGet structName regName fullPath offset typeRef docComms = do num = (1 `Data.Bits.shiftL` fromIntegral sz) - 1 in "0x" <> Text.pack (showHex num "") +getRegCType :: QRegMetadata True -> Text +getRegCType meta = + Text.pack $ + fromMaybe "unsigned" $ + sizeToType (size (unwrap (regSpan meta))) + writeBitsSet :: Bool -> StructName -> - String -> + QRegMetadata True -> QualifiedPath String -> N Bits -> RegisterBitsTypeRef 'Checked I A -> A -> M SIntf -writeBitsSet writeOnly structName regName fullPath offset typeRef docComms = do +writeBitsSet writeOnly structName regmeta fullPath offset typeRef docComms = do let fnName = qualifiedPathToIdentifier fullPath <> "__set" bitsName = basenamePart fullPath + regName = basenamePart (regFullPath regmeta) + regCType = getRegCType regmeta text "inline static void " text fnName @@ -498,10 +510,10 @@ writeBitsSet writeOnly structName regName fullPath offset typeRef docComms = do withIndent $ do let mask = typeRefToMask typeRef - text $ "unsigned mask_ = " <> mask <> ";\n" + text $ regCType <> " mask_ = " <> mask <> ";\n" unless (null shiftArguments) $ do text $ - "unsigned shift_ = " <> Text.intercalate " + " shiftArguments <> ";\n" + regCType <> " shift_ = " <> Text.intercalate " + " shiftArguments <> ";\n" text "mask_ <<= shift_;\n" text "int to_set_ = value" @@ -512,7 +524,7 @@ writeBitsSet writeOnly structName regName fullPath offset typeRef docComms = do text "to_set_ &= mask_;\n" unless writeOnly $ do - text $ "unsigned current_ = o->" <> Text.pack regName <> ";\n" + text $ regCType <> " current_ = o->" <> Text.pack regName <> ";\n" text "to_set_ = current_ ^ (current_ & mask_) ^ to_set_;\n" text $ "o->" <> Text.pack regName <> " = to_set_;\n" @@ -614,8 +626,6 @@ writeRegisterBody :: StructName -> QRegMetadata True -> RegisterBody Checked I A -> M SIntf writeRegisterBody structName regmeta = execWriterT . walk_ registerWalk where - regName = basenamePart (regFullPath regmeta) - registerWalk :: forall t. (Walk t, Typeable t) => @@ -632,8 +642,8 @@ writeRegisterBody structName regmeta = execWriterT . walk_ registerWalk sequence_ $ selectByModifier modifier - ( tell =<< lift (writeBitsGet structName regName fullPath offset typeRef annot), - tell =<< lift (writeBitsSet isWo structName regName fullPath offset typeRef annot) + ( tell =<< lift (writeBitsGet structName regmeta fullPath offset typeRef annot), + tell =<< lift (writeBitsSet isWo structName regmeta fullPath offset typeRef annot) ) -- text $ -- Text.pack $ |