crackNum-2.3/0000755000000000000000000000000013373711632011315 5ustar0000000000000000crackNum-2.3/crackNum.cabal0000644000000000000000000000265313373711632014052 0ustar0000000000000000Name: crackNum Version: 2.3 Synopsis: Crack various integer, floating-point data formats Description: Crack HP, SP and DP floats and 8, 16, 32, 64 bit words and integers. . For details, please see: License: BSD3 License-file: LICENSE Author: Levent Erkok Homepage: http://github.com/LeventErkok/CrackNum Maintainer: erkokl@gmail.com Copyright: Levent Erkok Category: Tools Build-type: Simple Cabal-version: 1.14 Extra-Source-Files: INSTALL, README.md, COPYRIGHT, CHANGES.md, crackNum.vim source-repository head type: git location: git://github.com/LeventErkok/crackNum.git Executable crackNum main-is : Data/Numbers/CrackNum/Main.hs ghc-options : -Wall default-language: Haskell2010 build-depends: base >= 4 && < 5, array >= 0.4.0.1, FloatingHex >= 0.4 other-modules: Data.Numbers.CrackNum , Data.Numbers.CrackNum.Utils , Data.Numbers.CrackNum.Data , Paths_crackNum Library ghc-options : -Wall default-language: Haskell2010 Build-Depends : base >= 4 && < 5, array >= 0.4.0.1, FloatingHex >= 0.4 Exposed-modules : Data.Numbers.CrackNum other-modules : Data.Numbers.CrackNum.Utils , Data.Numbers.CrackNum.Data crackNum-2.3/INSTALL0000644000000000000000000000015613373711632012350 0ustar0000000000000000The crackNum library can be installed simply by issuing cabal install like this: cabal install crackNum crackNum-2.3/Setup.hs0000644000000000000000000000070513373711632012753 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Main -- Copyright : (c) Levent Erkok -- License : BSD3 -- Maintainer : erkokl@gmail.com -- Stability : experimental -- -- Setup module for crackNum ----------------------------------------------------------------------------- {-# OPTIONS_GHC -Wall #-} module Main(main) where import Distribution.Simple main :: IO () main = defaultMain crackNum-2.3/LICENSE0000644000000000000000000000305713373711632012327 0ustar0000000000000000crackIEEE754: Cracking various Floating/Integer values Copyright (c) 2015-2016, Levent Erkok (erkokl@gmail.com) All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the developer (Levent Erkok) nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL LEVENT ERKOK BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. crackNum-2.3/README.md0000644000000000000000000001055013373711632012575 0ustar0000000000000000## CrackNum: Decode/Encode IEE754 Numbers [![Hackage version](http://img.shields.io/hackage/v/crackNum.svg?label=Hackage)](http://hackage.haskell.org/package/crackNum) [![Build Status](http://img.shields.io/travis/LeventErkok/crackNum.svg?label=Build)](http://travis-ci.org/LeventErkok/crackNum) CrackNum now comes with vim bindings, see http://github.com/LeventErkok/crackNum/blob/master/crackNum.vim ### Command line options: crackNum v2.3, (c) Levent Erkok. Released with a BSD3 license. Usage: crackNum precision bit/hex-pattern --hp 16 bit half precision --sp 32 bit single precision --dp 64 bit double precision --sb 8 bit signed byte --sw 16 bit signed word --sd 32 bit signed double --sq 64 bit signed quad --ub 8 bit unsigned byte --uw 16 bit unsigned word --ud 32 bit unsigned double --uq 64 bit unsigned quad --toIEEE=n Convert from decimal to IEEE SP/DP formats. -l n --lanes=n number of lanes --vim output in vim friendly format -h, -? --help print help, with examples -v --version print version info Examples: crackNum --hp fc00 crackNum --sp fc00 abcd crackNum --dp fc00 abc1 2345 6789 crackNum --sp 01111111110000000000000000000000 crackNum -l2 --hp 01111111110000000000000000000000 crackNum --sb 7f crackNum --sp --toIEEE=-2.3e6 crackNum --dp --toIEEE=max crackNum --dp --toIEEE=ulp Notes: - You can use hexadecimal or binary as input. - You can use _,- or space as a digit to improve readability. - You can give input for multiple lanes, we will guess the #of lanes for you. Or, you can specify number of lanes with the -l option. - For "toIEEE" option (case doesn't matter): - You can enter a number in decimal notation (like 2.3) - You can enter a number in hexadecimal notation (like 0x1.abcp+3) - OR, enter one of the following: * infinity, -infinity: Positive/Negative infinities * nan, snan, qnan: Not-A-Number; signaling/quiet * 0, -0: Both kinds of zeros * max : The maximum finite positive value * -max: The minimum finite negative value * min : The minimum normal positive value * -min: The maximum normal negative value * epsilon: The smallest possible value x s.t. 1+x /= 1. * ulp: The minimum subnormal value ### Example: Decoding single-precision numbers on two lanes $ crackNum --sp fc00 abc1 7F80 0001 == Lane: 1 ========================================== 3 2 1 0 1 09876543 21098765432109876543210 S ---E8--- ----------F23---------- Binary: 1 11111000 00000001010101111000001 Hex: FC00 ABC1 Precision: SP Sign: Negative Exponent: 121 (Stored: 248, Bias: 127) Hex-float: -0x1.015782p121 Value: -2.6723903e36 (NORMAL) == Lane: 0 ========================================== 3 2 1 0 1 09876543 21098765432109876543210 S ---E8--- ----------F23---------- Binary: 0 11111111 00000000000000000000001 Hex: 7F80 0001 Precision: SP Sign: Positive Exponent: 128 (Stored: 255, Bias: 127) Hex-float: NaN (Signaling) Value: NaN (Signaling) Note: Representation for NaN's is not unique. ### Example: Encoding a float as a IEEE754 single-precision bit-pattern $ crackNum --sp --toIEEE=-2.3e6 3 2 1 0 1 09876543 21098765432109876543210 S ---E8--- ----------F23---------- Binary: 1 10010100 00011000110000110000000 Hex: CA0C 6180 Precision: SP Sign: Negative Exponent: 21 (Stored: 148, Bias: 127) Hex-float: -0x1.18c3p21 Value: -2300000.0 (NORMAL) crackNum-2.3/CHANGES.md0000644000000000000000000000411713373711632012712 0ustar0000000000000000* Hackage: * GitHub: * Latest Hackage released version: 2.3, 2018-11-17 ### Version 2.3, 2018-11-17 * Remove dependency on the ieee754 and reinterpret-cast packages. The goal is to remove any FFI dependencies. We now define and export the required utilities directly in the CrackNum package. ### Version 2.2, 2018-09-01 * Instead of data-binary-ieee754, use reinterpret-cast package. According to documents, the former is deprecated. ### Version 2.1, 2018-07-20 * Support for vi-editor bindings. See the file "crackNum.vim" in the distribution or in the github repo You can put "so ~/.vim/crackNum.vim" (use the correct path!) and have vi crack numbers directly from inside your editor. Simply locate your cursor on a binary/hex stream of digits and type ":CrackNum". See the "crackNum.vim" file for binding details. ### Version 2.0, 2018-03-17 * Import FloatingHex qualified to avoid GHC 8.4.1 compilation issue ### Version 1.9, 2017-01-22 * Minor fix to printing of +/-0 ### Version 1.8, 2017-01-15 * Bump up FloatingHex dependency to >0.4, this enables proper support for large doubles ### Version 1.7, 2017-01-14 * Fix a snafu in reading hexadecimal floats ### Version 1.6, 2017-01-14 * Add support for hexadecimal-floats. These now work both in toIEEE option as input, and also when printing the values out. (i.e., numbers of the form 0x1.abp-3, etc.) ### Version 1.5, 2016-01-23 * Typo fixes; no functionality changes ### Version 1.4, 2016-01-17 * Fix NaN nomenclature: Screaming->Signaling * Add an example to README.md ### Version 1.3, 2015-04-11 * Fix docs, github location ### Version 1.2, 2015-04-11 * Fix the constant qnan values for SP/DP * Add conversions from float/double. Much easier to use. * Better handling of nan values. ### Version 1.1, 2015-04-02 * Clean-up the API, examples etc. ### Version 1.0, 2015-04-01 * First implementation. Supports HP/SP/DP and signed/unsigned numbers in 8/16/32/64 bits. crackNum-2.3/COPYRIGHT0000644000000000000000000000026013373711632012606 0ustar0000000000000000Copyright (c) 2015-2016, Levent Erkok (erkokl@gmail.com) All rights reserved. The crackIEEE754 library is distributed with the BSD3 license. See the LICENSE file for details. crackNum-2.3/crackNum.vim0000644000000000000000000000506313373711632013601 0ustar0000000000000000"""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""""" " VI interface to crackNum " " Copyright : (c) Levent Erkok " License : BSD3 " Maintainer : erkokl@gmail.com " " INSTALLATION: Put this file in a convenient location (typically your .vim directory), " and put "so crackNum.vim" in your .vimrc file. (With the appropriate path.) " " Once you restart vim, locate your cursor over a stream of binary/hex digits, and " enter the command :CrackNum to see further options. " " See https://github.com/LeventErkok/CrackNum for details. let g:crackNumPrecisions = ["hp","sp","dp","sb","sw","sd","sq","ub","uw","ud","uq"] function! CrackNumComplete(A, L, P) if empty(a:A) return g:crackNumPrecisions else let out = filter(copy(g:crackNumPrecisions), 'v:val =~ "^' . a:A . '.*"') if empty(out) return g:crackNumPrecisions else return out endif endfunction function! CrackNum(...) redraw let curWord = expand("") if empty(curWord) echoerr "Place the cursor on a bin/hex number to crack!" return endif if empty(a:000) echo "Cracking \"" . curWord . "\".. Use TAB to see precisions supported." call inputsave() let prec = input("Precision> ", "", "customlist,CrackNumComplete") call inputrestore() let args = [prec] + copy(a:000) else echo "Cracking \"" . curWord . "\".." let prec = a:1 let args = copy(a:000) endif if index(g:crackNumPrecisions, prec) < 0 echoerr "Unknown precision: \"" . prec . "\"" . ". Must be one of: " . join(g:crackNumPrecisions, ' ') return endif let l:grepargs = join(['--vim'] + copy(args) + ['--bv', curWord], ' ') let grepprg_bak=&grepprg let grepformat_bak=&grepformat try let &grepprg="crackNum" let &grepformat="VIM %m" silent execute "grep" . " " . l:grepargs finally let &grepprg=grepprg_bak let &grepformat=grepformat_bak endtry botright copen redraw! endfunction command! -nargs=* -complete=customlist,CrackNumComplete CrackNum call CrackNum() map @nhp :silent call CrackNum('hp') map @nsp :silent call CrackNum('sp') map @ndp :silent call CrackNum('dp') map @nsb :silent call CrackNum('sb') map @nsw :silent call CrackNum('sw') map @nsd :silent call CrackNum('sd') map @nsq :silent call CrackNum('sq') map @nub :silent call CrackNum('ub') map @nuw :silent call CrackNum('uw') map @nud :silent call CrackNum('ud') map @nuq :silent call CrackNum('uq') " end crackNum interface crackNum-2.3/Data/0000755000000000000000000000000013373711632012166 5ustar0000000000000000crackNum-2.3/Data/Numbers/0000755000000000000000000000000013373711632013601 5ustar0000000000000000crackNum-2.3/Data/Numbers/CrackNum.hs0000644000000000000000000003100013373711632015632 0ustar0000000000000000--------------------------------------------------------------------------- -- | -- Module : Data.Numbers.CrackNum -- Copyright : (c) Levent Erkok -- License : BSD3 -- Maintainer : erkokl@gmail.com -- Stability : experimental -- -- A library for formatting/analyzing FP and Integer values ----------------------------------------------------------------------------- {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NamedFieldPuns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Data.Numbers.CrackNum ( -- * Internal representation of a Floating-point numbers FP(..), Precision(..), IPrecision(..), Kind(..) -- * Creating FP values , floatToFP, doubleToFP, stringToFP, integerToFP -- * Displaying FP and Int/Word values , displayFP, displayWord -- * Converting between floats and bit-representations , floatToWord, wordToFloat, doubleToWord, wordToDouble ) where import Data.Bits (testBit, setBit, Bits) import Data.Char (toLower) import Data.Int (Int8, Int16, Int32, Int64) import Data.List (intercalate) import Data.Maybe (isJust, fromJust, fromMaybe, catMaybes) import Numeric import Data.Numbers.CrackNum.Data import Data.Numbers.CrackNum.Utils import qualified Data.Numbers.FloatingHex as FH import Data.Word (Word32, Word64) import Data.Array.ST (newArray, readArray, MArray, STUArray) import Data.Array.Unsafe (castSTUArray) import GHC.ST (runST, ST) -- | Crack a Haskell Integer value as the given precision floating value. The Integer should -- be the value corresponding to the bit-pattern as the float is laid out in memory according -- to the IEEE rules. integerToFP :: Precision -> Integer -> FP integerToFP HP = crack HP 15 15 [14, 13 .. 10] [9, 8 .. 0] integerToFP SP = crack SP 127 31 [30, 29 .. 23] [22, 21 .. 0] integerToFP DP = crack DP 1023 63 [62, 61 .. 52] [51, 50 .. 0] -- | Use Haskell Float to represent SP spVal :: Bool -> Int -> [Bool] -> Float spVal dn expVal fracBits = ((2::Float) ** fromIntegral expVal) * add1 frac where frac = sum $ zipWith (\b i -> if b then (2::Float)**(-(fromIntegral (i::Int))) else 0) fracBits [1..] add1 | dn = id | True = (1+) -- | Use Haskell Double to represent DP dpVal :: Bool -> Int -> [Bool] -> Double dpVal dn expVal fracBits = ((2::Double) ** fromIntegral expVal) * add1 frac where frac = sum $ zipWith (\b i -> if b then (2::Double)**(-(fromIntegral (i::Int))) else 0) fracBits [1..] add1 | dn = id | True = (1+) -- | Assemble a FP from the given bits and pieces. crack :: Precision -> Int -> Int -> [Int] -> [Int] -> Integer -> FP crack vPrec vBias signPos expPos fracPos val = FP { intVal = val , prec = vPrec , sign = vSign , stExpt = vStoredExp , expt = vStoredExp - curBias , bias = curBias , fracBits = vFracBits , bitLayOut = layOut [[vSign], vExpBits, vFracBits] , kind = vKind } where bit i = val `testBit` i vSign = bit signPos vExpBits = map bit expPos vStoredExp = bv vExpBits vFracBits = map bit fracPos isZero = all0 vExpBits && all0 vFracBits isDenormal = all0 vExpBits && any1 vFracBits isInfinity = all1 vExpBits && all0 vFracBits isNAN = all1 vExpBits && any1 vFracBits vKind | isZero = Zero vSign | isInfinity = Infty vSign | isNAN = if head vFracBits then QNaN else SNaN | isDenormal = Denormal | True = Normal curBias = case vKind of Denormal -> vBias - 1 _ -> vBias -- | Display a Floating-point number in a nicely formatted way. (This function is also available -- through the 'Show' instance for 'FP', but is provided here for symmetry with 'displayWord'.) displayFP :: FP -> String displayFP FP{intVal, prec, sign, stExpt, bias, expt, fracBits, bitLayOut, kind} = intercalate "\n" ls where ls = [ " " ++ inds1 , " " ++ inds2 , " " ++ inds3 , " Binary: " ++ bitLayOut , " Hex: " ++ hexDisp allBits , " Precision: " ++ show prec , " Sign: " ++ if sign then "Negative" else "Positive" , " Exponent: " ++ show expt ++ " (Stored: " ++ show stExpt ++ ", Bias: " ++ show bias ++ ")" , " Hex-float: " ++ hexVal , " Value: " ++ val ] ++ [ " Note: Representation for NaN's is not unique." | isNaNKind kind] (inds1, inds2, inds3) = case prec of HP -> (hpInds1, hpInds2, hpInds3) SP -> (spInds1, spInds2, spInds3) DP -> (dpInds1, dpInds2, dpInds3) allBits = case prec of HP -> [intVal `testBit` i | i <- startsAt 15] SP -> [intVal `testBit` i | i <- startsAt 31] DP -> [intVal `testBit` i | i <- startsAt 63] where startsAt n = [n, n-1 .. 0] dup x = (x, x) (val, hexVal) = case kind of Zero False -> ("+0.0", "0x0p+0") Zero True -> ("-0.0", "-0x0p+0") Infty False -> dup "+Infinity" Infty True -> dup "-Infinity" SNaN -> dup "NaN (Signaling)" QNaN -> dup "NaN (Quietized)" Denormal -> nval True " (DENORMAL)" Normal -> nval False " (NORMAL)" nval dn tag = (s ++ vd ++ tag, s ++ vh) where s = if sign then "-" else "+" vd = case prec of HP -> showGFloat Nothing (spVal dn expt fracBits) "" SP -> showGFloat Nothing (spVal dn expt fracBits) "" DP -> showGFloat Nothing (dpVal dn expt fracBits) "" vh = case prec of HP -> FH.showHFloat (spVal dn expt fracBits) "" SP -> FH.showHFloat (spVal dn expt fracBits) "" DP -> FH.showHFloat (dpVal dn expt fracBits) "" -- | Show instance for FP instance Show FP where show = displayFP -- | Display a Integer (signed/unsigned) number in a nicely formatted way displayWord :: IPrecision -> Integer -> String displayWord iprec intVal = intercalate "\n" ls where (sg, sz) = sgSz iprec ls = [ " " ++ fromJust inds1 | isJust inds1] ++ [ " " ++ inds2 , " Binary: " ++ binDisp allBits , " Hex: " ++ hexDisp allBits , " Type: " ++ show iprec ] ++ [ " Sign: " ++ if signBit then "Negative" else "Positive" | sg] ++ [ " Value: " ++ val ] (inds1, inds2) = case sz of 8 -> (Nothing, bInds2) 16 -> (Just wInds1, wInds2) 32 -> (Just dInds1, dInds2) 64 -> (Just qInds1, qInds2) _ -> error $ "displayWord: Unexpected size: " ++ show sz allBits = [intVal `testBit` i | i <- [sz-1, sz-2 .. 0]] signBit = head allBits val | not sg = show intVal | True = case iprec of I8 -> show $ adjust (0::Int8) I16 -> show $ adjust (0::Int16) I32 -> show $ adjust (0::Int32) I64 -> show $ adjust (0::Int64) _ -> error $ "displayWord: Unexpected type: " ++ show iprec adjust :: Bits a => a -> a adjust v = foldr (flip setBit) v [i | (i, True) <- zip [0..] (reverse allBits)] -- | Convert the given string to a IEEE number with the required precision stringToFP :: Precision -> String -> FP stringToFP precision input = case precision of SP -> fromMaybe (error $ "*** stringToFP: Cannot read a valid SP number from: " ++ show input) mbF DP -> fromMaybe (error $ "*** stringToFP: Cannot read a valid DP number from: " ++ show input) mbD _ -> error $ "*** stringToFP: Unsupported precision: " ++ show precision where i = map toLower (dropWhile (== '+') input) specials :: [(String, (FP, FP))] specials = [ (s, (floatToFP f, doubleToFP d)) | (s, (f, d)) <- [ ("infinity", ( infinityF, infinityD)) , ("-infinity", (-infinityF, - infinityD)) , ("0", ( 0, 0)) , ("-0", (-0, - 0)) , ("max", ( maxFiniteF, maxFiniteD)) , ("-max", (-maxFiniteF, - maxFiniteD)) , ("min", ( minNormalF, minNormalD)) , ("-min", (-minNormalF, - minNormalD)) , ("epsilon", ( epsilonF, epsilonD))] ] ++ [ ("ulp", (integerToFP SP 1, integerToFP DP 1)) , ("nan", (integerToFP SP 0x7f800001, integerToFP DP 0x7ff0000000000001)) , ("snan", (integerToFP SP 0x7f800001, integerToFP DP 0x7ff0000000000001)) , ("qnan", (integerToFP SP 0x7fc00000, integerToFP DP 0x7ff8000000000000)) ] infinityF, maxFiniteF, minNormalF, epsilonF :: Float infinityF = 1/0 maxFiniteF = 3.40282347e+38 minNormalF = 1.17549435e-38 epsilonF = 1.19209290e-07 infinityD, maxFiniteD, minNormalD, epsilonD :: Double infinityD = 1/0 maxFiniteD = 1.7976931348623157e+308 minNormalD = 2.2250738585072014e-308 epsilonD = 2.2204460492503131e-16 mbF, mbD :: Maybe FP (mbF, mbD) = case (i `lookup` specials, rd i :: Maybe Float, rd i :: Maybe Double) of (Just (f, d), _ , _ ) -> (Just f, Just d) (Nothing, Just f, Just d) -> (Just (floatToFP f), Just (doubleToFP d)) (Nothing, Just f, _ ) -> (Just (floatToFP f), Nothing) (Nothing, _, Just d) -> (Nothing, Just (doubleToFP d)) _ -> (Nothing, Nothing) rd :: (Read a, FH.FloatingHexReader a) => String -> Maybe a rd s = case [v | (v, "") <- reads s] ++ catMaybes [FH.readHFloat s] of [v] -> Just v _ -> Nothing -- | Turn a Haskell float to the internal detailed FP representation floatToFP :: Float -> FP floatToFP = integerToFP SP . toInteger . floatToWord -- | Turn a Haskell double to the internal detailed FP representation doubleToFP :: Double -> FP doubleToFP = integerToFP DP . toInteger . doubleToWord ------------------------------------------------------------------------- -- Reinterpreting float/double as word32/64 and back. Here, we use the -- definitions from the reinterpret-cast package: -- -- http://hackage.haskell.org/package/reinterpret-cast -- -- The reason we steal these definitions is to make sure we keep minimal -- dependencies and no FFI requirements anywhere. ------------------------------------------------------------------------- -- | Reinterpret-casts a `Float` to a `Word32`. floatToWord :: Float -> Word32 floatToWord x = runST (cast x) {-# INLINEABLE floatToWord #-} -- | Reinterpret-casts a `Word32` to a `Float`. wordToFloat :: Word32 -> Float wordToFloat x = runST (cast x) {-# INLINEABLE wordToFloat #-} -- | Reinterpret-casts a `Double` to a `Word64`. doubleToWord :: Double -> Word64 doubleToWord x = runST (cast x) {-# INLINEABLE doubleToWord #-} -- | Reinterpret-casts a `Word64` to a `Double`. wordToDouble :: Word64 -> Double wordToDouble x = runST (cast x) {-# INLINEABLE wordToDouble #-} {-# INLINE cast #-} cast :: (MArray (STUArray s) a (ST s), MArray (STUArray s) b (ST s)) => a -> ST s b cast x = newArray (0 :: Int, 0) x >>= castSTUArray >>= flip readArray 0 crackNum-2.3/Data/Numbers/CrackNum/0000755000000000000000000000000013373711632015304 5ustar0000000000000000crackNum-2.3/Data/Numbers/CrackNum/Utils.hs0000644000000000000000000001203013373711632016734 0ustar0000000000000000--------------------------------------------------------------------------- -- | -- Module : Data.Numbers.CrackNum.Utils -- Copyright : (c) Levent Erkok -- License : BSD3 -- Maintainer : erkokl@gmail.com -- Stability : experimental -- -- Various utils and sundry ----------------------------------------------------------------------------- module Data.Numbers.CrackNum.Utils where import Data.Char (toLower) import Data.List (genericIndex) import Numeric import Data.Numbers.CrackNum.Data (Precision(..), IPrecision(..)) -- | Returns True if all bits are False all0 :: [Bool] -> Bool all0 = all not -- | Returns True if all bits are True all1 :: [Bool] -> Bool all1 = and -- | Returns True if any bit is True any1 :: [Bool] -> Bool any1 = (True `elem`) -- | Lay out a sequence of separated bools as a nicely formatted binary number layOut :: [[Bool]] -> String layOut = unwords . map b2s -- | Binary to String conversion b2s :: [Bool] -> String b2s bs = concat [if b then "1" else "0" | b <- bs] -- | Test whether a digit is binary isBinDigit :: Char -> Bool isBinDigit = (`elem` "01") -- | Convert from binary char digit to value binDigit :: Char -> Int binDigit '0' = 0 binDigit '1' = 1 binDigit c = error $ "binDigit: recevied: " ++ show c -- | Read a number in base 16 readB16 :: String -> Integer readB16 s = case readHex s of [(v, "")] -> v _ -> error $ "Invalid hex input: " ++ show s -- | Read a number in base 2 readB2 :: String -> Integer readB2 s = case readInt 2 isBinDigit binDigit s of [(v, "")] -> v _ -> error $ "Invalid binary input: " ++ show s -- | Display a binary number in groups of 4 binDisp :: [Bool] -> String binDisp = grpBy4 . b2s -- | Group in chunks of 44 grpBy4 :: String -> String grpBy4 = grp False where grp _ [] = [] grp sep xs = let (f, r) = splitAt 4 xs in (if sep then " " else "") ++ f ++ grp True r -- | Display a binary number in groups of 4, in hexadecimal format hexDisp :: [Bool] -> String hexDisp = grpBy4 . chunkHex where chunkHex [] = [] chunkHex xs = let (f, r) = splitAt 4 xs in (letters `genericIndex` (bv f :: Int)) : chunkHex r letters = ['0' .. '9'] ++ ['A' .. 'F'] -- | Cluster a list into given size chunks cluster :: Int -> [a] -> [[a]] cluster n is = go is where s = length is `div` n go [] = [] go xs = let (f, r) = splitAt s xs in f : go r -- | Big-endian num converter bv :: Num a => [Bool] -> a bv = foldr (\b a -> 2 * a + b2i b) 0 . reverse where b2i b = if b then 1 else 0 -- | Drop unnecessary parts from input. This enables the user to be able to give data more easily cleanUp :: String -> String cleanUp = map toLower . filter (not . ignorable) where ignorable = (`elem` " _-") ---------------------------------------------------------------------------------------------------- -- Rulers ---------------------------------------------------------------------------------------------------- -- | Half-precision ruler, line 1 hpInds1 :: String -- | Half-precision ruler, line 2 hpInds2 :: String -- | Half-precision ruler, line 3 hpInds3 :: String hpInds1 = "1 0" hpInds2 = "5 43210 9876543210" hpInds3 = "S -E5-- ---F10----" -- | Single-precision ruler, line 1 spInds1 :: String -- | Single-precision ruler, line 2 spInds2 :: String -- | Single-precision ruler, line 3 spInds3 :: String spInds1 = "3 2 1 0" spInds2 = "1 09876543 21098765432109876543210" spInds3 = "S ---E8--- ----------F23----------" -- | Double-precision ruler, line 1 dpInds1 :: String -- | Double-precision ruler, line 2 dpInds2 :: String -- | Double-precision ruler, line 3 dpInds3 :: String dpInds1 = "6 5 4 3 2 1 0" dpInds2 = "3 21098765432 1098765432109876543210987654321098765432109876543210" dpInds3 = "S ----E11---- ------------------------F52-------------------------" -- | Byte-precision ruler, line 2 (note that no line 1 is needed!) bInds2 :: String bInds2 = "7654 3210" -- | Word-precision ruler, line 1 wInds1 :: String -- | Word-precision ruler, line 2 wInds2 :: String wInds1 = "1 0" wInds2 = "5432 1098 7654 3210" -- | Double-word-precision ruler, line 1 dInds1 :: String -- | Double-word-precision ruler, line 2 dInds2 :: String dInds1 = "3 2 1 0" dInds2 = "1098 7654 3210 9876 5432 1098 7654 3210" -- | Quad-word-precision ruler, line 1 qInds1 :: String -- | QuadDouble-word-precision ruler, line 2 qInds2 :: String qInds1 = "6 5 4 3 2 1 0" qInds2 = "3210 9876 5432 1098 7654 3210 9876 5432 1098 7654 3210 9876 5432 1098 7654 3210" -- | Convert Floating point precision to corresponding number of bits fpSz :: Precision -> Int fpSz HP = 16 fpSz SP = 32 fpSz DP = 64 -- | Convert Integer precision to whether it's signed and how many bits sgSz :: IPrecision -> (Bool, Int) sgSz W8 = (False, 8) sgSz I8 = (True, 8) sgSz W16 = (False, 16) sgSz I16 = (True, 16) sgSz W32 = (False, 32) sgSz I32 = (True, 32) sgSz W64 = (False, 64) sgSz I64 = (True, 64) crackNum-2.3/Data/Numbers/CrackNum/Data.hs0000644000000000000000000000546313373711632016521 0ustar0000000000000000--------------------------------------------------------------------------- -- | -- Module : Data.Numbers.CrackNum.Data -- Copyright : (c) Levent Erkok -- License : BSD3 -- Maintainer : erkokl@gmail.com -- Stability : experimental -- -- Internal representation of FP values ----------------------------------------------------------------------------- module Data.Numbers.CrackNum.Data where -- | Floating point precision data Precision = HP -- ^ Half precision; 16 bits = 1 sign + 5 exponent + 10 mantissa | SP -- ^ Single precision; 32 bits = 1 sign + 8 exponent + 23 mantissa | DP -- ^ Double precision; 64 bits = 1 sign + 11 exponent + 52 mantissa deriving (Eq, Show) -- | Integer/Word precision data IPrecision = W8 -- ^ 8-bit unsigned (byte) | I8 -- ^ 8-bit signed | W16 -- ^ 16-bit unsigned (word) | I16 -- ^ 16-bit signed | W32 -- ^ 32-bit unsigned (double-word) | I32 -- ^ 32-bit signed | W64 -- ^ 64-bit unsigned (quad-word) | I64 -- ^ 64-bit signed deriving Eq -- | Kinds of floating point values data Kind = Zero Bool -- ^ Zero: 0. If Bool is true, then this is -0; otherwise +0. | Infty Bool -- ^ Infinity: oo. If Bool is true, then this is -oo, otherwie +oo. | SNaN -- ^ The signaling-NaN. | QNaN -- ^ The quiet-NaN. | Denormal -- ^ Denormalized number, i.e., leading bit is not 1 | Normal -- ^ Normal value. -- | Determine if we have a NaN value isNaNKind :: Kind -> Bool isNaNKind SNaN = True isNaNKind QNaN = True isNaNKind _ = False -- | Show instance for integer-precisions instance Show IPrecision where show W8 = "Unsigned Byte" show I8 = "Signed Byte" show W16 = "Unsigned Word" show I16 = "Signed Word" show W32 = "Unsigned Double" show I32 = "Signed Double" show W64 = "Unsigned Quad" show I64 = "Signed Quad" -- | Complete internal representation for a floating-point number data FP = FP { intVal :: Integer -- ^ The value as represented as a full Integer. Storage purposes only. , prec :: Precision -- ^ FP precision. , sign :: Bool -- ^ Sign. If True then negative, otherwise positive. , stExpt :: Int -- ^ The exponent as it is stored. , bias :: Int -- ^ The implicit bias of the exponent. , expt :: Int -- ^ The actual exponent. , fracBits :: [Bool] -- ^ Bits in the fractional part , bitLayOut :: String -- ^ Layout representation , kind :: Kind -- ^ Floating-point kind (i.e., value) } crackNum-2.3/Data/Numbers/CrackNum/Main.hs0000644000000000000000000003452513373711632016535 0ustar0000000000000000--------------------------------------------------------------------------- -- | -- Module : Main -- Copyright : (c) Levent Erkok -- License : BSD3 -- Maintainer : erkokl@gmail.com -- Stability : experimental -- -- Main entry point for the crackNum executable ----------------------------------------------------------------------------- {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternGuards #-} module Main(main) where import Control.Monad (zipWithM_) import Data.Char (isHexDigit, isDigit) import Data.Maybe (fromMaybe, listToMaybe, isNothing) import System.Console.GetOpt (ArgOrder(Permute), getOpt, ArgDescr(..), OptDescr(..), usageInfo) import System.Environment (getArgs, getProgName) import System.Exit (exitFailure) import Data.Numbers.CrackNum import Data.Numbers.CrackNum.Utils import Data.Version (showVersion) import Paths_crackNum (version) copyRight :: String copyRight = "(c) Levent Erkok. Released with a BSD3 license." -- | Options accepted by the executable data Flag = FPType Precision -- ^ Crack as a Floating Point with given precision | IType IPrecision -- ^ Crack as an Integer with the given number of bits | ToIEEE String -- ^ Convert to IEEE SP/DP value | Lanes String -- ^ Number of lanes present in the input, crackNum can guess but it can also be specified. | Help -- ^ Help | VIM -- ^ Are we being called from VIM? | Version -- ^ Version deriving Eq options :: [OptDescr Flag] options = [ Option "" ["hp"] (NoArg (FPType HP)) "16 bit half precision" , Option "" ["sp"] (NoArg (FPType SP)) "32 bit single precision" , Option "" ["dp"] (NoArg (FPType DP)) "64 bit double precision" , Option "" ["sb"] (NoArg (IType I8)) " 8 bit signed byte" , Option "" ["sw"] (NoArg (IType I16)) "16 bit signed word" , Option "" ["sd"] (NoArg (IType I32)) "32 bit signed double" , Option "" ["sq"] (NoArg (IType I64)) "64 bit signed quad" , Option "" ["ub"] (NoArg (IType W8)) " 8 bit unsigned byte" , Option "" ["uw"] (NoArg (IType W16)) "16 bit unsigned word" , Option "" ["ud"] (NoArg (IType W32)) "32 bit unsigned double" , Option "" ["uq"] (NoArg (IType W64)) "64 bit unsigned quad" , Option "" ["toIEEE"] (ReqArg ToIEEE "n") "Convert from decimal to IEEE SP/DP formats." , Option "l" ["lanes"] (ReqArg Lanes "n") "number of lanes" , Option "" ["vim"] (NoArg VIM) "output in vim friendly format" , Option "h?" ["help"] (NoArg Help) "print help, with examples" , Option "v" ["version"] (NoArg Version) "print version info" ] helpStr :: String -> String helpStr pn = usageInfo ("Usage: " ++ pn ++ " precision bit/hex-pattern") options usage :: String -> IO () usage pn = do putStrLn $ helpStr pn putStrLn "Examples:" putStrLn "" putStrLn $ " " ++ pn ++ " --hp fc00" putStrLn $ " " ++ pn ++ " --sp fc00 abcd" putStrLn $ " " ++ pn ++ " --dp fc00 abc1 2345 6789" putStrLn $ " " ++ pn ++ " --sp 01111111110000000000000000000000" putStrLn $ " " ++ pn ++ " -l2 --hp 01111111110000000000000000000000" putStrLn $ " " ++ pn ++ " --sb 7f" putStrLn $ " " ++ pn ++ " --sp --toIEEE=-2.3e6" putStrLn $ " " ++ pn ++ " --dp --toIEEE=max" putStrLn $ " " ++ pn ++ " --dp --toIEEE=ulp" putStrLn "" putStrLn "Notes:" putStrLn " - You can use hexadecimal or binary as input." putStrLn " - You can use _,- or space as a digit to improve readability." putStrLn " - You can give input for multiple lanes, we will guess the #of lanes for you." putStrLn " Or, you can specify number of lanes with the -l option." putStrLn " - For \"toIEEE\" option (case doesn't matter):" putStrLn " - You can enter a number in decimal notation (like 2.3)" putStrLn " - You can enter a number in hexadecimal notation (like 0x1.abcp+3)" putStrLn " - OR, enter one of the following:" putStrLn " * infinity, -infinity: Positive/Negative infinities" putStrLn " * nan, snan, qnan: Not-A-Number; signaling/quiet" putStrLn " * 0, -0: Both kinds of zeros" putStrLn " * max : The maximum finite positive value" putStrLn " * -max: The minimum finite negative value" putStrLn " * min : The minimum normal positive value" putStrLn " * -min: The maximum normal negative value" putStrLn " * epsilon: The smallest possible value x s.t. 1+x /= 1." putStrLn " * ulp: The minimum subnormal value" exitFailure -- instead of dealing with vimscript, munge our args here.. heh vimpret :: [String] -> [String] vimpret args = case break (== "--bv") args of ([p], "--bv":rest) -> case mkArgs p of Nothing -> ["--help"] Just pr -> ("--" ++ pr) : rest _ -> ["--help"] where bad = (`elem` ["lanes", "vim", "help"]) validPrecs = filter (not . bad) $ concat [xs | Option _ xs _ _ <- options] dvalidPrecs = map ('-':) validPrecs ddvalidPrecs = map ('-':) dvalidPrecs mkArgs p | p `elem` validPrecs = Just p | p `elem` dvalidPrecs = Just (drop 1 p) | p `elem` ddvalidPrecs = Just (drop 2 p) | True = Nothing main :: IO () main = do origArgs <- getArgs origPN <- getProgName let -- bugger.. make the args a bit more friendly friendly :: String -> String friendly ('-':ns) -- -2/-3 etc become lane stuff | all isDigit ns = "-l" ++ ns friendly ('-':c:cs) | c `notElem` "-l" = "--" ++ (c:cs) friendly s = s cleanArgs = map friendly origArgs (argv, pn) | "--vim" `elem` cleanArgs = ("--vim" : vimpret (filter (/= "--vim") cleanArgs), "CrackNum") | True = (cleanArgs, origPN) case getOpt Permute options argv of (os, rs, []) -> if Version `elem` os then putStrLn $ pn ++ " v" ++ showVersion version ++ ", " ++ copyRight else process pn os rs (_, _, errs) -> do mapM_ putStrLn errs putStr $ helpStr pn where getChosenPrec os = case [p | p@FPType{} <- os] ++ [p | p@IType{} <- os] of [p] -> Just p _ -> Nothing process pn os rs | Help `elem` os = do putStrLn $ pn ++ " v" ++ showVersion version ++ ", " ++ copyRight usage pn | Just v <- listToMaybe [s | ToIEEE s <- os], null rs, Just (FPType p) <- mbPrec = putStrLn $ displayFP $ stringToFP p v | all isDigit lcs && lc > 0, Just p <- mbPrec = lane pn (VIM `elem` os) lc p rs | True = putStr $ helpStr pn where mbPrec = getChosenPrec os lcs = fromMaybe (show (guessLaneCount mbPrec (cleanUp (concat rs)))) (listToMaybe (reverse [n | Lanes n <- os])) lc = read lcs -- Try to guess the lane count if not given; if we can't we'll just return 1 guessLaneCount :: Maybe Flag -> String -> Int guessLaneCount mbp s | not (allHex || allBin) = 1 | isNothing mbp = 1 | Just (FPType p) <- mbp = guessFP ls p | Just (IType p) <- mbp = guessIP ls p | True = 1 where allHex = all isHexDigit s allBin = all isBinDigit s ls | allBin = length s | True = 4 * length s -- | Guess lane count for floating-point guessFP :: Int -> Precision -> Int guessFP 0 _ = 1 guessFP l p | r == 0 = q | True = 1 where sz = fpSz p (q, r) = l `quotRem` sz -- | Guess lane count for integer guessIP :: Int -> IPrecision -> Int guessIP 0 _ = 1 guessIP l p | r == 0 = q | True = 1 where (_, sz) = sgSz p (q, r) = l `quotRem` sz -- | Do the lane.. lane :: String -> Bool -> Int -> Flag -> [String] -> IO () lane pn _ 1 f rs = dispatch pn f rs lane pn vim n f rs | ls `mod` n /= 0 = help $ "Input length " ++ show ls ++ " is not a multiple of lane count: " ++ show n | True = zipWithM_ cvt [n-1, n-2 .. 0] (cluster n s) where s = cleanUp (concat rs) ls = length s help m = do putStrLn $ pn ++ ": " ++ m usage pn cvt i r = do putStrLn $ vimMarker vim ++ mkHeader (Just i) f dispatch pn f [r] vimMarker :: Bool -> String vimMarker False = "" vimMarker True = "VIM " -- | Display the ruler.. mkHeader :: Maybe Int -> Flag -> String mkHeader mbl f = take (fit len) divider where divider | Just l <- mbl = "== Lane: " ++ show l ++ ' ' : repeat '=' | True = repeat '=' fit n = 30 `max` (n + 19) len = case f of FPType p -> fpLen p IType p -> ipLen p _ -> 80 get p xs = fromMaybe 78 (lookup p xs) fpLen p = get p [ (HP, 8 + length hpInds3) , (SP, length spInds3) , (DP, length dpInds3) ] ipLen p = get p [ (W8, length bInds2), (I8, length bInds2) , (W16, length wInds2), (I16, length wInds2) , (W32, length dInds2), (I32, length dInds2) , (W64, length qInds2), (I32, length qInds2) ] dispatch :: String -> Flag -> [String] -> IO () dispatch pn p@FPType{} rs = unpack pn p (unwords rs) dispatch pn p@IType{} rs = unpack pn p (unwords rs) dispatch pn _ _ = usage pn unpack :: String -> Flag -> String -> IO () unpack pn prec orig = case (prec, length s, allHex, allBin) of (FPType HP, 4, True, _ ) -> putStrLn $ displayFP $ integerToFP HP hexVal (FPType HP, 16, _ , True) -> putStrLn $ displayFP $ integerToFP HP binVal (FPType SP, 8, True, _ ) -> putStrLn $ displayFP $ integerToFP SP hexVal (FPType SP, 32, _ , True) -> putStrLn $ displayFP $ integerToFP SP binVal (FPType DP, 16, True, _ ) -> putStrLn $ displayFP $ integerToFP DP hexVal (FPType DP, 64, _ , True) -> putStrLn $ displayFP $ integerToFP DP binVal (IType I8, 2, True, _ ) -> putStrLn $ displayWord I8 hexVal (IType I8, 8, _ , True) -> putStrLn $ displayWord I8 binVal (IType W8, 2, True, _ ) -> putStrLn $ displayWord W8 hexVal (IType W8, 8, _ , True) -> putStrLn $ displayWord W8 binVal (IType I16, 4, True, _ ) -> putStrLn $ displayWord I16 hexVal (IType I16, 16, _ , True) -> putStrLn $ displayWord I16 binVal (IType W16, 4, True, _ ) -> putStrLn $ displayWord W16 hexVal (IType W16, 16, _ , True) -> putStrLn $ displayWord W16 binVal (IType I32, 8, True, _ ) -> putStrLn $ displayWord I32 hexVal (IType I32, 32, _ , True) -> putStrLn $ displayWord I32 binVal (IType W32, 8, True, _ ) -> putStrLn $ displayWord W32 hexVal (IType W32, 32, _ , True) -> putStrLn $ displayWord W32 binVal (IType I64, 16, True, _ ) -> putStrLn $ displayWord I64 hexVal (IType I64, 64, _ , True) -> putStrLn $ displayWord I64 binVal (IType W64, 16, True, _ ) -> putStrLn $ displayWord W64 hexVal (IType W64, 64, _ , True) -> putStrLn $ displayWord W64 binVal _ -> if not (null orig) then do case prec of FPType HP -> putStrLn $ "ERROR: HP format requires 4 hex or 16 bin digits, received: " ++ what FPType SP -> putStrLn $ "ERROR: SP format requires 8 hex or 32 bin digits, received: " ++ what FPType DP -> putStrLn $ "ERROR: DP format requires 16 hex or 64 bin digits, received: " ++ what IType I8 -> putStrLn $ "ERROR: Signed byte format requires 2 hex or 8 bin digits, received: " ++ what IType I16 -> putStrLn $ "ERROR: Signed word format requires 4 hex or 16 bin digits, received: " ++ what IType I32 -> putStrLn $ "ERROR: Signed double format requires 8 hex or 32 bin digits, received: " ++ what IType I64 -> putStrLn $ "ERROR: Signed quad format requires 16 hex or 64 bin digits, received: " ++ what IType W8 -> putStrLn $ "ERROR: Unsigned byte format requires 2 hex or 8 bin digits, received: " ++ what IType W16 -> putStrLn $ "ERROR: Unsigned word format requires 4 hex or 16 bin digits, received: " ++ what IType W32 -> putStrLn $ "ERROR: Unsigned double format requires 8 hex or 32 bin digits, received: " ++ what IType W64 -> putStrLn $ "ERROR: Unsigned quad format requires 16 hex or 64 bin digits, received: " ++ what _ -> putStrLn $ "ERROR: Illegal input received: " ++ what putStrLn $ "\nUse '" ++ pn ++ " --help' for detailed help." exitFailure else usage pn where s = cleanUp orig ls = length s allHex = all isHexDigit s allBin = all isBinDigit s hexVal = readB16 s binVal = readB2 s what | allHex && allBin = show ls ++ " bin/hex digit" ++ plural | allHex = show ls ++ " hex digit" ++ plural | allBin = show ls ++ " bin digit" ++ plural | True = show ls ++ " bogus digit" ++ plural where plural | ls == 1 = "" | True = "s"