Skip to content

gtk: allocate Gtk memory with 'atomic-interior #375

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
samth merged 1 commit into from
Oct 20, 2026
+113 −90
Merged

gtk: allocate Gtk memory with 'atomic-interior #375

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion gui-lib/info.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@
(define deps '("srfi-lite-lib"
"data-lib"
["icons" #:version "1.3"]
["base" #:version "9.0.0.6"]
["base" #:version "9.4.0.2"]
["syntax-color-lib" #:version "1.7"]
["draw-lib" #:version "1.18"]
["snip-lib" #:version "1.6"]
Expand Down
5 changes: 3 additions & 2 deletions gui-lib/mred/private/wx/gtk/canvas.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -41,7 +41,7 @@
_GtkWidget _string _double* (_pointer = #f) -> _void)
#:c-id g_object_set)
(define-gobj g_object_get_double (_fun #:varargs-after 2
_GtkWidget _string (r : (_ptr o _double)) (_pointer = #f)
_GtkWidget _string (r : (_ptr o _double atomic-interior)) (_pointer = #f)
-> _void -> r)
#:c-id g_object_get)

Expand Down Expand Up @@ -179,7 +179,8 @@

;; We rely some on the implementation of GtkComboBoxEntry to replace
;; the drawing routine.
(define-cstruct _GList ([data _pointer]))
(define-cstruct _GList ([data _pointer])
#:malloc-mode 'atomic-interior)
(define-gdk gdk_window_get_children (_fun _pointer -> _GList-pointer/null))
(define-gdk gdk_window_hide (_fun _pointer -> _void))
(define (get-subwindow gtk)
Expand Down
27 changes: 11 additions & 16 deletions gui-lib/mred/private/wx/gtk/clipboard.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,7 +36,8 @@
[format _int]
[data _pointer]
[length _int]
[display _GtkDisplay]))
[display _GtkDisplay])
#:malloc-mode 'atomic-interior)

(define _GtkSelectionData _GtkSelectionDataT-pointer)

Expand All @@ -59,9 +60,10 @@
(define-gtk gtk_selection_data_get_data (_fun _GtkSelectionData -> _pointer)
#:fail (lambda () GtkSelectionDataT-data))

(define-cstruct _GtkTargetEntry ([target _pointer]
(define-cstruct _GtkTargetEntry ([target _string/utf-8/immobile]
[flags _uint]
[info _uint]))
[info _uint])
#:malloc-mode 'interior)

(define (get-data cb sel-data info self-box)
(send (ptr-ref self-box _scheme) provide-data info sel-data))
Expand Down Expand Up @@ -178,21 +180,14 @@
(list (car all-data) (car all-data))
(loop (cdr all-data) (cdr orig-types)))))))
(values orig-types types all-data))])
(let ([target-strings (malloc 'raw _byte (+ (length types)
(apply + (map string-utf-8-length types))))]
[targets (malloc _GtkTargetEntry (length types))])
(for/fold ([offset 0]) ([str (in-list types)]
[i (in-naturals)])
(let ([targets (malloc _GtkTargetEntry (length types) 'interior)])
(for ([str (in-list types)]
[i (in-naturals)])
(let ([t (ptr-add targets i _GtkTargetEntry)])
(cpointer-push-tag! t 'GtkTargetEntry)
(set-GtkTargetEntry-target! t (ptr-add target-strings offset))
(set-GtkTargetEntry-target! t str)
(set-GtkTargetEntry-flags! t 0)
(set-GtkTargetEntry-info! t i))
(let ([bstr (string->bytes/utf-8 str)])
(memcpy target-strings offset bstr 0 (bytes-length bstr))
(let ([offset (+ offset (bytes-length bstr))])
(ptr-set! (ptr-add target-strings offset) _byte 0)
(+ offset 1))))
(set-GtkTargetEntry-info! t i)))
Comment on lines +184 to +190

@github-actions github-actions Bot Oct 20, 2026

Copy link
Copy Markdown

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

let-to-define: Internal definitions are recommended instead of let expressions, to reduce nesting.

Suggested change
(for ([str (in-list types)]
[i (in-naturals)])
(let ([t (ptr-add targets i _GtkTargetEntry)])
(cpointer-push-tag! t 'GtkTargetEntry)
(set-GtkTargetEntry-target! t (ptr-add target-strings offset))
(set-GtkTargetEntry-target! t str)
(set-GtkTargetEntry-flags! t 0)
(set-GtkTargetEntry-info! t i))
(let ([bstr (string->bytes/utf-8 str)])
(memcpy target-strings offset bstr 0 (bytes-length bstr))
(let ([offset (+ offset (bytes-length bstr))])
(ptr-set! (ptr-add target-strings offset) _byte 0)
(+ offset 1))))
(set-GtkTargetEntry-info! t i)))
(for ([str (in-list types)]
[i (in-naturals)])
(define t (ptr-add targets i _GtkTargetEntry))
(cpointer-push-tag! t 'GtkTargetEntry)
(set-GtkTargetEntry-target! t str)
(set-GtkTargetEntry-flags! t 0)
(set-GtkTargetEntry-info! t i))
Debugging details
Textual replacement 
(line-replacement
  #:new-lines
    '#("          (for ([str (in-list types)]"
       "                [i (in-naturals)])"
       "            (define t (ptr-add targets i _GtkTargetEntry))"
       "            (cpointer-push-tag! t 'GtkTargetEntry)"
       "            (set-GtkTargetEntry-target! t str)"
       "            (set-GtkTargetEntry-flags! t 0)"
       "            (set-GtkTargetEntry-info! t i))")
  #:original-lines
    '#("          (for ([str (in-list types)]"
       "                [i (in-naturals)])"
       "            (let ([t (ptr-add targets i _GtkTargetEntry)])"
       "              (cpointer-push-tag! t 'GtkTargetEntry)"
       "              (set-GtkTargetEntry-target! t str)"
       "              (set-GtkTargetEntry-flags! t 0)"
       "              (set-GtkTargetEntry-info! t i)))")
  #:start-line 184)
Syntactic replacement 
(syntax-replacement
  #:introduction-scope #<procedure:...and/syntax-local.rkt:148:2>
  #:new-syntax
    #<syntax:.../resyntax/base.rkt:215:28 (for ((str (in-list types)) (i (in-naturals))) (define t (ptr-add targets i _GtkTargetEntry)) (cpointer-push-tag! t (quote GtkTargetEntry)) (set-GtkTargetEntry-target! t str) (set-GtkTargetEntry-flags! t 0) (set-GtkTargetEntry-info! t i))>
  #:original-syntax
    #<syntax:gui-lib/mred/private/wx/gtk/clipboard.rkt:184:10 (for ((str (in-list types)) (i (in-naturals))) (let ((t (ptr-add targets i _GtkTargetEntry))) (cpointer-push-tag! t (quote GtkTargetEntry)) (set-GtkTargetEntry-target! t str) (set-GtkTargetEntry-flags! t 0) (set-GtkTargetEntry-info! t i)))>
  #:source
    (file-source
     #<path:/home/runner/work/gui/gui/gui-lib/mred/private/wx/gtk/clipboard.rkt>)
  #:uses-universal-tagged-syntax? #f)

(set! client c)
(set! client-data all-data)
(set! client-types types)
Expand All @@ -208,7 +203,7 @@
clear_owner
this-box)))

(free target-strings)))))
(void/reference-sink targets)))))

