[fpc-pascal] DirectX applications crash

[Felipe Monteiro de Carvalho]

Hello,

I've always had a problem with using COM with Free Pascal. If I
release the interfaces, then the application crashes without reason
somewhere unrelated with the code to do the actual release. In the
following example I used the DirectX units from clootie:

http://www.clootie.ru/fpc/index.html

When I use _release I get this crash:

(gdb) run
Starting program: C:\Documents and Settings\Felipe\Meus documentos\felipedocs\Ar
tigos\Lazarusbuch\kapitel_5/directxcube.exe

Program received signal SIGSEGV, Segmentation fault.
0x00407c96 in fpc_intf_decr_ref ()
(gdb) bt
#0  0x00407c96 in fpc_intf_decr_ref ()
#1  0x0040194d in P$DIRECTXCUBE_finalize_implicit () at directxcube.pas:134
#2  0x004097a4 in SYSTEM_FINALIZEUNITS ()
#3  0x00000000 in ?? ()
(gdb)

If I don't release the interfaces then no exception occurs. I always
have this problem when using DirectX with Free Pascal. Clootie has no
forum, so I thought that asking here would be the best idea ...

Here is the test app which I converted from a C tutorial for directx:

program directxcube;

{$mode delphi}

uses
  Classes, SysUtils,
  // include the basic windows header files and the Direct3D header file
  Windows,
  Direct3D9, D3DX9;

var
  // global declarations
  d3d: IDirect3D9;    // the pointer to our Direct3D interface
  d3ddev: IDirect3DDevice9;    // the pointer to the device class

// function prototypes
procedure initD3D(hWnd: HWND); forward;    // sets up and initializes Direct3D
procedure render_frame(); forward;    // renders a single frame
procedure cleanD3D(); forward;   // closes Direct3D and releases memory

// the WindowProc function prototype
//function WindowProc(HWND hWnd, UINT message, WPARAM wParam, LPARAM lParam);

// this is the main message handler for the program
function WindowProc(_hWnd: HWND; _message: UINT; _wParam: WPARAM;
_lParam: LPARAM): LRESULT; stdcall;
begin
  if _message = WM_DESTROY then
  begin
    PostQuitMessage(0);
    Result := 0;
    Exit;
  end;

  Result := DefWindowProc (_hWnd, _message, _wParam, _lParam);
end;

// this function initializes and prepares Direct3D for use
procedure initD3D(hWnd: HWND);
var
  d3dpp: D3DPRESENT_PARAMETERS;    // create a struct to hold various
device information
begin
  d3d := Direct3DCreate9(D3D_SDK_VERSION);    // create the Direct3D interface

  FillChar(d3dpp, sizeof(d3dpp), 0);    // clear out the struct for use
  d3dpp.Windowed := TRUE;    // program windowed, not fullscreen
  d3dpp.SwapEffect := D3DSWAPEFFECT_DISCARD;    // discard old frames
  d3dpp.hDeviceWindow := hWnd;    // set the window to be used by Direct3D

  // create a device class using this information and information from
the d3dpp stuct
  d3d.CreateDevice(D3DADAPTER_DEFAULT,
                      D3DDEVTYPE_HAL,
                      hWnd,
                      D3DCREATE_SOFTWARE_VERTEXPROCESSING,
                      @d3dpp,
                      d3ddev);
end;

// this is the function used to render a single frame
procedure render_frame();
begin
    // clear the window to a deep blue
    d3ddev.Clear(0, nil, D3DCLEAR_TARGET, D3DCOLOR_XRGB(0, 40, 100), 1.0, 0);

    d3ddev.BeginScene();    // begins the 3D scene

    // do 3D rendering on the back buffer here

    d3ddev.EndScene();    // ends the 3D scene

    d3ddev.Present(nil, nil, 0, nil);   // displays the created frame
on the screen
end;

// this is the function that cleans up Direct3D and COM
procedure cleanD3D();
begin
  d3ddev._Release();    // close and release the 3D device
  d3d._Release();    // close and release Direct3D
end;

var
  _hWnd: HWND;
  wc: WNDCLASSEX;
  _msg: MSG;
  starting_point: Cardinal;
begin
  FillChar(wc, sizeof(WNDCLASSEX), 0);

  wc.cbSize := sizeof(WNDCLASSEX);
  wc.style := CS_HREDRAW or CS_VREDRAW;
  wc.lpfnWndProc := WindowProc;
  wc.hInstance := hInstance;
  wc.hCursor := LoadCursor(0, IDC_ARROW);
  wc.hbrBackground := HBRUSH(COLOR_WINDOW);
  wc.lpszClassName := 'WindowClass';

  RegisterClassEx(@wc);

  _hWnd := CreateWindowEx(0,
                         'WindowClass',
                         'Our First Direct3D Program',
                         WS_OVERLAPPEDWINDOW,
                         300, 300,
                         640, 480,
                         0,
                         0,
                         hInstance,
                         nil);

  ShowWindow(_hWnd, SW_SHOW);

  // set up and initialize Direct3D
  initD3D(_hWnd);

  // enter the main loop:
  while (True) do
  begin
    starting_point := GetTickCount();

    if (PeekMessage(_msg, 0, 0, 0, PM_REMOVE)) then
    begin
      if (_msg.message = WM_QUIT) then Break;

      TranslateMessage(_msg);
      DispatchMessage(_msg);
    end;

    render_frame();

    while ((GetTickCount() - starting_point) < 25) do;
  end;

  // clean up DirectX and COM
  cleanD3D(); // Comment or uncomment
end.