2. Re: Running safe.e ???
On Fri, Sep 19, 2003 at 12:43:54PM -0400, Bernie Ryan wrote:
>
>
> Rob: Why does this fail ?
Works fine under Linux, Eu 2.3
> Also will location a always contain a terminating zero ?
Yes. From allocate_string() in safe.e, line 821:
global function allocate_string(sequence s)
-- create a C-style null-terminated string in memory
atom mem
mem = allocate(length(s) + 1)
poke(mem, s & 0)
return mem
end function
For an empty sequence, you get:
mem = allocate(0 + 1)
poke(mem, "" & 0)
return mem
>
> ===================================
> include safe.e
>
> atom a a = allocate_string("")
> ? a
> ? peek(a)
>
> if getc(0) then
> -- pause
> end if
> ===================================
>
> Bernie
>
>
>
> TOPICA - Start your own email discussion group. FREE!
>
>
--
"Is there peace in heaven, or is that merely an illusion?" - Someone
11. Re: Running safe.e ???
Derek Parnell wrote:
>>Bernie Ryan wrote:
>>
>>>Rob: Why does this fail ?
>>>...
>>>
>>>===================================
>>>include safe.e
>>>
>>>atom a a = allocate_string("")
>>>? a
>>>? peek(a)
>>
>> > ...
>>
>>You've found a bug in safe.e
>>Thanks for pointing this out.
>>
>
> I must be using a different safe.e, because it works fine here.
The bug lies in safe_address() in safe.e.
The version of safe.e in 2.3 has the old allocate_string(),
while machine.e for 2.3 has the new allocate_string()
with Aku's optimization.
The new allocate_string() is correct but it will trigger the
safe_address() bug when passed a null string. It tries to
poke() a length-0 sequence of bytes into memory, which
triggers an incorrect (false-alarm) error report from safe.e.
If you aren't using safe.e there's no problem.
I said yesterday that both 2.3 and 2.4 had the problem,
but actually only 2.4 has the problem because 2.3's safe.e
was lagging behind machine.e. In 2.4 safe.e was updated to
have the same faster allocate_string() as machine.e.
> Also, if you're changing this, you might consider
> return BAD1, BAD2, etc... so we can easily distinguish
> the particular reason for rejecting a bad address.
> So instead of just saying "BAD POKE", it could say
> "BAD POKE CODE 1" etc...
Thanks. I'll look into that.
> BTW, there is an unused local variable called 'half'
> in the safe.e allocate() function.
Thanks.
Regards,
Rob Craig
Rapid Deployment Software
http://www.RapidEuphoria.com
12. Re: Running safe.e ???
On Sat, Sep 20, 2003 at 02:48:12PM +1000, Derek Parnell wrote:
>
>
> ----- Original Message -----
> From: "Robert Craig" <rds at RapidEuphoria.com>
> To: "EUforum" <EUforum at topica.com>
> Subject: Re: Running safe.e ???
>
>
> > Bernie Ryan wrote:
> > > Rob: Why does this fail ?
> > > ...
> > >
> > > ===================================
> > > include safe.e
> > >
> > > atom a a = allocate_string("")
> > > ? a
> > > ? peek(a)
> > > ...
> >
> > You've found a bug in safe.e
> > Thanks for pointing this out.
> >
>
> I must be using a different safe.e, because it works fine here.
Same here. Tho, this simple hack in safe.e might help Bernie out.
global procedure poke(atom a, object v)
-- safe version of poke
integer len
if atom(v) then
len = 1
else
len = length(v)
end if
--INSERT
if len = 0 then
return
end if
--END INSERT
if safe_address(a, len) then
original_poke(a, v)
else
die("BAD POKE" & bad_address(a))
end if
end procedure
>
> Also, if you're changing this, you might consider return BAD1, BAD2, etc... so
> we can easily distinguish the particular reason for rejecting a bad address. So
> instead of just saying "BAD POKE", it could say "BAD POKE CODE 1" etc...
Yes.
>
> BTW, there is an unused local variable called 'half' in the safe.e allocate()
> function.
Its in mine too. But mine is 2.3, not 2.4
> --
> Derek
>
>
>
> TOPICA - Start your own email discussion group. FREE!
>
>
--
"No one can be immortal, because the only way to be alive is to die." - Someone
14. Re: Running safe.e ???
On Sun, Sep 21, 2003 at 07:28:13AM +1000, Derek Parnell wrote:
> > The bug lies in safe_address() in safe.e.
> >
> [snip]
>
> Whatever. All I'm saying is that I'm using safe.e from Eu 2.4 and it WORKS on
> my machine.
>
> If I run the example code above I get this ...
>
> Euphoria Interpreter 2.4 for 32-bit DOS.
> Copyright (c) Rapid Deployment Software 2003
> This Complete Edition of Euphoria is a licensed
> product of Rapid Deployment Software and may
> not be redistributed, except with the written
> permission of Rapid Deployment Software.
>
> file name to execute? test
>
> Using Debug Version of machine.e
> 2195227448
> 0
>
> --
> Derek
>
Lets see the sniplets of code for your allocate_string(), poke(), and
safe_address() from your safe.e. It may be that you are somehow accidently
using 2.3 safe.e in 2.4, so this is why I ask.
jbrown
>
>
> TOPICA - Start your own email discussion group. FREE!
>
>
--
"The quest for peace may only bring pain, or may the quest of pain bring
peace?" - Someone
15. Re: Running safe.e ???
Derek Parnell wrote:
Whatever. All I'm saying is that I'm using safe.e
> from Eu 2.4 and it WORKS on my machine.
If I run the example code above I get this ...
Euphoria Interpreter 2.4 for 32-bit DOS.
Copyright (c) Rapid Deployment Software 2003
This Complete Edition of Euphoria is a licensed
product of Rapid Deployment Software and may
not be redistributed, except with the written
permission of Rapid Deployment Software.
file name to execute? test
Using Debug Version of machine.e
2195227448
0
I don't remember exactly when I updated allocate_string()
in safe.e to be the same as Aku's version in machine.e.
It may have been for 2.4 alpha, 2.4 beta or 2.4 Official release.
Although your interpreter is certainly 2.4 Official Complete Edition,
I think you are probably picking up a safe.e that is not
from 2.4 Official, or maybe you have tweaked your copy
of safe.e somehow.
Here is allocate_string() from safe.e in 2.4 Official:
global function allocate_string(sequence s)
-- create a C-style null-terminated string in memory
atom mem
mem = allocate(length(s) + 1)
if mem then
poke(mem, s)
poke(mem+length(s), 0) -- Thanks to Aku
end if
return mem
end function
The earlier version had a single poke statement
with a concatenation. Aku found it was faster to
do away with the concatenation and add an extra poke.
However this can lead to a poke of a length-0 sequence s
which triggers the bug in safe_address().
Regards,
Rob Craig
Rapid Deployment Software
http://www.RapidEuphoria.com
16. Re: Running safe.e ???
This is a multi-part message in MIME format.
--Boundary_(ID_CPyZ++6CtfUnAsYXp5mIqQ)
----- Original Message -----
From: "Robert Craig" <rds at RapidEuphoria.com>
To: "EUforum" <EUforum at topica.com>
Sent: Sunday, September 21, 2003 1:07 PM
Subject: Re: Running safe.e ???
>
>
> Derek Parnell wrote:
> > Whatever. All I'm saying is that I'm using safe.e
> > from Eu 2.4 and it WORKS on my machine.
> >
> > If I run the example code above I get this ...
> >
> > Euphoria Interpreter 2.4 for 32-bit DOS.
> > Copyright (c) Rapid Deployment Software 2003
> > This Complete Edition of Euphoria is a licensed
> > product of Rapid Deployment Software and may
> > not be redistributed, except with the written
> > permission of Rapid Deployment Software.
> >
> > file name to execute? test
> >
> > Using Debug Version of machine.e
> > 2195227448
> > 0
>
> I don't remember exactly when I updated allocate_string()
> in safe.e to be the same as Aku's version in machine.e.
> It may have been for 2.4 alpha, 2.4 beta or 2.4 Official release.
>
> Although your interpreter is certainly 2.4 Official Complete Edition,
> I think you are probably picking up a safe.e that is not
> from 2.4 Official, or maybe you have tweaked your copy
> of safe.e somehow.
No, I have not tweaked or otherwise edited safe.e, ever!
> Here is allocate_string() from safe.e in 2.4 Official:
>
> global function allocate_string(sequence s)
> -- create a C-style null-terminated string in memory
> atom mem
>
> mem = allocate(length(s) + 1)
> if mem then
> poke(mem, s)
> poke(mem+length(s), 0) -- Thanks to Aku
> end if
> return mem
> end function
Here is the safe.e's allocate_string I'm using...
global function allocate_string(sequence s)
-- create a C-style null-terminated string in memory
atom mem
mem = allocate(length(s) + 1)
if mem then
poke(mem, s)
poke(mem+length(s), 0) -- Thanks to Aku
end if
return mem
end function
Looks sorta the same to me.
> The earlier version had a single poke statement
> with a concatenation. Aku found it was faster to
> do away with the concatenation and add an extra poke.
> However this can lead to a poke of a length-0 sequence s
> which triggers the bug in safe_address().
I did a scan of my disk and I still have 2.2 and 2.3 safe.e. I checked that they
are not in the EUINC or EUDIR paths.
I have ...
f:\EUPHORIA22\INCLUDE\SAFE.E
f:\EUPHORIA23\INCLUDE\SAFE.E
f:\EUPHORIA\INCLUDE\SAFE.E
and my environment symbols are...
EUDIR=F:\EUPHORIA
EUINC=f:\win32lib\include;f:\projects\euinc;.
I've attached a screen dump of the windows find results...
So it seems that I'm running the official safe.e and it still works. Sorry to be
difficult.
--
Derek
--Boundary_(ID_CPyZ++6CtfUnAsYXp5mIqQ)
Content-type: application/x-compressed; name=safe.zip
17. Re: Running safe.e ???
This is a multi-part message in MIME format.
--Boundary_(ID_0DtQ83yyc81XdHZvQNEkBA)
----- Original Message -----
From: <jbrown105 at speedymail.org>
To: "EUforum" <EUforum at topica.com>
Sent: Sunday, September 21, 2003 1:51 PM
Subject: Re: Running safe.e ???
>
>
> On Sun, Sep 21, 2003 at 07:28:13AM +1000, Derek Parnell wrote:
> > > The bug lies in safe_address() in safe.e.
> > >
> > [snip]
> >
> > Whatever. All I'm saying is that I'm using safe.e from Eu 2.4 and it WORKS
> > on my machine.
> >
> > If I run the example code above I get this ...
> >
> > Euphoria Interpreter 2.4 for 32-bit DOS.
> > Copyright (c) Rapid Deployment Software 2003
> > This Complete Edition of Euphoria is a licensed
> > product of Rapid Deployment Software and may
> > not be redistributed, except with the written
> > permission of Rapid Deployment Software.
> >
> > file name to execute? test
> >
> > Using Debug Version of machine.e
> > 2195227448
> > 0
> >
> > --
> > Derek
> >
>
> Lets see the sniplets of code for your allocate_string(), poke(), and
> safe_address() from your safe.e. It may be that you are somehow accidently
> using 2.3 safe.e in 2.4, so this is why I ask.
>
> jbrown
>
> >
> > TOPICA - Start your own email discussion group. FREE!
> >
> >
> --
> "The quest for peace may only bring pain, or may the quest of pain bring
> peace?" - Someone
>
> --^----------------------------------------------------------------
> This email was sent to: ddparnell at bigpond.com
>
>
> TOPICA - Start your own email discussion group. FREE!
>
>
--Boundary_(ID_0DtQ83yyc81XdHZvQNEkBA)
Content-type: application/octet-stream; name=safe.e
Content-transfer-encoding: quoted-printable
Content-disposition: attachment; filename=safe.e
-- Euphoria 2.4
-- Machine Level Programming (386/486/Pentium)
-- This is a DEBUGGING VERSION of machine.e
-- How To Use This File:
-- 1. Copy safe.e into the same directory as your main .ex[w][u] file =
and=20
-- rename safe.e as machine.e in that directory. (Do NOT simply=20
-- include safe.e, or you may have naming conflicts.)
-- 2. If your program doesn't already include machine.e add: =20
-- include machine.e =20
-- to your main .ex[w][u] file at the top.
-- 3. If necessary, call register_block(address, length) to add =
additional
-- "external" blocks of memory to the safe_address_list. These are =
blocks=20
-- of memory that are safe to read/write but which you did not =
acquire=20
-- through Euphoria's allocate() or allocate_low(). Call=20
-- unregister_block(address) when you want to prevent further access =
to=20
-- an external block.
-- 4. Run your program. It might be 10x slower than normal but it's
-- worth it to catch a nasty bug.
-- 5. If a bug is caught, you will hear some "beep" sounds.
-- Press Enter to clear the screen and see the error message.=20
-- There will be a "divide by zero" traceback in ex.err=20
-- so you can find the statement that is making the illegal memory =
access.
-- 6. When you are finished debugging and want to run at full speed,
-- remove or rename the local copy of machine.e (really safe.e)=20
-- in your directory.
-- This file is equivalent to machine.e, but it overrides the built-in=20
-- routines:=20
-- poke, peek, poke4, peek4s, peek4u, call, mem_copy, and mem_set
-- and it provides alternate versions of:
-- allocate, allocate_low, free, free_low
-- Some parameters you may wish to change:
global integer check_calls, edges_only
check_calls =3D 1 -- if 1, check all blocks for edge corruption after =
each=20
-- call(), dos_interrupt(), c_proc(), or c_func().=20
-- To save time, your program can turn off this checking by=20
-- setting check_calls to 0.=20
edges_only =3D (platform()=3D2) -- on WIN32 people often use =
unregistered blocks =20
-- if 1, only check for references to the leader or trailer
-- areas just outside each registered block.
-- don't complain about addresses that are far out of bounds
-- (it's probably a legitimate block from another source)
-- For a stronger check, set this to 0 if your program=20
-- will never read/write an unregistered block of memory.
=20
-- from misc.e and graphics.e:
constant M_SOUND =3D 1
-- Your program will only be allowed to read/write areas of memory
-- that it allocated (and hasn't freed), as well as areas in low memory=20
-- that you list below, or add dynamically via register_block().
sequence safe_address_list
-- Include the starting address and length of any=20
-- acceptable areas of memory for peek/poke here.=20
-- Set allocation number to 0.
if platform() =3D 1 then -- DOS32
safe_address_list =3D {
-- {start , length , allocation_number} =20
{#A0000, 200*320, 0}, -- mode 19 pixel memory, start & length=20
--{#B0000, 4000 , 0}, -- monochrome text memory, first page
{#B8000, 8000 , 0}, -- color text memory, first page, 50-line mode=20
{1024 , 100 , 0} -- keyboard buffer area (roughly)
-- add more here
}
else
safe_address_list =3D {}
end if
with type_check
puts(1, "\n\t\tUsing Debug Version of machine.e\n")
atom t
t =3D time()
while time() < t + 3 do
end while
constant OK =3D 1, BAD =3D 0
constant M_ALLOC =3D 16,
M_FREE =3D 17,
M_ALLOC_LOW =3D 32,
M_FREE_LOW =3D 33,
M_INTERRUPT =3D 34,
M_SET_RAND =3D 35,
M_USE_VESA =3D 36,
M_CRASH_MESSAGE =3D 37,
M_TICK_RATE =3D 38,
M_GET_VECTOR =3D 39,
M_SET_VECTOR =3D 40,
M_LOCK_MEMORY =3D 41,
M_A_TO_F64 =3D 46,
M_F64_TO_A =3D 47,
M_A_TO_F32 =3D 48,
M_F32_TO_A =3D 49,
M_CRASH_FILE =3D 57
-- biggest address on a 32-bit machine
constant MAX_ADDR =3D power(2, 32)-1
-- biggest address accessible to 16-bit real mode
constant LOW_ADDR =3D power(2, 20)-1
type positive_int(integer x)
return x >=3D 1
end type
type natural(integer x)
return x >=3D 0
end type
type machine_addr(atom a)
-- a 32-bit non-null machine address=20
return a > 0 and a <=3D MAX_ADDR and floor(a) =3D a
end type
type far_addr(sequence a)
-- protected mode far address {seg, offset}
return length(a) =3D 2 and integer(a[1]) and machine_addr(a[2])
end type
type low_machine_addr(atom a)
-- a legal low machine address=20
return a > 0 and a <=3D LOW_ADDR and floor(a) =3D a
end type
constant BORDER_SPACE =3D 40
constant leader =3D repeat('@', BORDER_SPACE)
constant trailer =3D repeat('%', BORDER_SPACE)
function safe_address(atom start, integer len)
-- is it ok to read/write all addresses from start to start+len-1?
atom block_start, block_upper, upper
sequence block
=20
upper =3D start + len
-- search the list of safe memory blocks:
for i =3D 1 to length(safe_address_list) do
block =3D safe_address_list[i]
block_start =3D block[1]
if edges_only then
-- addresses are considered safe as long as=20
-- they aren't in any block's border zone
if start <=3D 3 then
return BAD -- null pointer (or very small address)
end if
if block[3] >=3D 1 then
-- an allocated block with a border area
block_upper =3D block_start + block[2]
if (start >=3D block_start - BORDER_SPACE and=20
start < block_start) or=20
(start >=3D block_upper and=20
start < block_upper + BORDER_SPACE) then
return BAD
=09
elsif (upper > block_start - BORDER_SPACE and
upper <=3D block_start) or
(upper > block_upper and
upper < block_upper + BORDER_SPACE) then
return BAD
=09
elsif start < block_start - BORDER_SPACE and
upper > block_upper + BORDER_SPACE then
return BAD
end if
end if
else
-- addresses are considered safe as long as=20
-- they are inside an allocated or registered block
if start >=3D block_start then=20
block_upper =3D block_start + block[2]
if upper <=3D block_upper then
if i > 1 then
-- move block i to the top and move 1..i-1 down
if i =3D 2 then
-- common case, subscript is faster than slice:
safe_address_list[2] =3D safe_address_list[1]
else
safe_address_list[2..i] =3D safe_address_list[1..i-1]
end if
safe_address_list[1] =3D block
end if
return OK
end if
end if
end if
end for
if edges_only then
return OK -- not found in any border zone
else
return BAD -- not found in any safe block
end if
end function
procedure die(sequence msg)
-- Terminate with a message.
-- makes warning beeps first so you can see what's happening on the =
screen
atom t
=20
for i =3D 1 to 7 do
machine_proc(M_SOUND, 1000)
t =3D time()
while time() < t + .1 do
end while
machine_proc(M_SOUND, 0)
t =3D time()
while time() < t + .1 do
end while
end for
puts(1, "\n *** Press Enter *** ")
if getc(0) then
end if
if machine_func(5, -1) then -- graphics_mode
end if
puts(1, "\n\n" & msg & "\n\n")
if getc(0) then
end if
? 1/0 -- force traceback
end procedure
function bad_address(atom a)
-- show address in decimal and hex =20
return sprintf(" ADDRESS!!!! %d (#%08x)", {a, a})
end function
function original_peek(object x)
return peek(x) -- Euphoria's normal peek
end function
without warning
-- override "peek" with debug peek
global function peek(object x)
-- safe version of peek=20
integer len
atom a
=20
if atom(x) then
len =3D 1
a =3D x
else
len =3D x[2]
a =3D x[1]
end if
if safe_address(a, len) then
return original_peek(x)
else
die("BAD PEEK" & bad_address(a))
end if
end function
function original_peek4s(object x)
return peek4s(x) -- Euphoria's normal peek
end function
-- override "peek4s" with debug peek4s
global function peek4s(object x)
-- safe version of peek4s=20
integer len
atom a
=20
if atom(x) then
len =3D 4
a =3D x
else
len =3D x[2]*4
a =3D x[1]
end if
if safe_address(a, len) then
return original_peek4s(x)
else
die("BAD PEEK4S" & bad_address(a))
end if
end function
function original_peek4u(object x)
return peek4u(x) -- Euphoria's normal peek
end function
-- override "peek4u" with debug peek4u
global function peek4u(object x)
-- safe version of peek4u=20
integer len
atom a
=20
if atom(x) then
len =3D 4
a =3D x
else
len =3D x[2]*4
a =3D x[1]
end if
if safe_address(a, len) then
return original_peek4u(x)
else
die("BAD PEEK4U" & bad_address(a))
end if
end function
procedure original_poke(atom a, object v)
poke(a, v)
end procedure
global procedure poke(atom a, object v)
-- safe version of poke=20
integer len
=20
if atom(v) then
len =3D 1
else
len =3D length(v)
end if
if safe_address(a, len) then
original_poke(a, v)
else
die("BAD POKE" & bad_address(a))
end if
end procedure
procedure original_poke4(atom a, object v)
poke4(a, v)
end procedure
global procedure poke4(atom a, object v)
-- safe version of poke4=20
integer len
=20
if atom(v) then
len =3D 4
else
len =3D length(v)*4
end if
if safe_address(a, len) then
original_poke4(a, v)
else
die("BAD POKE4" & bad_address(a))
end if
end procedure
procedure original_mem_copy(atom target, atom source, atom len)
mem_copy(target, source, len)
end procedure
global procedure mem_copy(machine_addr target, machine_addr source, =
natural len)
-- safe mem_copy
if not safe_address(target, len) then=20
die("BAD MEM_COPY TARGET" & bad_address(target))
elsif not safe_address(source, len) then
die("BAD MEM_COPY SOURCE" & bad_address(source))
else
original_mem_copy(target, source, len)
end if
end procedure
procedure original_mem_set(atom target, atom value, integer len)
mem_set(target, value, len)
end procedure
global procedure mem_set(machine_addr target, atom value, natural len)
-- safe mem_set
if safe_address(target, len) then
original_mem_set(target, value, len)
else
die("BAD MEM_SET" & bad_address(target))
end if
end procedure
atom allocation_num
allocation_num =3D 0
procedure show_byte(atom m)
-- display byte at memory location m
integer c
=20
c =3D original_peek(m)
if c <=3D 9 then
printf(1, "%d", c)
elsif c < 32 or c > 127 then
printf(1, "%d #%02x", {c, c})
else
if c =3D leader[1] or c =3D trailer[1] then
printf(1, "%s", c)
else
printf(1, "%d #%02x '%s'", {c, c, c})
end if
end if
puts(1, ", ")
end procedure
procedure show_block(sequence block_info)
-- display a corrupted block and die
integer len, id, bad, p
atom start
=20
start =3D block_info[1]
len =3D block_info[2]
id =3D block_info[3]
printf(1, "BLOCK# %d, START: #%x, SIZE %d\n", {id, start, len})
-- check pre-block
bad =3D 0
for i =3D start-BORDER_SPACE to start-1 do
p =3D original_peek(i)
if p !=3D leader[1] or bad then
bad +=3D 1
if bad =3D 1 then
puts(1, "DATA WAS STORED ILLEGALLY, JUST BEFORE THIS BLOCK:\n")
puts(1, "(" & leader[1] & " characters are OK)\n")
printf(1, "#%x: ", i)
end if
show_byte(i)
end if
end for
puts(1, "\nDATA WITHIN THE BLOCK:\n")
printf(1, "#%x: ", start)
if len <=3D 30 then
-- show whole block
for i =3D start to start+len-1 do
show_byte(i)
end for=20
else
-- first part of block
for i =3D start to start+14 do
show_byte(i)
end for=20
-- last part of block
puts(1, "\n ...\n")
printf(1, "#%x: ", start+len-15)
for i =3D start+len-15 to start+len-1 do
show_byte(i)
end for=20
end if
bad =3D 0
-- check post-block
for i =3D start+len to start+len+BORDER_SPACE-1 do
p =3D original_peek(i)
if p !=3D trailer[1] or bad then
bad +=3D 1
if bad =3D 1 then
puts(1, "\nDATA WAS STORED ILLEGALLY, JUST AFTER THIS BLOCK:\n")
puts(1, "(" & trailer[1] & " characters are OK)\n")
printf(1, "#%x: ", i)
end if
show_byte(i)
end if
end for=20
die("")
end procedure
global procedure check_all_blocks()
-- Check all allocated blocks for corruption of the leader and trailer =
areas.=20
integer n
atom a
sequence block
=20
for i =3D 1 to length(safe_address_list) do
block =3D safe_address_list[i]
if block[3] >=3D 1 then
-- a block that we allocated
a =3D block[1]
n =3D block[2]
if not equal(leader,=20
original_peek({a-BORDER_SPACE, BORDER_SPACE})) then
show_block(block)
elsif not equal(trailer,=20
original_peek({a+n, BORDER_SPACE})) then
show_block(block)
end if =20
end if
end for
end procedure
procedure original_call(atom addr)
call(addr)
end procedure
global procedure call(atom addr)
-- safe call - machine code must start in block that we own
if safe_address(addr, 1) then
original_call(addr)
if check_calls then
check_all_blocks() -- check for any corruption
end if
else
die(sprintf("BAD CALL ADDRESS!!!! %d\n\n", addr))
end if
end procedure
procedure original_c_proc(integer i, sequence s)
c_proc(i, s)
end procedure
global procedure c_proc(integer i, sequence s)
original_c_proc(i, s)
if check_calls then
check_all_blocks()
end if
end procedure
function original_c_func(integer i, sequence s)
return c_func(i, s)
end function
global function c_func(integer i, sequence s)
object r
=20
r =3D original_c_func(i, s)
if check_calls then
check_all_blocks()
end if=20
return r
end function
global procedure register_block(machine_addr block_addr, positive_int =
block_len)
-- register an externally-acquired block of memory as being safe to use
allocation_num +=3D 1
safe_address_list =3D prepend(safe_address_list, {block_addr, =
block_len,
-allocation_num})
end procedure
global procedure unregister_block(machine_addr block_addr)
-- remove an external block of memory from the safe address list
for i =3D 1 to length(safe_address_list) do
if safe_address_list[i][1] =3D block_addr then
if safe_address_list[i][3] >=3D 0 then
die("ATTEMPT TO UNREGISTER A NON-EXTERNAL BLOCK")
end if
safe_address_list =3D safe_address_list[1..i-1] &
safe_address_list[i+1..length(safe_address_list)]
return
end if =20
end for
die("ATTEMPT TO UNREGISTER A BLOCK THAT WAS NOT REGISTERED!")
end procedure
function prepare_block(atom a, integer n)
-- set up an allocated block so we can check it for corruption
if a =3D 0 then
die("OUT OF MEMORY!")
end if
original_poke(a, leader)
a +=3D BORDER_SPACE
original_poke(a+n, trailer)
allocation_num +=3D 1
-- if allocation_num =3D ??? then=20
-- trace(1) -- find out who allocated this block number
-- end if =20
safe_address_list =3D prepend(safe_address_list, {a, n, =
allocation_num})
return a
end function
global function allocate(positive_int n)
-- allocate memory block and add it to safe list
atom a
integer half
a =3D machine_func(M_ALLOC, n+BORDER_SPACE*2)
return prepare_block(a, n)
end function
global function allocate_low(positive_int n)
-- allocate memory block and add it to safe list
atom a
=20
a =3D machine_func(M_ALLOC_LOW, n+BORDER_SPACE*2)
return prepare_block(a, n)
end function
global procedure free(machine_addr a)
-- free address a - make sure it was allocated
integer n
=20
for i =3D 1 to length(safe_address_list) do
if safe_address_list[i][1] =3D a then
-- check pre and post block areas
if safe_address_list[i][3] <=3D 0 then
die("ATTEMPT TO FREE A BLOCK THAT WAS NOT ALLOCATED!")
end if
n =3D safe_address_list[i][2]
if not equal(leader, original_peek({a-BORDER_SPACE, BORDER_SPACE})) =
then
show_block(safe_address_list[i])
elsif not equal(trailer, original_peek({a+n, BORDER_SPACE})) then
show_block(safe_address_list[i])
end if =20
machine_proc(M_FREE, a-BORDER_SPACE)
-- remove it from list
safe_address_list =3D=20
safe_address_list[1..i-1] &
safe_address_list[i+1..length(safe_address_list)]
return
end if
end for
die("ATTEMPT TO FREE USING AN ILLEGAL ADDRESS!")
end procedure
global procedure free_low(low_machine_addr a)
-- free low address a - make sure it was allocated
integer n
=20
if a > 1024*1024 then
die("TRYING TO FREE A HIGH ADDRESS USING free_low!")
end if
for i =3D 1 to length(safe_address_list) do
if safe_address_list[i][1] =3D a then
-- check pre and post block areas
if safe_address_list[i][3] <=3D 0 then
die("ATTEMPT TO FREE A BLOCK THAT WAS NOT ALLOCATED!")
end if
n =3D safe_address_list[i][2]
if not equal(leader, original_peek({a-BORDER_SPACE, BORDER_SPACE})) =
then
show_block(safe_address_list[i])
elsif not equal(trailer, original_peek({a+n, BORDER_SPACE})) then
show_block(safe_address_list[i])
end if =20
machine_proc(M_FREE_LOW, a-BORDER_SPACE)
-- remove it from list
safe_address_list =3D=20
safe_address_list[1..i-1] &
safe_address_list[i+1..length(safe_address_list)]
return
end if
end for
die("ATTEMPT TO FREE USING AN ILLEGAL ADDRESS!")
end procedure
global constant REG_LIST_SIZE =3D 10
type register_list(sequence r)
-- a list of register values
return length(r) =3D REG_LIST_SIZE
end type
global function dos_interrupt(integer int_num, register_list input_regs)
-- call the DOS operating system via software interrupt int_num, using =
the
-- register values in input_regs. A similar register_list is returned.
-- It contains the register values after the interrupt.
object r
r =3D machine_func(M_INTERRUPT, {int_num, input_regs})
if check_calls then
check_all_blocks()
end if
return r
end function
----------- the rest is identical to machine.e =
------------------------------
type sequence_8(sequence s)
-- an 8-element sequence
return length(s) =3D 8
end type
type sequence_4(sequence s)
-- a 4-element sequence
return length(s) =3D 4
end type
global constant REG_DI =3D 1, =20
REG_SI =3D 2,
REG_BP =3D 3,
REG_BX =3D 4,
REG_DX =3D 5,
REG_CX =3D 6,
REG_AX =3D 7,
REG_FLAGS =3D 8, -- on input: ignored=20
-- on output: low bit has carry flag for=20
-- success/fail
REG_ES =3D 9,
REG_DS =3D 10
global function int_to_bytes(atom x)
-- returns value of x as a sequence of 4 bytes=20
-- that you can poke into memory=20
-- {bits 0-7, (least significant)
-- bits 8-15,
-- bits 16-23,
-- bits 24-31} (most significant)
-- This is the order of bytes in memory on 386+ machines.
integer a,b,c,d
=20
a =3D remainder(x, #100)
x =3D floor(x / #100)
b =3D remainder(x, #100)
x =3D floor(x / #100)
c =3D remainder(x, #100)
x =3D floor(x / #100)
d =3D remainder(x, #100)
return {a,b,c,d}
end function
atom mem
mem =3D allocate(4)
global function bytes_to_int(sequence s)
-- converts 4-byte peek() sequence into an integer value
if length(s) =3D 4 then
poke(mem, s)
else =20
poke(mem, s[1..4])
end if
return peek4u(mem)
end function
global function int_to_bits(atom x, integer nbits)
-- Returns the low-order nbits bits of x as a sequence of 1's and 0's.=20
-- Note that the least significant bits come first. You can use =
Euphoria's
-- and/or/not operators on sequences of bits. You can also subscript,=20
-- slice, concatenate etc. to manipulate bits.
sequence bits
integer mask
=20
bits =3D repeat(0, nbits)
if integer(x) and nbits < 30 then
-- faster method
mask =3D 1
for i =3D 1 to nbits do
bits[i] =3D and_bits(x, mask) and 1
mask *=3D 2
end for
else
-- slower, but works for large x and large nbits
if x < 0 then
x +=3D power(2, nbits) -- for 2's complement bit pattern
end if
for i =3D 1 to nbits do
bits[i] =3D remainder(x, 2)=20
x =3D floor(x / 2)
end for
end if
return bits
end function
global function bits_to_int(sequence bits)
-- get the (positive) value of a sequence of "bits"
atom value, p
=20
value =3D 0
p =3D 1
for i =3D 1 to length(bits) do
if bits[i] then
value +=3D p
end if
p +=3D p
end for
return value
end function
global procedure set_rand(integer seed)
-- Reset the random number generator.
-- A given value of seed will cause the same series of
-- random numbers to be generated from the rand() function
machine_proc(M_SET_RAND, seed)
end procedure
global procedure use_vesa(integer code)
-- If code is 1 then force Euphoria to use the VESA graphics standard.
-- This may let Euphoria work better in SVGA modes with certain graphics =
cards.
-- If code is 0 then Euphoria's normal use of the graphics card is =
restored.
-- Values of code other than 0 or 1 should not be used.
machine_proc(M_USE_VESA, code)
end procedure
global procedure crash_message(sequence msg)
-- Specify a final message to display for your user, in the event=20
-- that Euphoria has to shut down your program due to an error.
machine_proc(M_CRASH_MESSAGE, msg)
end procedure
global procedure crash_file(sequence file_path)
-- Specify a file name in place of "ex.err" where you want
-- diagnostic information to be written.
machine_proc(M_CRASH_FILE, file_path)
end procedure
global procedure tick_rate(atom rate)
-- Specify the number of clock-tick interrupts per second.
-- This determines the precision of the time() library routine,=20
-- and also the sampling rate for time profiling.
machine_proc(M_TICK_RATE, rate)
end procedure
global function get_vector(integer int_num)
-- returns the current (far) address of the interrupt handler
-- for interrupt vector number int_num as a 2-element sequence:=20
-- {16-bit segment, 32-bit offset}
return machine_func(M_GET_VECTOR, int_num)
end function
global procedure set_vector(integer int_num, far_addr a)
-- sets a new interrupt handler address for vector int_num =20
machine_proc(M_SET_VECTOR, {int_num, a})
end procedure
global procedure lock_memory(machine_addr a, positive_int n)
-- Prevent a chunk of code or data from ever being swapped out to disk.
-- You should lock any code or data used by an interrupt handler.
machine_proc(M_LOCK_MEMORY, {a, n})
end procedure
global function atom_to_float64(atom a)
-- Convert an atom to a sequence of 8 bytes in IEEE 64-bit format
return machine_func(M_A_TO_F64, a)
end function
global function atom_to_float32(atom a)
-- Convert an atom to a sequence of 4 bytes in IEEE 32-bit format
return machine_func(M_A_TO_F32, a)
end function
global function float64_to_atom(sequence_8 ieee64)
-- Convert a sequence of 8 bytes in IEEE 64-bit format to an atom
return machine_func(M_F64_TO_A, ieee64)
end function
global function float32_to_atom(sequence_4 ieee32)
-- Convert a sequence of 4 bytes in IEEE 32-bit format to an atom
return machine_func(M_F32_TO_A, ieee32)
end function
global function allocate_string(sequence s)
-- create a C-style null-terminated string in memory
atom mem
=20
mem =3D allocate(length(s) + 1)
if mem then
poke(mem, s)
poke(mem+length(s), 0) -- Thanks to Aku
end if
return mem
end function
--Boundary_(ID_0DtQ83yyc81XdHZvQNEkBA)--
19. Re: Running safe.e ???
On Sun, 21 Sep 2003 23:17:08 +1000, Derek Parnell
<ddparnell at bigpond.com> wrote:
>So it seems that I'm running the official safe.e and it still works. =
Sorry to be difficult.
I saved your safe.e and ran against it, still failing.
-- code:
with trace
include safe.e
trace(1)
atom a a =3D allocate_string("")
Here is the debug dump at the point of failure:
safe.e F1=3Dmain F2=3Dtrace Enter down-arrow ? q Q !
157: if block[3] >=3D 1 then
158: -- an allocated block with a border area
159: block_upper =3D block_start + block[2]
160: if (start >=3D block_start - BORDER_SPACE and
161: start < block_start) or
162: (start >=3D block_upper and
163: start < block_upper + BORDER_SPACE) then
164: return BAD
165:
166: elsif (upper > block_start - BORDER_SPACE and
167: upper <=3D block_start) or
168: (upper > block_upper and
169: upper < block_upper + BORDER_SPACE) then
170: --this is dereks posted copy of safe.e
171=3D=3D> return BAD
172:
173: elsif start < block_start - BORDER_SPACE and
174: upper > block_upper + BORDER_SPACE then
175: return BAD
variable name? BORDER_SPACE
upper=3D4509452 block_start=3D4509452 BORDER_SPACE=3D40(
block_upper=3D4509453
block=3D{4509452,1,2}
safe_address_list=3D{{4509452,1,2},{4462352,4,1}}
(I put that comment in at line 170 to make doubly sure, of course).
If you trace it, what do you get at line 166?
Pete
