OpenEuphoria

Re: Memory allocation/deallocation

• Posted by euman at bellsouth.net Feb 16, 2002
• 649 views

----- Original Message ----- 
From: "George Papadopoulos" <georgp at otenet.gr>
To: "EUforum" <EUforum at topica.com>

I want to ask if memory allocated with allocate( mem ) can be freed by
Shell's memory allocator  or  in the opposite side, memory allocated
by Shell can be freed with free( mem ). I have to deal with
interfaces.

 Thanks
-George

Hi George,

Glad to see you back... (posting)

I would try to poke a null terminated string then use Shells free and
then use Eu to look at the address for the string. If the strings not there
then it will work..

On the other hand,

I always use these routines as replacements for Euphoria's mem-handling.
So these may be better choices for you.

function link_c_func(atom dll, sequence name, sequence args, atom result)
-- dynamically link a C routine as a Euphoria function
    integer handle

    handle = define_c_func(dll, name, args, result)
    if handle = -1 then
 not_found(name)
    else
 return handle
    end if
end function

function link_c_proc(atom dll, sequence name, sequence args)
-- dynamically link a C routine as a Euphoria function
    integer handle
    handle = define_c_proc(dll, name, args)
    if handle = -1 then
 not_found(name)
    else
 return handle
    end if
end function

atom kernel32

kernel32=open_dll("kernel32.dll")
if kernel32=NULL then
  not_found("kernel32.dll")
end if

constant
xHeapCreate = link_c_func(kernel32,"HeapCreate",{C_LONG,C_LONG,C_LONG},C_LONG)
,xHeapDestroy = link_c_func(kernel32,"HeapDestroy",{C_LONG},C_LONG)
,xHeapAlloc = link_c_func(kernel32,"HeapAlloc",{C_LONG,C_LONG,C_LONG},C_LONG)
,xHeapFree = link_c_proc(kernel32,"HeapFree",{C_LONG,C_LONG,C_LONG})
,xCopyMemory =
link_c_func(kernel32,"RtlMoveMemory",{C_POINTER,C_POINTER,C_LONG},C_LONG)
,xlstrlen = link_c_func(kernel32,"lstrlen",{C_POINTER},C_INT)

constant HEAP_ZERO_MEMORY=#00000008

global atom pHeap
pHeap = c_func(xHeapCreate,{0,16384,0})

global function myalloc(integer size)
   return c_func(xHeapAlloc,{pHeap,HEAP_ZERO_MEMORY,size})
end function

global procedure myfree(integer pmem)
   c_proc(xHeapFree,{pHeap,0,pmem})
end procedure

global procedure mypoke(atom mem, object s)
   poke(mem, s)
end procedure

global procedure mypoke4(atom mem, object s)
   poke4(mem, s) 
end procedure

global function mypeek(object si)
   if integer(si) then
      return peek(si)      
   else
      return peek({si[1],si[2]}) 
   end if    
end function

global function mypeek4s(object si)
   if integer(si) then
      return peek4s(si) 
   else
      return peek4s({si[1],si[2]}) 
   end if
end function

global function mypeek4u(object si)
   if integer(si) then
      return peek4u(si) 
   else
      return peek4u({si[1],si[2]}) 
   end if
end function

global function allocate_string2(sequence s)
atom mem
    mem = myalloc(length(s) + 1)
    poke(mem, s)
    return mem       
end function

global function LOWORD(atom long)
   return remainder(long,65536)
end function

global function HIWORD(atom long)
   return floor(long/65536)
end function   

global function peek_zstring(atom lpzString)
  return mypeek({lpzString,c_func(xlstrlen,{lpzString})})
end function

global atom ppi
ppi = myalloc(4)

global function int_to_bytes2(object x)
 mypoke4(ppi, x)
 return mypeek({ppi,4})
end function

global function bytes_to_int2(sequence x)
 mypoke(ppi, x)
 return mypeek4u(ppi)
end function

global function shift_left (atom x, integer count)
  return x * power (2, count)  
end function

global function MAKELONG (atom a, atom b)
 return or_bits (a, shift_left (b, 16))
end function

global procedure pokew(atom addr,object w)
    if atom(w) then
      mypoke(addr,{remainder(w,256),floor(w/256)})
    else
      for i = 1 to length(w) do
           mypoke(addr+(i-1)*2,{remainder(w[i],256),floor(w[i]/256)})
      end for
    end if
end procedure

junk = c_func(xHeapDestroy,{pHeap}) -- free heap

Euman
euman at bellsouth.net

Q: Are we monetarily insane?
A: YES