Блог

Windows 10, CLISP 2.49, FFI.

Я использовал встроенный FFI для запуска цикла Windows и базового обратного вызова windproc. Начальное сообщение Windows WM_PAINT в порядке. В некоторых тестах SetWindowPos или минимизация / максимизация окна, все из которых вызываются WM_PAINT , также в порядке.

Но когда я, пользователь, хватаюсь за край окна, чтобы изменить размер окна, происходит сбой. Ошибка lisp отсутствует. Я попытался подключиться к CLISP через Visual Studio, но также нет исключения Windows.

Я добавил (room) и (ext:gc) для проверки проблем с памятью. Я очень подозреваю, что room отчеты "Bytes available until next GC: 6,510" довольно низкие непосредственно перед сбоем программы. Несколько WM_PAINT вызовов будут успешными, но если «доступных байтов» мало, есть хороший (но не 100%) шанс сбоя.

 ; Test Crash
;
; Win32 linkages at top.
; My Win32 windproc and message loop at bottom.
;

(ffi:def-c-enum eWin32Constants
    (WS_OVERLAPPED              #x00000000)
    (WS_VISIBLE                 #x10000000)
    (WS_CAPTION                 #x00C00000)
    (WS_SYSMENU                 #x00080000)
    (WS_THICKFRAME              #x00040000)
    (WM_PAINT                   15 ) ; #x000f
)

;
; Win32 Structs
;

(ffi:def-c-type ATOM      FFI:UINT16)
(ffi:def-c-type BOOL      FFI:INT)
(ffi:def-c-type DWORD     FFI:UINT32)
(ffi:def-c-type HANDLE    FFI:c-pointer)
(ffi:def-c-type HBRUSH    HANDLE)
(ffi:def-c-type HCURSOR   HANDLE)
(ffi:def-c-type HDC       HANDLE)
(ffi:def-c-type HICON     HANDLE)
(ffi:def-c-type HINSTANCE HANDLE)
(ffi:def-c-type HMENU     HANDLE)
(ffi:def-c-type HWND      HANDLE)
(ffi:def-c-type LPARAM    FFI:LONG)
(ffi:def-c-type LPVOID    FFI:c-pointer)
(ffi:def-c-type LRESULT   FFI:LONG)
(ffi:def-c-type WPARAM    FFI:UINT32)

(ffi:def-c-struct POINT
    (X ffi:long) 
    (Y ffi:long))

(FFI:def-c-struct RECT
    (LEFT FFI:LONG)
    (TOP FFI:LONG)
    (RIGHT FFI:LONG)
    (BOTTOM FFI:LONG)
)

(ffi:def-c-struct MSG
    (hwnd HWND) 
    (message FFI:UINT) 
    (wparam WPARAM) 
    (lparam LPARAM) 
    (time dword) 
    (pt POINT) 
    (lprivate dword))

(FFI:def-c-struct PAINTSTRUCT
    (HDC    HDC)
    (FERASE  BOOL )
    (RCPAINT  RECT )
    (FRESTORE   BOOL )
    (FINCUPDATE     BOOL )
    (RGBRESERVED    FFI:UINT8)
)

(ffi:def-c-type WINDPROC (ffi:c-function 
                            (:ARGUMENTS 
                                (hwnd HWND :in)
                                (uMsg FFI:UINT32)
                                (wParam WPARAM)
                                (lParam LPARAM))
                            (:RETURN-TYPE FFI:UINT32) 
                            (:LANGUAGE :stdc)))

(FFI:def-c-struct WNDCLASSA
    (STYLE FFI:UINT32)
    (LPFNWNDPROC WINDPROC)
    (CBCLSEXTRA  FFI:INT)
    (CBWNDEXTRA  FFI:INT)
    (HINSTANCE  HINSTANCE)
    (HICON      HICON)
    (HCURSOR    HCURSOR)
    (HBRBACKGROUND  HBRUSH)
    (LPSZMENUNAME   FFI:C-STRING)
    (LPSZCLASSNAME  FFI:C-STRING)
)

;
; Win32 Functions
;

(ffi:def-call-out RegisterClassA  (:library "user32.dll")
    (:name "RegisterClassA")
    (:arguments (lpWndClass (FFI:c-ptr WNDCLASSA) :in)) ;HACK:; WNDCLASSA 
    (:return-type ATOM))

(defun RegisterClass (_name _style _wnd_proc)
    
    (let* ( (wndclass (make-WNDCLASSA :STYLE _STYLE :|LPFNWNDPROC| _WND_PROC :|LPSZCLASSNAME| _NAME
        :|CBCLSEXTRA|  0 :|CBWNDEXTRA| 0 :|HINSTANCE| NIL :|HICON| NIL
        :|HCURSOR| NIL :|HBRBACKGROUND|  NIL :|LPSZMENUNAME| NIL))
            (registration (RegisterClassA wndclass)))
    ))

(ffi:def-call-out CreateWindowExA  (:library "user32.dll")
    (:name "CreateWindowExA")
    (:arguments 
        (dwExStyle dword)
        (lpClassName FFI:c-string)
        (lpWindowName FFI:c-string)
        (dwStyle dword)
        (X FFI:int)
        (Y FFI:int)
        (nWidth FFI:int)
        (nHeight FFI:int)
        (hWndParent HWND)
        (hMenu HMENU)
        (hInstance HINSTANCE)
        (lpParam LPVOID)
        )
    (:return-type HWND))

(ffi:def-call-out DefWindowProcA  (:library "user32.dll")
    (:name "DefWindowProcA")
    (:arguments 
        (hWnd HWND :in)
        (Msg ffi:uint32 :in)
        (wParam WPARAM :in)
        (lParam LPARAM :in))
    (:return-type LRESULT))
    
(ffi:def-call-out GetMessageA  (:library "user32.dll")
    (:name "GetMessageA")
    (:arguments
        (LPMSG (ffi:c-ptr MSG) :out :alloca)
        (HWND HWND :in)
        (WMSGFILTERMIN FFI:UINT :in)
        (WMSGFILTERMAX FFI:UINT :in))
    (:return-type BOOL))
    
(ffi:def-call-out TranslateMessage  (:library "user32.dll")
    (:name "TranslateMessage")
    (:arguments 
        (LPMSG (ffi:c-ptr MSG) :in-out))
    (:return-type BOOL))

(ffi:def-call-out DispatchMessageA  (:library "user32.dll")
    (:name "DispatchMessageA")
    (:arguments 
        (LPMSG (ffi:c-ptr MSG) :in-out))
    (:return-type BOOL))

(ffi:def-call-out BeginPaint (:library "user32.dll")
    (:name "BeginPaint")
    (:arguments (HWND HWND :in)
                (ps (ffi:c-ptr PAINTSTRUCT) :out :alloca))
    (:return-type (ffi:c-pointer HDC)))

(ffi:def-call-out EndPaint (:library "user32.dll")
    (:name "EndPaint")
    (:arguments (HWND HWND :in)
                (ps (ffi:c-ptr PAINTSTRUCT) :in))
    (:return-type BOOL))

;
; My Win32 App Code
;

(FFI:DEF-CALL-IN MyWindowProc (:ARGUMENTS (handle UINT WPARAM LPARAM))
  (:RETURN-TYPE dword)
  (:LANGUAGE :stdc))
  
(defun MyWindowProc( hWnd uMsg wParam lParam)
    (block defproc
        (cond 
            ((= uMsg WM_PAINT )
                (format t "WM_PAINT~%")
                
                (multiple-value-bind (dc ps)
                    (BeginPaint hWnd )
                    (EndPaint hWnd ps)
                    ; Do nothing, but this clears the dirty flag.
                )
                
                (room)
                (dotimes (j 2) (dotimes (i 40) (format t "*")) (FORMAT T "~%"))
            )

            (t 
                (return-from defproc (DefWindowProcA hWnd uMsg wParam lParam)))
        )
        ; default return
        0
    )
)

(RegisterClass "LispGameWindow" 0 #'MyWindowProc) ;(logior CS_HREDRAW CS_VREDRAW CS_OWNDC)
(let ((*myhwnd* (CreateWindowExA 
                    0 "LispGameWindow" "MyGameWindow" 
                    (logior WS_OVERLAPPED WS_VISIBLE WS_CAPTION WS_SYSMENU WS_THICKFRAME)
                    100 100 655  415 
                    NIL NIL NIL NIL)))

    ; Main message loop:
    (loop
        (multiple-value-bind (ret msg)
            (GetMessageA *myhwnd* 0 0 )
            (when (<= ret 0)
                (return (jMSG-wparam msg)))
            (TranslateMessage msg)
            (DispatchMessageA msg)
        )
        ;(ext:gc)
    )
)
  

Вывод:

 WM_PAINT

Number of garbage collections:                0
Bytes freed by GC:                            0
Time spent in GC:                           0.0 sec
Bytes permanently allocated:             92,960
Bytes currently in use:               2,714,832
Bytes available until next GC:           40,198
****************************************
****************************************
WM_PAINT

Number of garbage collections:                0
Bytes freed by GC:                            0
Time spent in GC:                           0.0 sec
Bytes permanently allocated:             92,960
Bytes currently in use:               2,726,060
Bytes available until next GC:           28,970
****************************************
****************************************
WM_PAINT

Number of garbage collections:                0
Bytes freed by GC:                            0
Time spent in GC:                           0.0 sec
Bytes permanently allocated:             92,960
Bytes currently in use:               2,737,292
Bytes available until next GC:           17,738
****************************************
****************************************
WM_PAINT

Number of garbage collections:                0
Bytes freed by GC:                            0
Time spent in GC:                           0.0 sec
Bytes permanently allocated:             92,960
Bytes currently in use:               2,748,520
Bytes available until next GC:            6,510
************
  

^^ Прерван по-настоящему в момент сбоя.

Сбой происходит не из-за функций Windows, а из-за простых команд lisp, таких как (dotimes ... (dotimes ... )) или (format t "a lot of text")

Я не уверен, что правильно распределяю / сохраняю свои переменные FFI Windows.

Поваренная книга http://cl-cookbook.sourceforge.net/win32.html имеет пример «Приложение A: «Привет, Lisp» Программа № 1″, которая гораздо более агрессивно относится к ручному выделению строк и структур win32. Я не знаю, нужно ли это в FFI в отличие от FLI, и я потерпел неудачу в своих попытках вручную выделить буфер сообщений и передать его между тремя функциями Windows.

Отправляются ли WM_PAINT сообщения Windows в том же потоке, который выполняет основной цикл сообщений?

• Если да, то, скорее всего, это ошибка в CLISP. Если вы можете воспроизвести его также с текущей предварительной версией 2.49.92 (доступна с https://alpha.gnu.org/gnu/clisp /), стоит отправить отчет об ошибке по адресу https://gitlab.com/gnu-clisp/clisp/-/issues .
• Если нет, то в настоящее время нет способа заставить это работать с CLISP; Тогда я бы рекомендовал SBCL вместо этого. Причина в том, что многопоточность в CLISP не готова к прайм-тайм, в то время как SBCL хорошо поддерживает несколько потоков.