(define/public (replaced s-box)
;; In atomic mode
Expand Down
2 changes: 1 addition & 1 deletion gui-lib/mred/private/wx/gtk/colordialog.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,7 +14,7 @@

(define-gtk gtk_color_selection_dialog_get_color_selection (_fun _GtkWidget -> _GtkWidget)
#:fail (lambda () #f))
(define-gtk gtk_color_selection_get_current_color (_fun _GtkWidget (c : (_ptr o _GdkColor)) -> _void -> c))
(define-gtk gtk_color_selection_get_current_color (_fun _GtkWidget (c : (_ptr o _GdkColor atomic-interior)) -> _void -> c))
(define-gtk gtk_color_selection_set_current_color (_fun _GtkWidget _GdkColor-pointer -> _void))

(define (color-dialog-works?)
Expand Down
6 changes: 3 additions & 3 deletions gui-lib/mred/private/wx/gtk/combo.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -23,8 +23,8 @@

(define-gobj g_signal_parse_name (_fun _string
_GType
(id : (_ptr o _uint))
(_ptr o _GQuark)
(id : (_ptr o _uint atomic-interior))
(_ptr o _GQuark atomic-interior)
_gboolean
-> (r : _gboolean)
-> (and r id)))
Expand All @@ -51,7 +51,7 @@
_uint
_GQuark
_pointer
(r : (_ptr o _gboolean))
(r : (_ptr o _gboolean atomic-interior))
-> _void
-> r))

Expand Down
3 changes: 2 additions & 1 deletion gui-lib/mred/private/wx/gtk/dc.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -57,7 +57,8 @@
[ref_count _uint]
[qdata _pointer]
[type _int]
[depth _int]))
[depth _int])
#:malloc-mode 'atomic-interior)
(define-gdk gdk_visual_get_system (_fun -> _GdkVisual-rec-pointer))

