1 files changed, 58 insertions, 0 deletions
diff --git a/SHARC/Word48.hs b/SHARC/Word48.hs
new file mode 100644
index 0000000..42e1075
--- /dev/null
+++ b/SHARC/Word48.hs
@@ -0,0 +1,58 @@
+{-
+  This file is part of shark-disassembler.
+
+  Copyright (C) 2014 Ricardo Wurmus
+
+  This program is free software: you can redistribute it and/or modify
+  it under the terms of the GNU General Public License as published by
+  the Free Software Foundation, either version 3 of the License, or
+  (at your option) any later version.
+
+  This program is distributed in the hope that it will be useful,
+  but WITHOUT ANY WARRANTY; without even the implied warranty of
+  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+  GNU General Public License for more details.
+
+  You should have received a copy of the GNU General Public License
+  along with this program.  If not, see <http://www.gnu.org/licenses/>.
+-}
+
+module SHARC.Word48 where
+
+import           Text.Printf (printf)
+import           Data.Word (Word8, Word64)
+import           Data.Bits ((.&.), (.|.), shiftL, shiftR, testBit)
+import           Data.Binary.Get
+import           Control.Monad (replicateM)
+
+data Word48 = Word48 (Word8, Word8, Word8, Word8, Word8, Word8)
+instance Show Word48 where
+  show (Word48 (a,b,c,d,e,f)) =
+    unwords $ map (printf "0x%02X") [a,b,c,d,e,f]
+
+unpackWord8Word48 :: [Word8] -> Word48
+unpackWord8Word48 [a,b,c,d,e,f] = Word48 (f,e,d,c,b,a)
+
+getWord48 :: ([Word8] -> Word48) -> Get Word48
+getWord48 p = fmap p $ replicateM 6 getWord8
+
+getPackedWord48 :: Get Word48
+getPackedWord48 = getWord48 unpackWord8Word48
+
+word48ToWord64 :: Word48 -> Word64
+word48ToWord64 (Word48 (a,b,c,d,e,f)) = fromIntegral a `shiftL` 40 .|.
+                                        fromIntegral b `shiftL` 32 .|.
+                                        fromIntegral c `shiftL` 24 .|.
+                                        fromIntegral d `shiftL` 16 .|.
+                                        fromIntegral e `shiftL`  8 .|.
+                                        fromIntegral f
+
+-- apply mask and shift result to the very right
+-- TODO: find a laxer type signature
+cutMask :: Integral n => Word64 -> Word64 -> n
+cutMask w mask = fromIntegral . fst $ until p shifter (w .&. mask, mask)
+  where
+    -- shift word by as much as we need to shift the mask to the very right
+    p (x, mask') = mask' `testBit` 0
+    shifter (x, m) = (x `shiftR` 1, m `shiftR` 1)
+