【发布时间】：2021-02-20 00:42:52
【问题描述】：
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,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命令
我不确定我是否正确分配/存储了我的 FFI windows 变量。
Cookbook http://cl-cookbook.sourceforge.net/win32.html 有一个示例“附录 A：“Hello, Lisp”程序 #1”，它在手动分配 win32 字符串和结构方面更具侵略性。我不知道在 FFI 而不是 FLI 中是否有必要这样做，而且我自己尝试手动分配 MSG 缓冲区并在三个 Windows 函数之间传递它失败了。
【问题讨论】：
标签： winapi lisp common-lisp ffi clisp