From b6e444bbdca1a619d6800f36b3571a62b37b29de Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Wed, 28 Sep 2022 20:13:45 +0300 Subject: [PATCH] FIXED: remove message_hook during cleanup to avoid possible crash --- sweep.c | 86 +++++++++++++++++++++++++-------------------------- sweep.pl | 74 ++++++++++++++++++++++++++++++++++++++++++-- sweeprolog.el | 42 +++++++++++++++---------- 3 files changed, 141 insertions(+), 61 deletions(-) diff --git a/sweep.c b/sweep.c index 301362b..a9f804e 100644 --- a/sweep.c +++ b/sweep.c @@ -447,6 +447,46 @@ sweep_open_query(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void *data) return r; } +static foreign_t +sweep_funcall0(term_t f, term_t v) { + char * string = NULL; + emacs_value r = NULL; + size_t l = -1; + term_t n = PL_new_term_ref(); + + if (PL_get_nchars(f, &l, &string, CVT_STRING|REP_UTF8)) { + r = current_env->funcall(current_env, current_env->intern(current_env, string), 0, NULL); + if (value_to_term(current_env, r, n) >= 0) { + if (PL_unify(n, v)) { + return TRUE; + } + } + } + return FALSE; +} + +static foreign_t +sweep_funcall1(term_t f, term_t a, term_t v) { + char * string = NULL; + emacs_value e = NULL; + emacs_value r = NULL; + size_t l = -1; + term_t n = PL_new_term_ref(); + + if (PL_get_nchars(f, &l, &string, CVT_STRING|REP_UTF8)) { + e = term_to_value(current_env, a); + if (e != NULL) { + r = current_env->funcall(current_env, current_env->intern(current_env, string), 1, &e); + if (value_to_term(current_env, r, n) >= 0) { + if (PL_unify(n, v)) { + return TRUE; + } + } + } + } + return FALSE; +} + static emacs_value sweep_initialize(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void *data) { @@ -467,6 +507,9 @@ sweep_initialize(emacs_env *env, ptrdiff_t nargs, emacs_value *args, void *data) if (PL_version_info(PL_VERSION_SYSTEM < 80516)) PL_action(PL_GMP_SET_ALLOC_FUNCTIONS, FALSE); + PL_register_foreign("sweep_funcall", 3, sweep_funcall1, 0); + PL_register_foreign("sweep_funcall", 2, sweep_funcall0, 0); + r = PL_initialise(nargs, argv); for (i = 0; i < nargs; i++) { @@ -505,46 +548,6 @@ static void provide(emacs_env *env, const char *feature) { env->funcall(env, Qprovide, 1, (emacs_value[]){Qfeat}); } -static foreign_t -sweep_funcall0(term_t f, term_t v) { - char * string = NULL; - emacs_value r = NULL; - size_t l = -1; - term_t n = PL_new_term_ref(); - - if (PL_get_nchars(f, &l, &string, CVT_STRING|REP_UTF8)) { - r = current_env->funcall(current_env, current_env->intern(current_env, string), 0, NULL); - if (value_to_term(current_env, r, n) >= 0) { - if (PL_unify(n, v)) { - return TRUE; - } - } - } - return FALSE; -} - -static foreign_t -sweep_funcall1(term_t f, term_t a, term_t v) { - char * string = NULL; - emacs_value e = NULL; - emacs_value r = NULL; - size_t l = -1; - term_t n = PL_new_term_ref(); - - if (PL_get_nchars(f, &l, &string, CVT_STRING|REP_UTF8)) { - e = term_to_value(current_env, a); - if (e != NULL) { - r = current_env->funcall(current_env, current_env->intern(current_env, string), 1, &e); - if (value_to_term(current_env, r, n) >= 0) { - if (PL_unify(n, v)) { - return TRUE; - } - } - } - } - return FALSE; -} - int emacs_module_init (struct emacs_runtime *runtime) { @@ -627,9 +630,6 @@ This function drops the current instantiation of the query variables.", emacs_value args_cleanup[] = {symbol_cleanup, func_cleanup}; env->funcall (env, env->intern (env, "defalias"), 2, args_cleanup); - PL_register_foreign("sweep_funcall", 3, sweep_funcall1, 0); - PL_register_foreign("sweep_funcall", 2, sweep_funcall0, 0); - provide(env, "sweep-module"); return 0; diff --git a/sweep.pl b/sweep.pl index b1fba49..afaa971 100644 --- a/sweep.pl +++ b/sweep.pl @@ -55,6 +55,8 @@ sweep_op_info/2, sweep_imenu_index/2, sweep_module_path/2, + sweep_top_level_server/2, + sweep_accept_top_level_client/2, write_sweep_module_location/0 ]). @@ -76,6 +78,7 @@ :- dynamic sweep_current_color/3, sweep_open/2, + sweep_top_level_thread_buffer/2, sweep_source_time/2, sweep_current_comment/3. @@ -671,11 +674,12 @@ sweep_path_module(Path0, Module) :- sweep_setup_message_hook(_, _) :- - retractall(user:thread_message_hook(_, _, _)), asserta(( user:thread_message_hook(Term, Kind, Lines) :- sweep_message_hook(Term, Kind, Lines) - )). + ), + Ref), + at_halt(erase(Ref)). sweep_message_hook(Term, Kind0, _Lines) :- should_handle_message_kind(Kind0, Kind), @@ -745,3 +749,69 @@ write_sweep_module_location :- Path, [file_type(executable), access(read)]), writeln(Path). + +sweep_top_level_server(_, Port) :- + tcp_socket(ServerSocket), + tcp_setopt(ServerSocket, reuseaddr), + tcp_bind(ServerSocket, Port), + tcp_listen(ServerSocket, 5), + thread_create(sweep_top_level_server_loop(ServerSocket), T, + [ alias(sweep_top_level_server) + ]), + at_halt(( is_thread(T), + thread_property(T, status(running)) + -> thread_signal(T, thread_exit(0)), + thread_join(T, _) + ; true + )). + +sweep_top_level_server_loop(ServerSocket) :- + thread_get_message(Message), + sweep_top_level_server_loop_(Message, ServerSocket). + +sweep_top_level_server_loop_(accept(Buffer), ServerSocket) :- + !, + tcp_accept(ServerSocket, Slave, Peer), + tcp_open_socket(Slave, InStream, OutStream), + set_stream(InStream, close_on_abort(false)), + set_stream(OutStream, close_on_abort(false)), + thread_create(sweep_top_level_client(InStream, OutStream, Peer), T, [detached(true)]), + at_halt(( is_thread(T), + thread_property(T, status(running)) + -> thread_signal(T, thread_exit(0)), + thread_join(T, _) + ; true + )), + thread_property(T, id(Id)), + asserta(sweep_top_level_thread_buffer(Id, Buffer)), + sweep_top_level_server_loop(ServerSocket). +sweep_top_level_server_loop_(_, _). + +sweep_top_level_client(InStream, OutStream, ip(127,0,0,1)) :- + !, + set_prolog_IO(InStream, OutStream, OutStream), + set_stream(InStream, tty(true)), + set_prolog_flag(tty_control, false), + current_prolog_flag(encoding, Enc), + set_stream(user_input, encoding(Enc)), + set_stream(user_output, encoding(Enc)), + set_stream(user_error, encoding(Enc)), + set_stream(user_input, newline(detect)), + set_stream(user_output, newline(dos)), + set_stream(user_error, newline(dos)), + call_cleanup(prolog, + ( close(InStream, [force(true)]), + close(OutStream, [force(true)]), + thread_self(Self), + thread_property(Self, id(Id)), + retractall(sweep_top_level_thread_buffer(Id, _)) + )). +sweep_top_level_client(InStream, OutStream, _) :- + close(InStream), + close(OutStream), + thread_self(Self), + thread_property(Self, id(Id)), + retractall(sweep_top_level_thread_buffer(Id, _)). + +sweep_accept_top_level_client(Buffer, _) :- + thread_send_message(sweep_top_level_server, accept(Buffer)). diff --git a/sweeprolog.el b/sweeprolog.el index e1c3cd9..523e536 100644 --- a/sweeprolog.el +++ b/sweeprolog.el @@ -277,9 +277,9 @@ FLAG and VALUE are specified as strings and read as Prolog terms." (defun sweeprolog-start-prolog-server () (sweeprolog-open-query "user" - "prolog_server" - "prolog_server" - nil t) + "sweep" + "sweep_top_level_server" + nil) (let ((sol (sweeprolog-next-solution))) (sweeprolog-close-query) (when (sweeprolog-true-p sol) @@ -1164,7 +1164,9 @@ module name, F is a functor name and N is its arity." ;; (remove-list-of-text-properties beg end '(font-lock-face))) (sweeprolog-grammar-rule-face)) ("method" (sweeprolog-method-face)) - ("class" (sweeprolog-class-face)))) + ("class" (sweeprolog-class-face)) + ;; (_ (message "%S" arg) nil) + )) (defun sweeprolog--colourise (args) "ARGS is a list of the form (BEG LEN . SEM)." @@ -1173,7 +1175,7 @@ module name, F is a functor name and N is its arity." (arg (cddr args)) (flf (sweeprolog--colour-term-to-face arg))) (with-silent-modifications - (font-lock--add-text-property beg end 'font-lock-face flf (current-buffer) nil)))) + (put-text-property beg end 'font-lock-face flf)))) (defun sweeprolog-colourise-buffer (&optional buffer) (interactive) @@ -1254,9 +1256,9 @@ buffer to load." (end (point-max)) (contents (buffer-substring-no-properties beg end))) (sweeprolog-open-query "user" - "sweep" - "sweep_load_buffer" - (cons contents (buffer-file-name))) + "sweep" + "sweep_load_buffer" + (cons contents (buffer-file-name))) (let ((sol (sweeprolog-next-solution))) (sweeprolog-close-query) (if (sweeprolog-true-p sol) @@ -1281,14 +1283,22 @@ Interactively, a prefix arg means to prompt for BUFFER." (generate-new-buffer-name "*sweeprolog-top-level*")))))) (list buffer))) (let ((buf (get-buffer-create (or buffer "*sweeprolog-top-level*")))) - (with-current-buffer buf - (unless (eq major-mode 'sweeprolog-top-level-mode) - (sweeprolog-top-level-mode))) - (make-comint-in-buffer "sweeprolog-top-level" - buf - (cons "localhost" - sweeprolog-prolog-server-port)) - (pop-to-buffer buf sweeprolog-top-level-display-action))) + (with-current-buffer buf + (unless (eq major-mode 'sweeprolog-top-level-mode) + (sweeprolog-top-level-mode))) + (sweeprolog-open-query "user" + "sweep" + "sweep_accept_top_level_client" + (buffer-name buf)) + (let ((sol (sweeprolog-next-solution))) + (sweeprolog-close-query) + (unless (sweeprolog-true-p sol) + (error "Failed to create new top-level!"))) + (make-comint-in-buffer "sweeprolog-top-level" + buf + (cons "localhost" + sweeprolog-prolog-server-port)) + (pop-to-buffer buf sweeprolog-top-level-display-action))) (defun sweeprolog-top-level--post-self-insert-function () (when-let ((pend (cdr comint-last-prompt))) -- 2.39.5