floatToIntBits, floatToIntHex, intBitsToFloat, intHexToFloat

[flaith]

Hi guys

because I need these functions for an assembler, I just wanted to share them

Code: Select all

Enumeration 
  #REGExp_HEX
  #REGExp_BIN
EndEnumeration

#PATTERN_HEX        = "^[$]?[0-9a-fA-F]+$"
#PATTERN_BIN        = "^[%]?[0-1]+$"

;For a 32 or 64 Bits Compiler
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
  #LenBits          = 32
CompilerElse
  #LenBits          = 64
CompilerEndIf

; RegExp pattern from blueznl - http://www.purebasic.fr/english/viewtopic.php?p=336309#p336309
; [code]
; Global re_ishex = CreateRegularExpression(#PB_Any,"^[$]?[0-9a-fA-F]+$")
; 
; Procedure.i x_ishex(s.s)
;   ProcedureReturn MatchRegularExpression(re_ishex,s)
; EndProcedure
; 
; Debug x_ishex("a")
; 

Structure CS_LONG
Long.l
EndStructure

Global Dim REGExp_Result.s(0)

Global REGExp_Hexa = CreateRegularExpression(#REGExp_HEX, #PATTERN_HEX)
Global REGExp_Binary = CreateRegularExpression(#REGExp_BIN, #PATTERN_BIN)

Procedure.i CheckIsHexa(__value.s)
Protected.i _index, _NbFound

If REGExp_Hexa
If MatchRegularExpression(#REGExp_HEX, __value)
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndIf
EndProcedure

Procedure.i CheckIsBinary(__value.s)
Protected.i _index, _NbFound

If REGExp_Binary
If MatchRegularExpression(#REGExp_BIN, __value)
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndIf
EndProcedure

Procedure.s floatToIntBits(__Value.f)
Protected.CS_LONG *ptr
Protected.i _index
Protected.s _result

*ptr = @__Value
For _index = SizeOf(Float) - 1 To 0 Step - 1
_result + RSet(Bin(PeekC(*ptr + _index)), 8, "0")
Next

ProcedureReturn _result
EndProcedure

Procedure.s floatToIntHex(__Value.f)
Protected.CS_LONG *ptr
Protected.i _index
Protected.s _result

*ptr = @__Value
For _index = SizeOf(Float) - 1 To 0 Step - 1
_result + RSet(Hex(PeekC(*ptr + _index)), 2, "0")
Next

ProcedureReturn _result
EndProcedure

Procedure.f intBitsToFloat(__Value.s)
Protected.i _index, _count
Protected.c _ValueOneByte
Protected.f _tmpFloat = 0.0
Protected *ptrFloat

;Get the address of temporary float value
*ptrFloat = @_tmpFloat

If CheckIsBinary(__Value)
If Len(__Value) <> #LenBits ;32 or 64 bits
; Will return NaN
ProcedureReturn
Else
_count = 3 ;Starting by 3 and going to 0
;to put each number to make the float value correct
; Starting to extract each byte from binary value
_index = 1
Repeat
_ValueOneByte = Val("%"+Mid(__Value, _index, )
PokeC(*ptrFloat + _count, _ValueOneByte)
_count - 1
_index + 8
Until _index >= #LenBits
EndIf
Else
; Will return NaN
ProcedureReturn
EndIf

ProcedureReturn _tmpFloat
EndProcedure

Procedure.f intHexToFloat(__Value.s) ;40490FDA
Protected.i _index, _count
Protected.c _ValueOneByte
Protected.f _tmpFloat = 0.0
Protected *ptrFloat

;Get the address of temporary float value
*ptrFloat = @_tmpFloat

If CheckIsHexa(__Value)
If Len(__Value) <> 8
; Will return NaN
ProcedureReturn
Else
_count = 3 ;Starting by 3 and going to 0
;to put each number to make the float value correct
; Starting to extract each byte from hax value
_index = 1
Repeat
_ValueOneByte = Val("$"+Mid(__Value, _index, 2))
PokeC(*ptrFloat + _count, _ValueOneByte)
_count - 1
_index + 2
Until _index >= 8
EndIf
Else
; Will return NaN
ProcedureReturn
EndIf

ProcedureReturn _tmpFloat
EndProcedure

Debug floatToIntBits(#PI)
Debug floatToIntHex(#PI)

;Test to Match
If CheckIsBinary("01000000010010010000111111011011") : Debug "Match" : Else : Debug "Not Match !!!" : EndIf
If CheckIsHexa("40490FDB") : Debug "Match" : Else : Debug "Not Match !!!" : EndIf

;Should not match
If CheckIsBinary("01000000210010010000111111011011") : Debug "Match" : Else : Debug "Not Match !!!" : EndIf
If CheckIsHexa("4049GFDB") : Debug "Match" : Else : Debug "Not Match !!!" : EndIf

;-Test Bits to float
; Should return PI
tmp.f = intBitsToFloat("01000000010010010000111111011011")
Debug tmp

; Should return NaN because of the number '2'
tmp = intBitsToFloat("01000000210010010000111111011011")
Debug tmp

;-Test Hexa to float
; Should return PI
tmp.f = intHexToFloat("40490FDB")
Debug tmp

;Should return Nan
tmp.f = intHexToFloat("4049GFDB")
Debug tmp

Debug StrF(#PI,14)+"= PI from PureBasic"[/code]

[wilbert]

I'm curious if there's any reason you are using a loop and handle one byte at a time.
Something like this seems to give the same result

Code: Select all

Procedure.s floatToIntBits(__Value.f)
  Protected *ptr.Long = @__Value
  ProcedureReturn RSet(Bin(*ptr\l, #PB_Long), 32, "0")
EndProcedure

Procedure.s floatToIntHex(__Value.f)
  Protected *ptr.Long = @__Value
  ProcedureReturn RSet(Hex(*ptr\l, #PB_Long), 8, "0")
EndProcedure

Procedure.f intBitsToFloat(__Value.s)
  Protected binValue.l = Val("%" + __Value)
  Protected *ptr.Float = @binValue
  If RSet(Bin(binValue, #PB_Long), 32, "0") <> __Value
    ProcedureReturn NaN()
  Else
    ProcedureReturn *ptr\f
  EndIf
EndProcedure

Procedure.f intHexToFloat(__Value.s)
  Protected hexValue.l = Val("$" + __Value)
  Protected *ptr.Float = @hexValue
  If RSet(Hex(hexValue, #PB_Long), 8, "0") <> UCase(__Value)
    ProcedureReturn NaN()
  Else
    ProcedureReturn *ptr\f
  EndIf
EndProcedure

[flaith]

good to be curious
Yes in the beginning I tried a different way, means that I splited the mantissa from the binary value, that's why I kept the loop.
Thanks for you better solution Wilbert