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

Question

Windows 10，CLISP 2.49，FFI。

我已经使用内置的FFI启动了一个windows循环和一个基本的windproc回调。初始的windows消息WM_PAINT很好。在某些测试中，SetWindowPos或最小化/最大化窗口(所有这些都调用WM_PAINT )也很好。

但是当我，用户，抓住窗口的边缘调整窗口的大小时，它就崩溃了。没有lisp错误。我试图通过Visual附加到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窗口变量。

Cookbook http://cl-cookbook.sourceforge.net/win32.html有一个例子“附录A："Hello，Lisp”Program #1“，这对于手动分配win32字符串和结构来说要激进得多。我不知道这在FFI中是否有必要，而不是FLI，而且我自己尝试手动分配MSG缓冲区并在三个窗口函数之间传递它的尝试失败了。

Answer 1

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

如果

• 是，那么它很可能是CLISP中的一个bug。如果您也可以在当前的预发行版2.49.92 (可从https://alpha.gnu.org/gnu/clisp/获得)中复制它，那么值得在https://gitlab.com/gnu-clisp/clisp/-/issues .
• 上提交一个bug报告，如果不是，那么目前没有办法让它与CLISP一起工作；然后我建议使用SBCL。其原因是CLISP中的多线程尚未为黄金时段做好准备，而SBCL很好地支持多个线程。

。