(define x11-bitmap%
Expand Down
16 changes: 9 additions & 7 deletions gui-lib/mred/private/wx/gtk/frame.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -48,7 +48,7 @@
(define-gtk gtk_window_set_title (_fun _GtkWindow _string -> _void))
(define-gtk gtk_fixed_new (_fun -> _GtkWidget))
(define-gtk gtk_fixed_move (_fun _GtkWidget _GtkWidget _int _int -> _void))
(define-gtk gtk_window_get_size (_fun _GtkWidget (w : (_ptr o _int)) (h : (_ptr o _int))
(define-gtk gtk_window_get_size (_fun _GtkWidget (w : (_ptr o _int atomic-interior)) (h : (_ptr o _int atomic-interior))
-> _void
-> (values w h)))
(define-gtk gtk_window_set_decorated (_fun _GtkWidget _gboolean -> _void))
Expand All @@ -59,7 +59,7 @@
(define-gtk gtk_window_move (_fun _GtkWidget _int _int -> _void))
(define-gtk gtk_widget_set_uposition (_fun _GtkWidget _int _int -> _void)
#:fail (lambda () (lambda (w x y) (gtk_window_move w x y))))
(define-gtk gtk_window_get_position (_fun _GtkWidget (x : (_ptr o _int)) (y : (_ptr o _int))
(define-gtk gtk_window_get_position (_fun _GtkWidget (x : (_ptr o _int atomic-interior)) (y : (_ptr o _int atomic-interior))
-> _void
-> (values x y)))
(define-gtk gtk_window_set_gravity (_fun _GtkWindow _int -> _void))
Expand All @@ -75,9 +75,9 @@
(define-gdk gdk_screen_get_monitor_scale_factor (_fun _GdkScreen _int -> _int)
#:fail (lambda () (lambda (s n) 1)))
(define-gdk gdk_window_get_pointer (_fun _GdkWindow
(x : (_ptr o _int))
(y : (_ptr o _int))
(mods : (_ptr o _uint))
(x : (_ptr o _int atomic-interior))
(y : (_ptr o _int atomic-interior))
(mods : (_ptr o _uint atomic-interior))
-> _GdkWindow
-> (values x y mods)))

Expand All @@ -94,7 +94,8 @@
[height_inc _int]
[min_aspect _double]
[max_aspect _double]
[win_gravity _int]))
[win_gravity _int])
#:malloc-mode 'atomic-interior)
(define-gtk gtk_window_set_geometry_hints (_fun _GtkWindow _pointer _GdkGeometry-pointer _int -> _void))
(define-gtk gtk_widget_get_allocated_width (_fun _GtkWidget -> _int)
#:make-fail make-not-available)
Expand Down Expand Up @@ -147,7 +148,8 @@
[window _GtkWindow]
[send_event _int8]
[changed_mask _int]
[new_window_state _int]))
[new_window_state _int])
#:malloc-mode 'atomic-interior)


(define-signal-handler connect-window-state "window-state-event"
Expand Down
6 changes: 4 additions & 2 deletions gui-lib/mred/private/wx/gtk/gcwin.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -33,7 +33,8 @@
[wmclass_name _string]
[wmclass_class _string]
[override_redirect _gboolean]
[type_hint _int]))
[type_hint _int])
#:malloc-mode 'atomic-interior)

