OpenEuphoria

[CODE] Routines for Working with DIBs

• Posted by David Guy <dguy at MINDSPRING.COM> Feb 17, 1999
• 445 views

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