OpenEuphoria

binary.e

• Posted by jordah at btopenworld.com Mar 03, 2003
• 461 views

Hi all,
Due to the numerous complaints i've got about binary.e involving floating
   point inaccuracy. i have edited it to use atom_to_float64() and vice-versa. This
   means compression for floating point numbers is less since it uses 8bytes instead
   of 4.
I don't have a computer any more so i have just edited the source code from
   an internet cafe. i HTH. the code is untested so please read through.

Jordah
===============================================
---------------------------------------------------------
--File   : Enc/Dec of Euphoria Objects in Memory,Sequence or File    
--Version: 1.2
--Date   : 9/18/02
--Author : Jordah Ferguson
---------------------------------------------------------
constant 
CHAR    = 1, WORD   = 2, TRI     = 3,
LONG    = 4, DOUBLE = 8, NULL    = 0,
SEQ     = 1, STR    = 2,
CONVMEM = machine_func(16,LONG)
---------------------------------------------------------
integer Sign,TYPE,STYPE,Seq_rId,Mem_rId,File_rId,Slide_rId,byte,len
sequence MainBuffer,Chunk
atom Pointer,a
object x
---------------------------------------------------------
            
type string(sequence s)
for i = 1 to length(s) do
  x = s[i]
  if integer(x) then
    if x < 0 or x > #FF then
      return 0
    end if
  else
    return 0
  end if
end for
return 1
end type
------------------------------------------------------

function SeqSlide(integer idx)  
    Chunk   = MainBuffer[Pointer..(idx Pointer)-1]
    Pointer  = idx
    if idx = CHAR then
      return Chunk[CHAR]
    end if
    return Chunk 
end function
Seq_rId = routine_id("SeqSlide")
-----------------------------------------------------

function MemSlide(integer idx)
Chunk = peek({Pointer,idx})
Pointer  = idx
if idx = CHAR then     
  return Chunk[CHAR]
else
  return Chunk
end if
end function
Mem_rId = routine_id("MemSlide")
----------------------------------------------------

function FileSlide(integer idx)
if idx = CHAR then
  return getc(Pointer)
else
  Chunk = repeat(0,idx)
  for n = 1 to idx do
    Chunk[n] = getc(Pointer)
  end for
  return Chunk
end if    
end function
File_rId = routine_id("FileSlide")
----------------------------------------------------

function RetVal(integer idx)
  return call_func(Slide_rId,{idx})
end function  
-----------------------------------------------------

function Atom2Seq(atom x) 
    Sign = ((x>0)-(x<0))
    x *= Sign
    if x = NULL then
      TYPE = NULL
      return {}
    elsif x <= #FF then
      TYPE = CHAR*Sign
      return {x}
    elsif x <= #FFFF then
      TYPE = WORD*Sign
      return {and_bits(x,#FF),floor(x/#100)}
    elsif x <= #1000000 then
      TYPE = TRI*Sign
      return {and_bits(x,#FF),and_bits(floor(x/#100),#FF),floor(x/#10000)}
    elsif x <= #FFFFFFFF then
      TYPE = LONG*Sign
      poke4(CONVMEM,x)
      return peek({CONVMEM,LONG})        
    elsif x <= 1.7E308 then 
      TYPE = DOUBLE
      return machine_func(46,x) 
    end if
end function 
-----------------------------------------------------

function Obj2Seq(object x)
  sequence sx sx = {} 
  if atom(x) then
    sx = Atom2Seq(x) 
    if TYPE < 0 then
      TYPE  = #10
    end if
    if STYPE then
      TYPE  = STYPE * #10
      STYPE = NULL
    end if
    return TYPE & sx
  else
    len = length(x)
    if string(x) then
      STYPE = STR
      sx &= Obj2Seq(len) & x
    else
      STYPE = SEQ
      sx &= Obj2Seq(len)
      for n = 1 to len do
        sx &= Obj2Seq(x[n])
      end for 
    end if
    return sx
  end if
end function
-------------------------------------------------------

function Seq2Obj()
  sequence s
    byte  = RetVal(CHAR)
    if byte = -1 then
      return -1
    end if
    TYPE  = and_bits(byte,#F)
    STYPE = floor(byte/#10)
    Sign  = 1     
  if TYPE > DOUBLE then
    TYPE = #10 - TYPE
    Sign = -1
  end if      
  if TYPE = NULL then
    a = 0
  elsif TYPE = CHAR then
    a = RetVal(CHAR) * Sign
  elsif TYPE = WORD then
    s = RetVal(WORD)
    a = (s[1] s[2]*#100)*Sign
  elsif TYPE = TRI then
    s = RetVal(TRI)
    a = (s[1] s[2]*#100 s[3]*#10000)*Sign
  elsif TYPE = LONG then
    poke(CONVMEM,RetVal(LONG))
    a = peek4u(CONVMEM) * Sign
  elsif TYPE = DOUBLE then
    a = machine_func(47,RetVal(DOUBLE))
  else
    return NULL
  end if
  if STYPE then
    if STYPE = STR then
      if a = CHAR then
        return {RetVal(a)}
      else
        return RetVal(a)
      end if
    elsif STYPE = SEQ then
      s = repeat(0,a)
      for n = 1 to a do
        s[n] = Seq2Obj()
      end for
      return s
    else 
      return {}
    end if
  end if
  return a
end function
-------------------------------------------------------

global function EncodeObject(object x)
    STYPE  = NULL 
    return Obj2Seq(x)
end function
-------------------------------------------------------

global function DecodeObject(sequence x)
  Pointer = 1
  MainBuffer = x 
  Slide_rId = Seq_rId
  return Seq2Obj()
end function
-------------------------------------------------------

global function AllocateObject(object x)
  STYPE = NULL
  Chunk = Obj2Seq(x)
  Pointer = machine_func(16,length(Chunk))
  poke(Pointer,Chunk)
  return Pointer
end function
------------------------------------------------------

global function PeekObject(atom loc) 
  Slide_rId = Mem_rId
  Pointer = loc
  return Seq2Obj()
end function
------------------------------------------------------

global procedure PutObject(integer fn,object x)
if fn != -1 then
  STYPE = NULL
  puts(fn,Obj2Seq(x))
end if
end procedure
-----------------------------------------------------

global function GetObject(integer fn) 
if fn != -1 then
  Slide_rId = File_rId
  Pointer = fn
  return Seq2Obj() 
end if
return -1  
end function
-----------------------------------------------------