;; Gtk3, only:
(define-cstruct _GdkWindowAttr3
Expand All @@ -50,7 +51,8 @@
[wmclass_name _string]
[wmclass_class _string]
[override_redirect _gboolean]
[type_hint _int]))
[type_hint _int])
#:malloc-mode 'atomic-interior)

(define make-GdkWindowAttr
(if gtk3?
Expand Down
8 changes: 4 additions & 4 deletions gui-lib/mred/private/wx/gtk/gl-cairo.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -55,7 +55,7 @@
#:default-make-fail make-not-available)

(define-gl glGenTextures
(_fun _GLsizei (i : (_ptr o _GLuint)) -> _void -> i))
(_fun _GLsizei (i : (_ptr o _GLuint atomic-interior)) -> _void -> i))

(define-gl glBindTexture
(_fun _GLenum _GLuint -> _void))
Expand All @@ -73,7 +73,7 @@
(_fun _GLenum _GLint -> _void))

(define-gl glGenFramebuffers
(_fun _GLsizei (i : (_ptr o _GLuint)) -> _void -> i))
(_fun _GLsizei (i : (_ptr o _GLuint atomic-interior)) -> _void -> i))

(define-gl glBindFramebuffer
(_fun _GLenum _GLuint -> _void))
Expand All @@ -85,10 +85,10 @@
(_fun _GLenum -> _GLenum))

(define-gl glDeleteTextures
(_fun _GLsizei (_ptr i _GLuint) -> _void))
(_fun _GLsizei (_ptr i _GLuint atomic-interior) -> _void))

(define-gl glDeleteFramebuffers
(_fun _GLsizei (_ptr i _GLuint) -> _void))
(_fun _GLsizei (_ptr i _GLuint atomic-interior) -> _void))

