1. [CODE] Routines for Working with DIBs
Hi,
While fooling around with Euphoria, Windows and DIBs, I came up with some
routines others might find useful. Here they are:
global function CreatePtrToPtr()
-- creates a pointer-to-a-pointer, which can be passed to Windows for
-- internal use (such as when allocating memory for a DIB section during a
-- call to CreateDIBSection)
atom pToPtr
pToPtr = allocate(4)
return pToPtr
end function
global function DestroyPtrToPtr( atom pToPtr )
-- retrieves the pointer pointed by a previously creates pointer-to-a-
-- pointer, and releases any memory associated with 'pToPtr'
atom ptr
ptr = peek4u( pToPtr )
free( pToPtr )
return ptr
end function
global procedure FillBmpInfoHeader(
atom pBIH,
atom width,
atom height,
atom planes,
atom bitCount,
atom compression,
atom sizeImage,
atom xPelsPerMeter,
atom yPelsPerMeter,
atom clrUsed,
atom clrImportant )
-- fills in the BMPINFOHEADER "structure" pointed to by pBIH
poke4( pBIH + 0, 40 ) -- size of BMPINFOHEADER
poke4( pBIH + 4, width )
poke4( pBIH + 8, height )
-- the two fields that follow are WORDs (ie. two bytes), so they are
-- poke'd a byte at a time, low byte first (ie. the value #FEDC would
-- be stored in memory as [lowaddr ... |#DC|#FE| ... highaddr])
poke ( pBIH + 12, {planes, 0} )
poke ( pBIH + 14, {bitCount, 0} )
poke4( pBIH + 16, compression )
poke4( pBIH + 20, sizeImage )
poke4( pBIH + 24, xPelsPerMeter )
poke4( pBIH + 28, yPelsPerMeter )
poke4( pBIH + 32, clrUsed )
poke4( pBIH + 36, clrImportant )
end procedure
Some additions to safe.e (aka. the debugging version of machine.e):
global procedure register_block( machine_addr block_addr, atom block_len )
-- Adds a block of memory to the list of "safe address" tracked internally
-- by Euphoria, which will allow poke, peek, etc. to catch illegal accesses
-- to it. Currently, only blocks of memory allocated via Euphoria's own
-- allocation routines are tracked.
-- NOTE that 'allocation_num' is stored as a negative number, this allows
-- the modified free() and free_low() routines to catch any attempt to free
-- an externally allocated block
allocation_num += 1
safe_address_list =
append(safe_address_list, {block_addr, block_len, -allocation_num})
end procedure
global procedure unregister_block( machine_addr block_addr )
-- Removes a block of memory from the list of "safe address" tracked
-- internally by Euphoria.
for i = 1 to length(safe_address_list) do
if safe_address_list[i][1] = block_addr then
safe_address_list = safe_address_list[1..i-1] &
safe_address_list[i+1..length(safe_address_list)]
return
end if
end for
die("ATTEMPT TO UNREGISTER A BLOCK THAT WAS NEVER REGISTERED!")
end procedure
Versions of the above two routines for machine.e:
without warning
global procedure register_block( atom block_addr, atom block_len )
end procedure
global procedure unregister_block( atom block_addr )
end procedure
with warning
Below are slightly modified versions of free() and free_low(), from safe.e,
that will catch any attempt to free an externally allocated block:
global procedure free(machine_addr a)
-- free address a - make sure it was allocated
integer n
for i = 1 to length(safe_address_list) do
if safe_address_list[i][1] = a then
if safe_address_list[i][3] > 0 then -- if block was allocated using
Euphoria
-- check pre and post block areas
n = safe_address_list[i][2]
if not equal(leader, original_peek({a-BORDER_SPACE,
BORDER_SPACE})) then
show_block(safe_address_list[i])
end if
if not equal(trailer, original_peek({a+n, BORDER_SPACE})) then
show_block(safe_address_list[i])
end if
machine_proc(M_FREE, a)
-- remove it from list
safe_address_list =
safe_address_list[1..i-1] &
safe_address_list[i+1..length(safe_address_list)]
return
else
die("ATTEMPT TO FREE EXTERNALLY ALLOCATED BLOCK!")
end if
end if
end for
die("ATTEMPT TO FREE AN ADDRESS THAT WAS NEVER ALLOCATED!")
end procedure
global procedure free_low(low_machine_addr a)
-- free low address a - make sure it was allocated
integer n
if a > 1024*1024 then
die("TRYING TO FREE A HIGH ADDRESS USING free_low!")
end if
for i = 1 to length(safe_address_list) do
if safe_address_list[i][1] = a then
if safe_address_list[i][3] > 0 then -- if block was allocated using
Euphoria
-- check pre and post block areas
n = safe_address_list[i][2]
if not equal(leader, original_peek({a-BORDER_SPACE,
BORDER_SPACE})) then
show_block(safe_address_list[i])
end if
if not equal(trailer, original_peek({a+n, BORDER_SPACE})) then
show_block(safe_address_list[i])
end if
machine_proc(M_FREE_LOW, a)
-- remove it from list
safe_address_list =
safe_address_list[1..i-1] &
safe_address_list[i+1..length(safe_address_list)]
return
else
die("ATTEMPT TO FREE EXTERNALLY ALLOCATED BLOCK!")
end if
end if
end for
die("ATTEMPT TO FREE A LOW ADDRESS THAT WAS NEVER ALLOCATED!")
end procedure
All the routines/ changes are simple/small, so hopefully there are no bugs
(though if any one finds any please let me know :)
Hope they prove useful,
David
