interfaces/xmaxima/win32/win_signals.lisp

   1 ;;;
   2 ;;; This is inter-process communication support for MAXIMA.
   3 ;;;
   4 ;;; The main idea is copied from gcl/maxima. We have a library
   5 ;;; winkill_lib.dll which sets up a shared memory file mapping.
   6 ;;; The program winkill.exe writes interrupts into the shared memory.
   7 ;;; Maxima should then regularly check this memory to see if it
   8 ;;; should interrupt current computation or terminate. Other
   9 ;;; signals are not supported yet.
  10 ;;;
  11 ;;; Currently there is only support for ccl and sbcl. Should add
  12 ;;; support for all lisps other than gcl which run on windows.
  13 ;;;
  14
  15 (in-package :maxima)
  16
  17 #+openmcl
  18 (progn
  19   ;; The main maxima thread
  20   (defvar *main-maxima-process*)
  21   (defvar *signal-monitor-process*)
  22
  23   (defun load-library ()
  24     (ccl:open-shared-library "winkill_lib")
  25     (ccl:external-call "init_shared_memory"))
  26
  27   (defvar *run-monitor* nil)
  28
  29   (defun monitor-shared-memory ()
  30     (loop while *run-monitor* do
  31        ;; Check for SIGINT signals
  32          (when (= 1 (ccl:external-call "read_sm_sigint" :int))
  33            (ccl:external-call "reset_sm_sigint")
  34            (ccl:process-interrupt *main-maxima-process* #'(lambda () (error "interrupt signal"))))
  35        ;; Check for SIGTERM signals
  36          (when (= 1 (ccl:external-call "read_sm_sigterm" :int))
  37            (ccl:external-call "reset_sm_sigterm")
  38            (ccl:process-interrupt *main-maxima-process* #'(lambda () ($quit))))
  39        ;; Wait a little
  40          (sleep 0.1)))
  41
  42   ;; Starts the monitor thread
  43   (defun start-monitor ()
  44     (setq *run-monitor* t)
  45     (setq *main-maxima-process* ccl:*current-process*)
  46     (setq *signal-monitor-process* (ccl:process-run-function "monitor" #'monitor-shared-memory)))
  47
  48   (defun $quit ()
  49     (when *signal-monitor-process*
  50       (ccl:process-kill *signal-monitor-process*))
  51     (ccl:quit))
  52
  53   (defun start-shared-memory-monitor ()
  54     (load-library)
  55     (start-monitor)))
  56
  57 #+sbcl
  58 (progn
  59   (sb-alien:load-shared-object "winkill_lib.dll")
  60
  61   (defun load-library ()
  62     (sb-alien:alien-funcall (sb-alien:extern-alien "init_shared_memory" (sb-alien:function sb-alien:void))))
  63
  64   (defvar *run-monitor* nil)
  65
  66   (defun monitor-shared-memory ()
  67     (loop while *run-monitor* do
  68           ;; Check for SIGINT signals
  69           (when (= 1 (sb-alien:alien-funcall (sb-alien:extern-alien "read_sm_sigint" (sb-alien:function sb-alien:int))))
  70             (sb-alien:alien-funcall (sb-alien:extern-alien "reset_sm_sigint" (function sb-alien:void)))
  71             (sb-thread:interrupt-thread (sb-thread:main-thread) #'(lambda () (error "interrupt signal"))))
  72           ;; Check for SIGTERM signals
  73           (when (= 1 (sb-alien:alien-funcall (sb-alien:extern-alien"read_sm_sigterm" (sb-alien:function sb-alien:int))))
  74             (sb-alien:alien-funcall (sb-alien:extern-alien "reset_sm_sigterm" (sb-alien:function sb-alien:void)))
  75             (sb-thread:interrupt-thread (sb-thread:main-thread) #'(lambda () ($quit))))
  76           ;; Wait a little
  77           (sleep 0.1)))
  78
  79   ;; Starts the monitor thread
  80   (defun start-monitor ()
  81     (setq *run-monitor* t)
  82     (sb-thread:make-thread #'monitor-shared-memory :name "monitor"))
  83
  84   (defun start-shared-memory-monitor ()
  85     (load-library)
  86     (start-monitor)))
  87
  88
  89 #-(or openmcl sbcl)
  90 (defun start-shared-memory-monitor ())
  91
  92
  93 ;; This function should be called when Maxima starts.
  94 (start-shared-memory-monitor)