(define-gl glReadPixels
(_fun _GLint _GLint _GLsizei _GLsizei _GLenum _GLenum _pointer -> _void))
Expand Down
20 changes: 10 additions & 10 deletions gui-lib/mred/private/wx/gtk/gl-context.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -76,28 +76,28 @@
(define-egl eglGetProcAddress
(_fun _string -> _fpointer))
(define eglGetPlatformDisplay-type
(_fun _EGLInt _pointer (_list i _EGLInt) -> _EGLDisplay))
(_fun _EGLInt _pointer (_list i _EGLInt atomic-interior) -> _EGLDisplay))
(define-egl eglGetPlatformDisplay eglGetPlatformDisplay-type)
(define-egl eglInitialize
(_fun _pointer (_ptr o _int) (_ptr o _int) -> _EGLBoolean))
(_fun _pointer (_ptr o _int atomic-interior) (_ptr o _int atomic-interior) -> _EGLBoolean))
(define-egl eglChooseConfig
(_fun _EGLDisplay (_list i _EGLInt) (c : (_ptr o _EGLConfig)) (_int = 1) (n : (_ptr o _EGLInt))
(_fun _EGLDisplay (_list i _EGLInt atomic-interior) (c : (_ptr o _EGLConfig atomic-interior)) (_int = 1) (n : (_ptr o _EGLInt atomic-interior))
-> (r : _EGLBoolean)
-> (and r (= n 1) c)))
(define eglCreatePlatformWindowSurface-type
(_fun _EGLDisplay _EGLConfig _pointer (_list i _int) -> _EGLSurface))
(_fun _EGLDisplay _EGLConfig _pointer (_list i _int atomic-interior) -> _EGLSurface))
(define-egl eglCreatePlatformWindowSurface
eglCreatePlatformWindowSurface-type)
(define-egl eglBindAPI
(_fun _EGLInt -> _EGLBoolean))
(define-egl eglCreateContext
(_fun _EGLDisplay _EGLConfig _EGLContext (_list i _EGLInt) -> _EGLContext))
(_fun _EGLDisplay _EGLConfig _EGLContext (_list i _EGLInt atomic-interior) -> _EGLContext))
(define-egl eglMakeCurrent
(_fun _EGLDisplay _EGLSurface _EGLSurface _EGLContext -> _EGLBoolean))
(define-egl eglSwapBuffers
(_fun _EGLDisplay _EGLSurface -> _EGLBoolean))
(define-egl eglCreatePbufferSurface
(_fun _EGLDisplay _EGLConfig (_list i _EGLInt) -> _EGLSurface))
(_fun _EGLDisplay _EGLConfig (_list i _EGLInt atomic-interior) -> _EGLSurface))
(define-egl eglGetError
(_fun -> _EGLInt))
(define-egl eglDestroySurface
Expand Down Expand Up @@ -203,20 +203,20 @@
(_fun _Display _int -> _void))

