CLisp/FFI 在 win32 中崩溃，可能是因为垃圾回收
CLisp/FFI is crashing in win32, possibly because of garbage collection
Windows 10，CLISP 2.49，FFI。
我已经使用内置的 FFI 启动了一个 windows 循环和一个基本的 windproc 回调。初始 windows 消息 WM_PAINT 没问题。在某些测试中，SetWindowPos或minimizing/maximizing window，都调用WM_PAINT也可以。
但是当我，用户，抓住 window 边缘来调整 window 的大小时，它崩溃了。没有 lisp 错误。我试图通过 Visual Studio 连接到 CLISP，但也没有 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 函数，而是像 (dotimes ... (dotimes ... )) 或 (format t "a lot of text")
这样简单的 lisp 命令
我不确定我 allocating/storing 我的 FFI windows 变量是否正确。
Cookbook http://cl-cookbook.sourceforge.net/win32.html 有一个示例“附录 A：“Hello, Lisp”程序 #1”，它在手动分配 win32 字符串和结构方面更加激进。我不知道这在 FFI 中是否有必要，而不是在 FLI 中，我自己尝试手动分配 MSG 缓冲区并在三个 windows 函数之间传递它的尝试失败了。
Windows 发送的 WM_PAINT 消息是否在执行主消息循环的同一线程中？
- 如果是，则可能是 CLISP 中的错误。如果您也可以使用当前的预发行版 2.49.92 重现它（可从 https://alpha.gnu.org/gnu/clisp/), it's worth submitting a bug report at https://gitlab.com/gnu-clisp/clisp/-/issues 获得。
- 如果不是，那么目前还没有办法使用 CLISP 进行这项工作；然后我会推荐 SBCL。原因是CLISP中的多线程还没有为prime-time做好准备，而SBCL很好地支持多线程。
Windows 10，CLISP 2.49，FFI。
我已经使用内置的 FFI 启动了一个 windows 循环和一个基本的 windproc 回调。初始 windows 消息 WM_PAINT 没问题。在某些测试中，SetWindowPos或minimizing/maximizing window，都调用WM_PAINT也可以。
但是当我，用户，抓住 window 边缘来调整 window 的大小时，它崩溃了。没有 lisp 错误。我试图通过 Visual Studio 连接到 CLISP，但也没有 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 函数，而是像 (dotimes ... (dotimes ... )) 或 (format t "a lot of text")
我不确定我 allocating/storing 我的 FFI windows 变量是否正确。
Cookbook http://cl-cookbook.sourceforge.net/win32.html 有一个示例“附录 A：“Hello, Lisp”程序 #1”，它在手动分配 win32 字符串和结构方面更加激进。我不知道这在 FFI 中是否有必要，而不是在 FLI 中，我自己尝试手动分配 MSG 缓冲区并在三个 windows 函数之间传递它的尝试失败了。
Windows 发送的 WM_PAINT 消息是否在执行主消息循环的同一线程中？
- 如果是，则可能是 CLISP 中的错误。如果您也可以使用当前的预发行版 2.49.92 重现它（可从 https://alpha.gnu.org/gnu/clisp/), it's worth submitting a bug report at https://gitlab.com/gnu-clisp/clisp/-/issues 获得。
- 如果不是，那么目前还没有办法使用 CLISP 进行这项工作；然后我会推荐 SBCL。原因是CLISP中的多线程还没有为prime-time做好准备，而SBCL很好地支持多线程。