CLisp/FFI is crashing in win32, possibly because of garbage collection - winapi

Question

Windows 10, CLISP 2.49, FFI.
I have used the built-in FFI to start a windows loop and a basic windproc callback. The initial windows message WM_PAINT is fine. In some tests, SetWindowPos or minimizing/maximizing the window, all of which call WM_PAINT, are also fine.
But when I, the user, grab the window edge to resize the window, it crashes. There is no lisp error. I've attempted to attach to CLISP via Visual Studio, but there is no windows exception either.
I've added (room) and (ext:gc) to check memory issues. I'm very suspicious that room reports "Bytes available until next GC: 6,510" being pretty low just before the program crashes. Multiple WM_PAINT calls will succeed, but if "bytes available" is low, there's a good (but not 100%) chance of a crash.
; 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)
)
)
Output:
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
************
^^ Broken off for real at the point of the crash.
It is not windows functions that crash, but simple lisp commands like (dotimes ... (dotimes ... )) or (format t "a lot of text")
I am not certain I'm allocating/storing my FFI windows variables correctly.
The Cookbook http://cl-cookbook.sourceforge.net/win32.html has an example "Appendix A: "Hello, Lisp" Program #1" which is much more aggressive about manually allocating win32 strings and structures. I don't know if that's necessary in FFI as opposed to FLI, and I've failed in my own attempts to manually allocate the MSG buffer and pass it between the three windows functions.

Answer 1

Are the WM_PAINT messages sent by Windows in the same thread that executes the main message loop?
If yes, then it's likely a bug in CLISP. If you can reproduce it also with the current prerelease 2.49.92 (available from https://alpha.gnu.org/gnu/clisp/), it's worth submitting a bug report at https://gitlab.com/gnu-clisp/clisp/-/issues .
If no, then there's currently no way to make this work with CLISP; I'd then recommend SBCL instead. The reason is that multithreading in CLISP is not ready for prime-time, while SBCL supports multiple threads well.