(define-glx glXQueryVersion
(_fun _Display (major : (_ptr o _int)) (minor : (_ptr o _int))
(_fun _Display (major : (_ptr o _int atomic-interior)) (minor : (_ptr o _int atomic-interior))
-> (ret : _bool)
-> (values ret major minor)))

(define-glx glXQueryExtensionsString
(_fun _Display _int -> _string/utf-8))

(define-glx glXChooseFBConfig
(_fun _Display _int (_list i _int) (len : (_ptr o _int))
(_fun _Display _int (_list i _int atomic-interior) (len : (_ptr o _int atomic-interior))
-> (_cvector o _GLXFBConfig len))
#:wrap (allocator (λ (v) (XFree (cvector-ptr v)))))

(define-glx glXGetFBConfigAttrib
(_fun _Display _GLXFBConfig _int (out : (_ptr o _int))
(_fun _Display _GLXFBConfig _int (out : (_ptr o _int atomic-interior))
-> (ret : _int)
-> (values ret out)))

Expand Down Expand Up @@ -251,7 +251,7 @@
(define lazy-glXCreateContextAttribsARB
(delay
(function-ptr (glXGetProcAddressARB "glXCreateContextAttribsARB")
(_fun _Display _GLXFBConfig _GLXContext _bool (_list i _int)
(_fun _Display _GLXFBConfig _GLXContext _bool (_list i _int atomic-interior)
-> _GLXContext))))

(define (glXCreateContextAttribsARB . args)
Expand Down
8 changes: 4 additions & 4 deletions gui-lib/mred/private/wx/gtk/keymap.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -16,10 +16,10 @@
_uint ; hardware_keycode
_int ; GdkModifierType state
_int ; group
(keyval : (_ptr o _uint))
(effective_group : (_ptr o _int))
(level : (_ptr o _int))
(consumed_modifiers : (_ptr o _int))
(keyval : (_ptr o _uint atomic-interior))
(effective_group : (_ptr o _int atomic-interior))
(level : (_ptr o _int atomic-interior))
(consumed_modifiers : (_ptr o _int atomic-interior))
-> (r : _gboolean)
-> (and r keyval)))

Expand Down
7 changes: 4 additions & 3 deletions gui-lib/mred/private/wx/gtk/list-box.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -21,7 +21,8 @@
(define-cstruct _GtkTreeIter ([stamp _int]
[user_data _pointer]
[user_data2 _pointer]
[user_data3 _pointer]))
[user_data3 _pointer])
#:malloc-mode 'atomic-interior)

(define _GtkListStore (_cpointer 'GtkListStore))
(define _GtkCellRenderer (_cpointer 'GtkCellRenderer))
Expand All @@ -36,7 +37,7 @@
(define-gtk gtk_scrolled_window_new (_fun _pointer _pointer -> _GtkWidget))
(define-gtk gtk_scrolled_window_set_policy (_fun _GtkWidget _int _int -> _void))

(define-gtk gtk_list_store_newv (_fun _int (_list i _long) -> _GtkListStore))
(define-gtk gtk_list_store_newv (_fun _int (_list i _long atomic-interior) -> _GtkListStore))
(define-gtk gtk_list_store_clear (_fun _GtkListStore -> _void))
(define-gtk gtk_list_store_append (_fun _GtkListStore _GtkTreeIter-pointer _pointer -> _void))
(define-gtk gtk_list_store_set (_fun #:varargs-after 2
Expand Down Expand Up @@ -83,7 +84,7 @@
(define-gtk gtk_tree_path_free (_fun _pointer -> _void))
(define-gtk gtk_tree_path_get_indices (_fun _pointer -> _pointer))

(define-gtk gtk_tree_view_get_visible_range (_fun _GtkWidget [sp : (_ptr o _pointer)] [ep : (_ptr o _pointer)]
(define-gtk gtk_tree_view_get_visible_range (_fun _GtkWidget [sp : (_ptr o _pointer atomic-interior)] [ep : (_ptr o _pointer atomic-interior)]
-> [ok? : _gboolean]
-> (values (if ok? sp #f) (if ok? ep #f))))

@github-actions github-actions Bot Oct 20, 2026

Copy link
Copy Markdown

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

if-else-false-to-and: This if expression can be refactored to an equivalent expression using and.

Suggested change
-> (values (if ok? sp #f) (if ok? ep #f))))
-> (values (and ok? sp) (if ok? ep #f))))
Debugging details
Textual replacement 
(line-replacement
  #:new-lines
    '#("                                                  -> (values (and ok? sp) (if ok? ep #f))))")
  #:original-lines
    '#("                                                  -> (values (if ok? sp #f) (if ok? ep #f))))")
  #:start-line 89)
Syntactic replacement 
(syntax-replacement
  #:introduction-scope #<procedure:...and/syntax-local.rkt:148:2>
  #:new-syntax
    #<syntax:/home/runner/.local/share/racket/9.4.0.2/pkgs/resyntax/default-recommendations/boolean-shortcuts.rkt:63:2 (and ok? sp)>
  #:original-syntax
    #<syntax:gui-lib/mred/private/wx/gtk/list-box.rkt:89:61 (if ok? sp #f)>
  #:source
    (file-source
     #<path:/home/runner/work/gui/gui/gui-lib/mred/private/wx/gtk/list-box.rkt>)
  #:uses-universal-tagged-syntax? #f)

@github-actions github-actions Bot Oct 20, 2026

Copy link
Copy Markdown

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

if-else-false-to-and: This if expression can be refactored to an equivalent expression using and.

Suggested change
-> (values (if ok? sp #f) (if ok? ep #f))))
-> (values (if ok? sp #f) (and ok? ep))))
Debugging details
Textual replacement 
(line-replacement
  #:new-lines
    '#("                                                  -> (values (if ok? sp #f) (and ok? ep))))")
  #:original-lines
    '#("                                                  -> (values (if ok? sp #f) (if ok? ep #f))))")
  #:start-line 89)
Syntactic replacement 
(syntax-replacement
  #:introduction-scope #<procedure:...and/syntax-local.rkt:148:2>
  #:new-syntax
    #<syntax:/home/runner/.local/share/racket/9.4.0.2/pkgs/resyntax/default-recommendations/boolean-shortcuts.rkt:63:2 (and ok? ep)>
  #:original-syntax
    #<syntax:gui-lib/mred/private/wx/gtk/list-box.rkt:89:76 (if ok? ep #f)>
  #:source
    (file-source
     #<path:/home/runner/work/gui/gui/gui-lib/mred/private/wx/gtk/list-box.rkt>)
  #:uses-universal-tagged-syntax? #f)


Expand Down
2 changes: 1 addition & 1 deletion gui-lib/mred/private/wx/gtk/printer-dc.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -64,7 +64,7 @@
(define-gtk gtk_print_operation_run (_fun _GtkPrintOperation
_int
(_or-null _GtkWindow)
(_ptr o _pointer)
(_ptr o _pointer atomic-interior)
-> _int))

(define-gtk gtk_print_operation_set_allow_async (_fun _GtkPrintOperation _gboolean -> _void))
Expand Down
4 changes: 2 additions & 2 deletions gui-lib/mred/private/wx/gtk/procs.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -93,12 +93,12 @@
(define _GtkSettings (_cpointer 'GtkSettings))
(define-gtk gtk_settings_get_default (_fun -> _GtkSettings))
(define-gobj g_object_get/int (_fun #:varargs-after 2
_GtkSettings _string (r : (_ptr o _int)) (_pointer = #f)
_GtkSettings _string (r : (_ptr o _int atomic-interior)) (_pointer = #f)
-> _void
-> r)
#:c-id g_object_get)
(define-gobj g_object_get/string (_fun #:varargs-after 2
_GtkSettings _string (r : (_ptr o _pointer)) (_pointer = #f)
_GtkSettings _string (r : (_ptr o _pointer atomic-interior)) (_pointer = #f)
-> _void
-> r)
#:c-id g_object_get)
Expand Down
9 changes: 5 additions & 4 deletions gui-lib/mred/private/wx/gtk/queue.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,7 @@
;; disable asynchronous mode.
(void (putenv "IBUS_ENABLE_SYNC_MODE" "y"))

(define-gtk gtk_init_check (_fun (_ptr io _int) (_ptr io _intptr) -> _gboolean))
(define-gtk gtk_init_check (_fun (_ptr io _int atomic-interior) (_ptr io _intptr atomic-interior) -> _gboolean))
(define-gdk gdk_set_program_class (_fun _string -> _void))

(define x11-display
Expand Down Expand Up @@ -132,7 +132,8 @@

(define-cstruct _GPollFD ([fd _int]
[events _short]
[revents _short]))
[revents _short])
#:malloc-mode 'atomic-interior)

(define-glib g_main_context_default (_fun -> _GMainContext))
(define-glib g_main_context_query (_fun _GMainContext
Expand All @@ -153,7 +154,7 @@

(define poll-fd-count 1)
(define poll-fds (make-GPollFD 0 0 0))
(define timeout (malloc _int))
(define timeout (malloc _int 'atomic-interior))

;; These are OS-specific, but they tend to be the same across OSes:
(define POLLIN #x1)
Expand All @@ -172,7 +173,7 @@
(unsafe-poll-ctx-milliseconds-wakeup fds (+ (current-inexact-monotonic-milliseconds) to))))
(if (n . > . poll-fd-count)
(begin
(set! poll-fds (malloc _GPollFD n))
(set! poll-fds (malloc _GPollFD n 'atomic-interior))
(set! poll-fd-count n)
(install-wakeup fds))
(if (eq? 'windows (system-type))
Expand Down
Loading
Loading