问题描述
Windows 10，CLISP 2.49，FFI。
我已经使用内置的FFI启动Windows循环和基本的windproc回调。初始Windows消息WM_PAINT很好。在某些测试中，也可以使用SetwindowPos或最小化/最大化窗口（都调用WM_PAINT）。
但是，当我（用户）抓住窗口边缘以调整窗口大小时，它崩溃了。没有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,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,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,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：“ Hello，Lisp”程序＃1“，它在手动分配Win32字符串和结构上更具攻击性。我不知道在FFI中相对于FLI是否有必要，而且我手动分配MSG缓冲区并将其在三个Windows函数之间传递的尝试失败。
解决方法
Windows是否在执行主消息循环的同一线程中发送了WM_PAINT条消息？
- 如果是，则可能是CLISP中的错误。如果您还可以使用当前的预发行版2.49.92（可从https://alpha.gnu.org/gnu/clisp/获得），则值得在https://gitlab.com/gnu-clisp/clisp/-/issues提交错误报告。
- 如果否，那么当前无法使用CLISP进行；然后，我建议使用SBCL。原因是CLISP中的多线程尚未准备就绪，而SBCL很好地支持多线程。