OpenEuphoria

safe routines for poking etc.

• Posted by Robert Craig <rds at MSN.COM> Jul 01, 1997
• 793 views

Hello All,

Here's a safe.e file with safe versions of poke(), mem_copy()
etc. that you can use when debugging. I would have liked
to name them the same as the standard routines,
but this turned out to be impractical, so I stuck
"safe_" on the front of each one. You *can* rename
ex.exe built-in routines, but unfortunately, not Euphoria
global routines defined in .e files such as machine.e.

This code has not been thoroughly tested. In any case
you may need to modify it for your own particular programs.

I did test it on Ralf's latest gfxbeta from Irv's FTP site and it
caught an attempt to poke into unallocated memory. This error
did not show up on my Pentium when I ran his demo, but
my 486 had a Causeway error. Both machines catch the error
when safe.e is included, and poke() is renamed to safe_poke(),
and allocate() is renamed to safe_allocate() everywhere in his
code.

I'll try to insert safe.e directly into this message.
Please ignore any extra '=' signs or 3D's that get inserted.

-- safe.e ------------ cut here --------------------

-- Ensure that memory operations are safe (for debugging)
-- safe versions of peek, poke, mem_copy, mem_set,
-- allocate, allocate_low

include machine.e

constant OK = 1, BAD = 0

sequence safe_address_list

-- add any acceptable areas of low memory here:
safe_address_list = {
    {#A0000, 200*320} -- video memory, start & length
}

function safe_address(atom a)
-- is it ok to read/write address a?
    -- check the list of safe memory blocks:
    for i = 1 to length(safe_address_list) do
        if a >= safe_address_list[i][1] and
            a < safe_address_list[i][1] + safe_address_list[i][2] then
            return OK
        end if
    end for
    return BAD
end function

procedure die(sequence msg)
-- terminate with a message
    puts(1, "\n\n" & msg & "\n\n")
    ? 1/ 0 -- force traceback
end procedure

global function safe_peek(object x)
-- safe version of peek
    integer len
    atom a

    if atom(x) then
        len = 1
        a = x
    else
        len = x[2]
        a = x[1]
    end if
    if safe_address(a) and safe_address(a + len - 1) then
        return peek(x)
    else
        die(sprintf("BAD POKE ADDRESS!!!! %d\n\n", a))
    end if
end function

global procedure safe_poke(atom a, object v)
-- safe version of poke
    integer len

    if atom(v) then
        len = 1
    else
        len = length(v)
    end if
    if safe_address(a) and safe_address(a + len - 1) then
        poke(a, v)
    else
        die(sprintf("BAD POKE ADDRESS!!!! %d\n\n", a))
    end if
end procedure

global procedure safe_mem_copy(atom target, atom source, atom len)
-- safe mem_copy
    if not safe_address(target) or not safe_address(target+len-1) then
        die(sprintf("BAD MEM_COPY TARGET ADDRESS!!!! %d\n\n", target))
    elsif not safe_address(source) or not safe_address(source+len-1) then
        die(sprintf("BAD MEM_COPY SOURCE ADDRESS!!!! %d\n\n", target))
    else
        mem_copy(target, source, len)
    end if
end procedure

global procedure safe_mem_set(atom target, atom value, atom len)
-- safe mem_set
    if safe_address(target) and safe_address(target + len - 1) then
        mem_set(target, value, len)
    else
        die(sprintf("BAD MEM_SET ADDRESS!!!! %d\n\n", target))
    end if
end procedure

global function safe_allocate(integer n)
-- allocate memory block and add it to safe list
    atom a

    a = allocate(n)
    if a = 0 then
        die("OUT OF MEMORY!")
    end if
    safe_address_list = append(safe_address_list, {a, n})
    return a
end function

global function safe_allocate_low(integer n)
-- allocate memory block and add it to safe list
    atom a

    a = allocate_low(n)
    if a = 0 then
        die("OUT OF MEMORY!")
    end if
    safe_address_list = append(safe_address_list, {a, n})
    return a
end function

---------------

Regards,
  Rob Craig
  Rapid Deployment Software