时间戳

首页 > 解决方案 > CLisp/FFI 在 win32 中崩溃，可能是因为垃圾收集

winapi - CLisp/FFI 在 win32 中崩溃，可能是因为垃圾收集

问题描述

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 函数，而是简单的 lisp 命令，例如(dotimes ... (dotimes ... ))or(format t "a lot of text")

我不确定我是否正确分配/存储了我的 FFI windows 变量。

Cookbook http://cl-cookbook.sourceforge.net/win32.html有一个示例“附录 A：“Hello, Lisp”程序 #1”，它在手动分配 win32 字符串和结构方面更具侵略性。我不知道在 FFI 而不是 FLI 中是否有必要这样做，而且我自己尝试手动分配 MSG 缓冲区并在三个 Windows 函数之间传递它都失败了。

标签： winapilispcommon-lispfficlisp

解决方案

Windows 发送的消息是否在WM_PAINT执行主消息循环的同一线程中？

推荐阅读