The console is now protected by a global lock, so that toplevels from different threads do not interfere each other.

src/c/symbols_list2.h

@@ -1510,6 +1510,8 @@ cl_symbols[] = {
 {MP_ "+LOAD-COMPILE-LOCK+",NULL},
 {MP_ "WITH-LOCK",NULL},
 {MP_ "WITHOUT-INTERRUPTS",NULL},
+{MP_ "BLOCK-SIGNALS","mp_block_signals"},
+{MP_ "RESTORE-SIGNALS","mp_restore_signals"},
 #endif
 
 {SYS_ "WHILE",NULL},

src/h/external.h

@@ -1608,6 +1608,8 @@ extern ECL_API cl_object mp_condition_variable_timedwait(cl_object cv, cl_object
 extern ECL_API cl_object mp_condition_variable_signal(cl_object cv);
 extern ECL_API cl_object mp_condition_variable_broadcast(cl_object cv);
 extern ECL_API cl_object mp_current_process(void);
+extern ECL_API cl_object mp_block_signals(void);
+extern ECL_API cl_object mp_restore_signals(cl_object sigmask);
 
 extern ECL_API void ecl_import_current_thread(cl_object process_name, cl_object process_binding);
 extern ECL_API void ecl_release_current_thread(void);

src/lsp/mp.lsp

@@ -83,7 +83,7 @@ WITHOUT-INTERRUPTS in:
        (when si:*interrupts-enabled*
          (si::check-pending-interrupts)))))
 
-(defmacro with-lock ((lock-form) &body body)
+(defmacro with-lock ((lock &rest options) &body body)
   #-threads
   `(progn ,@body)
   ;; Why do we need %count? Even if get-lock succeeeds, an interrupt may
@@ -102,7 +102,7 @@ WITHOUT-INTERRUPTS in:
        (without-interrupts
            (unwind-protect
                 (with-restored-interrupts
-                    (mp::get-lock ,lock)
+                    (mp::get-lock ,lock, @options)
                   (locally ,@body))
              (when (> (mp:lock-count ,lock) ,count)
                (mp::giveup-lock ,lock)))))))

src/lsp/top.lsp

@@ -409,6 +409,44 @@ under certain conditions; see file 'Copyright' for details.")
 	(tpl))
       0)))
 
+#+threads
+(progn
+  (defvar *console-lock* (mp:make-lock :name "Console lock"))
+  (defvar *condition-variable* #-:win32 (mp:make-condition-variable))
+  (defvar *console-owner* nil)
+)
+
+(defmacro with-grabbed-console (&rest body)
+  #-threads
+  `(progn ,@body)
+  #+(and threads :win32)
+  `(progn
+     (tagbody
+      again
+        (with-lock (*console-lock*)
+          (cond (*condition-variable*
+                 (sleep 0.1)
+                 (go again))
+                (t
+                 (setf *console-owner* mp:*current-process*
+                       *condition-variable* mp:*current-process*)))))
+     (unwind-protect
+          (progn ,@body)
+       (with-lock (*console-lock*)
+         (setf *console-owner* nil
+               *condition-variable* nil))))
+  #+(and threads (not :win32))
+  `(progn
+     (with-lock (*console-lock*)
+       (unless (eq *console-owner* mp:*current-process*)
+         (mp:condition-variable-wait *console-available* *console-lock*))
+       (setf *console-owner* mp:*current-process*))
+     (unwind-protect
+          (progn ,@body)
+       (with-lock (*console-lock*)
+         (setf *console-owner* nil)
+         (mp:condition-variable-signal *console-variable*)))))
+
 (defvar *allow-recursive-debug* nil)
 (defvar *debug-status* nil)
 
@@ -461,13 +499,16 @@ under certain conditions; see file 'Copyright' for details.")
 			   )
 		     )))
 
-		 (tpl-prompt)
-		 (setq - (locally (declare (notinline tpl-read)) (tpl-read)))
-		 (setq values
-		       (multiple-value-list
-			(eval-with-env - *break-env*)))
-		 (setq /// // // / / values *** ** ** * * (car /))
-		 (tpl-print values))))
+               (setq - (with-grabbed-console
+                           (locally
+                               (declare (notinline tpl-read))
+                             (tpl-prompt)
+                             (tpl-read))))
+               (setq values
+                     (multiple-value-list
+                      (eval-with-env - *break-env*)))
+               (setq /// // // / / values *** ** ** * * (car /))
+               (tpl-print values))))
 	  (loop
 	   (setq +++ ++ ++ + + -)
 	   (when
@@ -1232,13 +1273,11 @@ package."
    (*debugger-waiting-list-lock*)
    (setq *debugger-waiting-list* (delete process *debugger-waiting-list*))))
 
-#+threads
 (defmacro with-debugger-lock (&body body)
+  #+threads
   `(mp:with-lock (*debugger-lock*)
-		 ,@body))
-
-#-threads
-(defmacro with-debugger-lock (&body body)
+		 ,@body)
+  #-threads
   `(progn ,@body))
 
 (defun default-debugger (condition)