1. binary.e
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
-----------------------------------------------------
