branch: externals/phps-mode
commit d45658d99c19aa6ebd3b0bb3ff0a0f9f5d36e1e5
Author: Christian Johansson <christ...@cvj.se>
Commit: Christian Johansson <christ...@cvj.se>
Starting experimenting with using two threads for serial commands
---
phps-mode-lexer.el | 3 --
phps-mode-serial.el | 147 ++++++++++++++++++++++++++++------------------------
2 files changed, 79 insertions(+), 71 deletions(-)
diff --git a/phps-mode-lexer.el b/phps-mode-lexer.el
index 8daae5d1b8..c4e0558995 100644
--- a/phps-mode-lexer.el
+++ b/phps-mode-lexer.el
@@ -1999,9 +1999,6 @@
(dolist (lambd lambdas)
(funcall lambd)))
- (when (fboundp 'thread-yield)
- (thread-yield))
-
;; Did we find a match?
(if phps-mode-lexer--match-length
(progn
diff --git a/phps-mode-serial.el b/phps-mode-serial.el
index d359694277..4b104dac8a 100644
--- a/phps-mode-serial.el
+++ b/phps-mode-serial.el
@@ -97,7 +97,7 @@
(let ((status (car start-return))
(value (car (cdr start-return)))
(start-time (car (cdr (cdr start-return))))
- (end-return nil))
+ (end-return))
;; Profile execution in debug mode
(when phps-mode-serial--profiling
@@ -145,77 +145,87 @@
(with-current-buffer key
(setq phps-mode-serial--status 'error))
(when start-error
- (funcall start-error value)))))))
+ (funcall start-error value))))
+ end-return)))
phps-mode-serial--async-processes))
(signal 'error (list "Async-start function is missing")))
;; Run command(s) asynchronously
- (puthash
- key
- (make-thread
- (lambda()
- (let ((start-return)
- (end-return))
-
- ;; First execute start lambda
- (condition-case conditions
- (let ((return (funcall start)))
- (setq start-return (list 'success return start-time)))
- (error (setq start-return (list 'error conditions
start-time))))
+ (let ((async-thread
+ (make-thread
+ (lambda()
+ (let ((start-return))
- ;; Profile execution in debug mode
- (when phps-mode-serial--profiling
- (let* ((end-time (current-time))
- (end-time-float
- (+ (car end-time) (car (cdr end-time)) (* (car (cdr
(cdr end-time))) 0.000001)))
- (start-time-float
- (+ (car start-time) (car (cdr start-time)) (* (car
(cdr (cdr start-time))) 0.000001)))
- (elapsed (- end-time-float start-time-float)))
- (message "Serial asynchronous thread start finished,
elapsed: %fs" elapsed)))
-
- (let ((status (car start-return))
- (value (car (cdr start-return)))
- (start-time (car (cdr (cdr start-return)))))
-
- (if (string= status "success")
- (progn
-
- ;; Then execute end lambda
- (condition-case conditions
- (let ((return (funcall end value)))
- (setq end-return (list 'success return
start-time)))
- (error (setq end-return (list 'error conditions
start-time))))
-
- ;; Profile execution
- (when phps-mode-serial--profiling
- (let* ((end-time (current-time))
- (end-time-float
- (+ (car end-time) (car (cdr end-time)) (*
(car (cdr (cdr end-time))) 0.000001)))
- (start-time-float
- (+ (car start-time) (car (cdr start-time))
(* (car (cdr (cdr start-time))) 0.000001)))
- (elapsed (- end-time-float start-time-float)))
- (message "Serial asynchronous thread end finished,
elapsed: %fs" elapsed)))
-
- (let ((status (car end-return))
- (value (car (cdr end-return))))
-
- (when (string= status "success")
- (with-current-buffer key
- (setq phps-mode-serial--status 'success)))
-
- (when (string= status "error")
- (with-current-buffer key
- (setq phps-mode-serial--status 'error))
- (when end-error
- (funcall end-error value)))))
-
- (when (string= status "error")
- (with-current-buffer key
- (setq phps-mode-serial--status 'error))
- (when start-error
- (funcall start-error value)))))))
- key)
- phps-mode-serial--async-threads))
+ ;; First execute start lambda
+ (condition-case conditions
+ (let ((return (funcall start)))
+ (setq start-return (list 'success return
start-time)))
+ (error (setq start-return (list 'error conditions
start-time))))
+
+ ;; Profile execution in debug mode
+ (when phps-mode-serial--profiling
+ (let* ((end-time (current-time))
+ (end-time-float
+ (+ (car end-time) (car (cdr end-time)) (* (car
(cdr (cdr end-time))) 0.000001)))
+ (start-time-float
+ (+ (car start-time) (car (cdr start-time)) (*
(car (cdr (cdr start-time))) 0.000001)))
+ (elapsed (- end-time-float start-time-float)))
+ (message "Serial asynchronous thread start finished,
elapsed: %fs" elapsed)))
+
+ start-return))
+ key)))
+ (puthash
+ key
+ async-thread
+ phps-mode-serial--async-threads)
+
+ (make-thread
+ `(lambda()
+ (let ((start-return
+ (thread-join ,async-thread))
+ (end-return))
+ (let ((status (car start-return))
+ (value (car (cdr start-return)))
+ (start-time (car (cdr (cdr start-return)))))
+
+ (if (string= status "success")
+ (progn
+
+ ;; Then execute end lambda
+ (condition-case conditions
+ (let ((return (funcall end value)))
+ (setq end-return (list 'success return
start-time)))
+ (error (setq end-return (list 'error conditions
start-time))))
+
+ ;; Profile execution
+ (when phps-mode-serial--profiling
+ (let* ((end-time (current-time))
+ (end-time-float
+ (+ (car end-time) (car (cdr end-time)) (*
(car (cdr (cdr end-time))) 0.000001)))
+ (start-time-float
+ (+ (car start-time) (car (cdr start-time))
(* (car (cdr (cdr start-time))) 0.000001)))
+ (elapsed (- end-time-float
start-time-float)))
+ (message "Serial asynchronous thread end
finished, elapsed: %fs" elapsed)))
+
+ (let ((status (car end-return))
+ (value (car (cdr end-return))))
+
+ (when (string= status "success")
+ (with-current-buffer key
+ (setq phps-mode-serial--status 'success)))
+
+ (when (string= status "error")
+ (with-current-buffer key
+ (setq phps-mode-serial--status 'error))
+ (when end-error
+ (funcall end-error value)))))
+
+ (when (string= status "error")
+ (with-current-buffer key
+ (setq phps-mode-serial--status 'error))
+ (when start-error
+ (funcall start-error value)))))
+ end-return)))))
(let ((start-return)
(end-return))
@@ -277,7 +287,8 @@
(with-current-buffer key
(setq phps-mode-serial--status 'error))
(when start-error
- (funcall start-error value)))))))))
+ (funcall start-error value)))))
+ end-return))))
(provide 'phps-mode-serial)
;;; phps-mode-serial.el ends here
