Enforce that registers are either 8, 16, 32, or 64 bits.

Fixed the issues where the output C code did not use correct register
sizes.

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 $