diff --git a/gui-lib/info.rkt b/gui-lib/info.rkt index d1af9283c..a50baeb7d 100644 --- a/gui-lib/info.rkt +++ b/gui-lib/info.rkt @@ -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"] diff --git a/gui-lib/mred/private/wx/gtk/canvas.rkt b/gui-lib/mred/private/wx/gtk/canvas.rkt index 27f7ac9ec..b43082d7c 100644 --- a/gui-lib/mred/private/wx/gtk/canvas.rkt +++ b/gui-lib/mred/private/wx/gtk/canvas.rkt @@ -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) @@ -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) diff --git a/gui-lib/mred/private/wx/gtk/clipboard.rkt b/gui-lib/mred/private/wx/gtk/clipboard.rkt index fb8179879..55b4d1d54 100644 --- a/gui-lib/mred/private/wx/gtk/clipboard.rkt +++ b/gui-lib/mred/private/wx/gtk/clipboard.rkt @@ -36,7 +36,8 @@ [format _int] [data _pointer] [length _int] - [display _GtkDisplay])) + [display _GtkDisplay]) + #:malloc-mode 'atomic-interior) (define _GtkSelectionData _GtkSelectionDataT-pointer) @@ -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)) @@ -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))) (set! client c) (set! client-data all-data) (set! client-types types) @@ -208,7 +203,7 @@ clear_owner this-box))) - (free target-strings))))) + (void/reference-sink targets))))) (define/public (replaced s-box) ;; In atomic mode diff --git a/gui-lib/mred/private/wx/gtk/colordialog.rkt b/gui-lib/mred/private/wx/gtk/colordialog.rkt index 7087d27d5..f459a7bfe 100644 --- a/gui-lib/mred/private/wx/gtk/colordialog.rkt +++ b/gui-lib/mred/private/wx/gtk/colordialog.rkt @@ -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?) diff --git a/gui-lib/mred/private/wx/gtk/combo.rkt b/gui-lib/mred/private/wx/gtk/combo.rkt index 714db2131..c5505ec74 100644 --- a/gui-lib/mred/private/wx/gtk/combo.rkt +++ b/gui-lib/mred/private/wx/gtk/combo.rkt @@ -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))) @@ -51,7 +51,7 @@ _uint _GQuark _pointer - (r : (_ptr o _gboolean)) + (r : (_ptr o _gboolean atomic-interior)) -> _void -> r)) diff --git a/gui-lib/mred/private/wx/gtk/dc.rkt b/gui-lib/mred/private/wx/gtk/dc.rkt index 239314950..46e9004f5 100644 --- a/gui-lib/mred/private/wx/gtk/dc.rkt +++ b/gui-lib/mred/private/wx/gtk/dc.rkt @@ -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% diff --git a/gui-lib/mred/private/wx/gtk/frame.rkt b/gui-lib/mred/private/wx/gtk/frame.rkt index b7180d259..f8266be36 100644 --- a/gui-lib/mred/private/wx/gtk/frame.rkt +++ b/gui-lib/mred/private/wx/gtk/frame.rkt @@ -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)) @@ -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)) @@ -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))) @@ -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) @@ -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" diff --git a/gui-lib/mred/private/wx/gtk/gcwin.rkt b/gui-lib/mred/private/wx/gtk/gcwin.rkt index 2769d367c..c611a0437 100644 --- a/gui-lib/mred/private/wx/gtk/gcwin.rkt +++ b/gui-lib/mred/private/wx/gtk/gcwin.rkt @@ -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 @@ -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? diff --git a/gui-lib/mred/private/wx/gtk/gl-cairo.rkt b/gui-lib/mred/private/wx/gtk/gl-cairo.rkt index ff4d1cb08..16db24b03 100644 --- a/gui-lib/mred/private/wx/gtk/gl-cairo.rkt +++ b/gui-lib/mred/private/wx/gtk/gl-cairo.rkt @@ -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)) @@ -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)) @@ -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)) diff --git a/gui-lib/mred/private/wx/gtk/gl-context.rkt b/gui-lib/mred/private/wx/gtk/gl-context.rkt index dbb908d9d..09df271ba 100644 --- a/gui-lib/mred/private/wx/gtk/gl-context.rkt +++ b/gui-lib/mred/private/wx/gtk/gl-context.rkt @@ -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 @@ -203,7 +203,7 @@ (_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))) @@ -211,12 +211,12 @@ (_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))) @@ -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) diff --git a/gui-lib/mred/private/wx/gtk/keymap.rkt b/gui-lib/mred/private/wx/gtk/keymap.rkt index 80ff0c4e6..81aa4da3a 100644 --- a/gui-lib/mred/private/wx/gtk/keymap.rkt +++ b/gui-lib/mred/private/wx/gtk/keymap.rkt @@ -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))) diff --git a/gui-lib/mred/private/wx/gtk/list-box.rkt b/gui-lib/mred/private/wx/gtk/list-box.rkt index ebef42588..ddb0c43b0 100644 --- a/gui-lib/mred/private/wx/gtk/list-box.rkt +++ b/gui-lib/mred/private/wx/gtk/list-box.rkt @@ -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)) @@ -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 @@ -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)))) diff --git a/gui-lib/mred/private/wx/gtk/printer-dc.rkt b/gui-lib/mred/private/wx/gtk/printer-dc.rkt index ccb5d8b7a..d59264085 100644 --- a/gui-lib/mred/private/wx/gtk/printer-dc.rkt +++ b/gui-lib/mred/private/wx/gtk/printer-dc.rkt @@ -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)) diff --git a/gui-lib/mred/private/wx/gtk/procs.rkt b/gui-lib/mred/private/wx/gtk/procs.rkt index 3768bb6a6..e9b7da13a 100644 --- a/gui-lib/mred/private/wx/gtk/procs.rkt +++ b/gui-lib/mred/private/wx/gtk/procs.rkt @@ -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) diff --git a/gui-lib/mred/private/wx/gtk/queue.rkt b/gui-lib/mred/private/wx/gtk/queue.rkt index 608bca4e7..b7f0b931d 100644 --- a/gui-lib/mred/private/wx/gtk/queue.rkt +++ b/gui-lib/mred/private/wx/gtk/queue.rkt @@ -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 @@ -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 @@ -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) @@ -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)) diff --git a/gui-lib/mred/private/wx/gtk/style.rkt b/gui-lib/mred/private/wx/gtk/style.rkt index 40102fbcd..08336a6ce 100644 --- a/gui-lib/mred/private/wx/gtk/style.rkt +++ b/gui-lib/mred/private/wx/gtk/style.rkt @@ -13,12 +13,14 @@ get-label-bg-color)) (define-cstruct _GTypeInstance - ([class _pointer])) + ([class _pointer]) + #:malloc-mode 'atomic-interior) (define-cstruct _GObject ([g_type_instance _GTypeInstance] [ref_count _uint] - [qdata _pointer])) + [qdata _pointer]) + #:malloc-mode 'atomic-interior) (define-cstruct _GtkStyle ([obj _GObject] @@ -66,7 +68,8 @@ [white _GdkColor] [font_desc _pointer] ; PangoFontDescription * ; ... - )) + ) + #:malloc-mode 'atomic-interior) (define-gtk gtk_widget_get_style (_fun _GtkWidget -> _GtkStyle-pointer)) (define-gtk gtk_rc_get_style (_fun _GtkWidget -> _GtkStyle-pointer)) @@ -105,7 +108,7 @@ (define _GtkSettings (_cpointer 'GtkSettings)) (define-gtk gtk_settings_get_default (_fun -> _GtkSettings)) (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) diff --git a/gui-lib/mred/private/wx/gtk/types.rkt b/gui-lib/mred/private/wx/gtk/types.rkt index e5057d6c0..9d20a2d22 100644 --- a/gui-lib/mred/private/wx/gtk/types.rkt +++ b/gui-lib/mred/private/wx/gtk/types.rkt @@ -78,7 +78,8 @@ [button _uint] [device (_or-null _GdkDevice)] [x_root _double] - [y_root _double])) + [y_root _double]) + #:malloc-mode 'atomic-interior) (define-cstruct _GdkEventKey ([type _GdkEventType] @@ -91,7 +92,8 @@ [string _pointer] ; do not use [hardware_keycode _uint16] [group _ubyte] - [is_modifier _byte])) ; just 1 bit + [is_modifier _byte]) ; just 1 bit + #:malloc-mode 'atomic-interior) (define-cstruct _GdkEventScroll ([type _GdkEventType] [window _GdkWindow] @@ -103,7 +105,8 @@ [direction _uint] [device _GdkDevice] [x_root _double] - [y_root _double])) + [y_root _double]) + #:malloc-mode 'atomic-interior) (define-cstruct _GdkEventMotion ([type _GdkEventType] [window _GdkWindow] @@ -116,7 +119,8 @@ [is_hint _int16] [device _GdkDevice] [x_root _double] - [y_root _double])) + [y_root _double]) + #:malloc-mode 'atomic-interior) (define-cstruct _GdkEventCrossing ([type _GdkEventType] [window _GdkWindow] @@ -130,7 +134,8 @@ [mode _int] [detail _int] [focus _gboolean] - [state _uint])) + [state _uint]) + #:malloc-mode 'atomic-interior) (define-cstruct _GdkEventConfigure ([type _GdkEventType] [window _GdkWindow] @@ -138,7 +143,8 @@ [x _int] [y _int] [width _int] - [height _int])) + [height _int]) + #:malloc-mode 'atomic-interior) (define-cstruct _GdkEventSelection ([type _GdkEventType] [window _GdkWindow] @@ -147,26 +153,31 @@ [target _GdkAtom] [property _GdkAtom] [time _uint32] - [requestor _pointer])) + [requestor _pointer]) + #:malloc-mode 'atomic-interior) (define-cstruct _GdkRectangle ([x _int] [y _int] [width _int] - [height _int])) + [height _int]) + #:malloc-mode 'atomic-interior) (define-cstruct _GdkEventExpose ([type _GdkEventType] [window _GdkWindow] [send_event _byte] [area _GdkRectangle] [region _pointer] - [count _int])) + [count _int]) + #:malloc-mode 'atomic-interior) (define-cstruct _GdkEventFocus ([type _GdkEventType] [window _GdkWindow] [send_event _byte] - [in _short])) + [in _short]) + #:malloc-mode 'atomic-interior) (define-cstruct _GdkColor ([pixel _uint32] [red _uint16] [green _uint16] - [blue _uint16])) + [blue _uint16]) + #:malloc-mode 'atomic-interior) diff --git a/gui-lib/mred/private/wx/gtk/unique.rkt b/gui-lib/mred/private/wx/gtk/unique.rkt index 352714456..f37be758a 100644 --- a/gui-lib/mred/private/wx/gtk/unique.rkt +++ b/gui-lib/mred/private/wx/gtk/unique.rkt @@ -42,7 +42,7 @@ (define-unique unique_message_data_new (_fun -> _UniqueMessageData)) (define-unique unique_message_data_free (_fun _UniqueMessageData -> _void)) (define-unique unique_message_data_set (_fun _UniqueMessageData _pointer _gsize -> _void)) -(define-unique unique_message_data_get (_fun _UniqueMessageData (len : (_ptr o _gsize)) +(define-unique unique_message_data_get (_fun _UniqueMessageData (len : (_ptr o _gsize atomic-interior)) -> (data : _bytes) -> (scheme_make_sized_byte_string data @@ -100,10 +100,10 @@ #:make-fail make-not-available) (define-gdk g_application_register (_fun _GtkApplication _pointer _pointer -> _gboolean) #:make-fail make-not-available) -(define-gdk g_application_run (_fun _GtkApplication _int (_vector i _string) -> _gboolean) +(define-gdk g_application_run (_fun _GtkApplication _int (_vector i _string/utf-8/immobile interior) -> _gboolean) #:make-fail make-not-available) (define-gdk g_application_command_line_get_arguments - (_fun _GApplicationCommandLine (n : (_ptr o _int)) -> (p : _pointer) -> (values p n)) + (_fun _GApplicationCommandLine (n : (_ptr o _int atomic-interior)) -> (p : _pointer) -> (values p n)) #:make-fail make-not-available) (define-gdk g_strfreev (_fun _pointer -> _void) #:make-fail make-not-available) diff --git a/gui-lib/mred/private/wx/gtk/utils.rkt b/gui-lib/mred/private/wx/gtk/utils.rkt index d474553a7..b364764a3 100644 --- a/gui-lib/mred/private/wx/gtk/utils.rkt +++ b/gui-lib/mred/private/wx/gtk/utils.rkt @@ -135,7 +135,7 @@ (g_signal_connect_data obj s proc user-data #f (if after? G_CONNECT_AFTER 0))) (define-gobj g_object_get (_fun _GtkWidget (_string = "window") - [w : (_ptr o _GdkWindow)] + [w : (_ptr o _GdkWindow atomic-interior)] (_pointer = #f) -> _void -> w)) (define-gobj g_object_new (_fun _GType _pointer -> _GtkWidget)) @@ -146,7 +146,8 @@ (define-cstruct _GtkObject ([type-instance _pointer] [ref_count _uint] [qdata _pointer] - [flags _uint32])) + [flags _uint32]) + #:malloc-mode 'atomic-interior) (define (get-gtk-object-flags gtk) (GtkObject-flags (cast gtk _pointer _GtkObject-pointer))) (define (set-gtk-object-flags! gtk v) @@ -178,7 +179,8 @@ (define-cstruct _g-slist ([data _pointer] - [next (_or-null _g-slist-pointer)])) + [next (_or-null _g-slist-pointer)]) + #:malloc-mode 'atomic-interior) (define-glib g_slist_free (_fun _g-slist-pointer -> _void)) (define (make-byte-string s) diff --git a/gui-lib/mred/private/wx/gtk/widget.rkt b/gui-lib/mred/private/wx/gtk/widget.rkt index 2373335ea..3c4b98f6c 100644 --- a/gui-lib/mred/private/wx/gtk/widget.rkt +++ b/gui-lib/mred/private/wx/gtk/widget.rkt @@ -42,7 +42,7 @@ (define-gtk gtk_widget_queue_draw (_fun _GtkWidget -> _void)) (define-gtk gtk_widget_get_toplevel (_fun _GtkWidget -> _GtkWidget)) (define-gtk gtk_widget_translate_coordinates (_fun _GtkWidget _GtkWidget _int _int - (x : (_ptr o _int)) (y : (_ptr o _int)) + (x : (_ptr o _int atomic-interior)) (y : (_ptr o _int atomic-interior)) -> _gboolean -> (values x y))) (define-gtk gtk_widget_get_realized (_fun _GtkWidget -> _gboolean) diff --git a/gui-lib/mred/private/wx/gtk/window.rkt b/gui-lib/mred/private/wx/gtk/window.rkt index 6208f6090..ec5246070 100644 --- a/gui-lib/mred/private/wx/gtk/window.rkt +++ b/gui-lib/mred/private/wx/gtk/window.rkt @@ -87,11 +87,13 @@ (define-gdk gdk_display_warp_pointer (_fun _GdkDisplay _GdkScreen _int _int -> _void)) (define-cstruct _GtkRequisition ([width _int] - [height _int])) + [height _int]) + #:malloc-mode 'atomic-interior) (define-cstruct _GtkAllocation ([x _int] [y _int] [width _int] - [height _int])) + [height _int]) + #:malloc-mode 'atomic-interior) (define-gtk gtk_widget_size_request (_fun _GtkWidget _GtkRequisition-pointer -> _void)) (define-gtk gtk_widget_size_allocate (_fun _GtkWidget _GtkAllocation-pointer -> _void)) @@ -132,7 +134,8 @@ [req _GtkRequisition] [alloc _GtkAllocation] [window _GdkWindow] - [parent _GtkWidget])) + [parent _GtkWidget]) + #:malloc-mode 'atomic-interior) (define-gtk widget-window (_fun _GtkWidget -> _GdkWindow) #:c-id gtk_widget_get_window @@ -146,7 +149,7 @@ (lambda (gtk) (GtkWidgetT-parent (cast gtk _GtkWidget _GtkWidgetT-pointer))))) -(define-gtk widget-allocation (_fun _GtkWidget (o : (_ptr o _GtkAllocation)) -> _void -> o) +(define-gtk widget-allocation (_fun _GtkWidget (o : (_ptr o _GtkAllocation atomic-interior)) -> _void -> o) #:c-id gtk_widget_get_allocation #:fail (lambda () (lambda (gtk) @@ -179,8 +182,8 @@ (define-gtk gtk_drag_dest_unset (_fun _GtkWidget -> _void)) (define-gtk gdk_event_get_scroll_deltas (_fun _GdkEventScroll-pointer - (dx : (_ptr o _double)) - (dy : (_ptr o _double)) + (dx : (_ptr o _double atomic-interior)) + (dy : (_ptr o _double atomic-interior)) -> _void -> (values dx dy)) #:make-fail make-not-available) diff --git a/gui-lib/mred/private/wx/gtk/x11.rkt b/gui-lib/mred/private/wx/gtk/x11.rkt index f6413ac8c..7bc74a438 100644 --- a/gui-lib/mred/private/wx/gtk/x11.rkt +++ b/gui-lib/mred/private/wx/gtk/x11.rkt @@ -56,7 +56,8 @@ [green-mask _ulong] [blue-mask _ulong] [colormap-size _int] - [bits-per-rgb _int])) + [bits-per-rgb _int]) + #:malloc-mode 'atomic-interior) ;; This should be `_ulong`, but we use pointers for various ;; reasons, including support for dealloctaors: