;;
;; SIGINTs are now delivered to the "main thread"
;;

(in-package "MULTIPROCESSING")

(defvar *top-level-loop* nil)

(defun startup-idle-and-top-level-loops ()
  "Enter the idle loop, starting a new process to run the top level loop.
  The awaking of sleeping processes is timed better with the idle loop process
  running, and starting a new process for the top level loop supports a
  simultaneous interactive session. Such an initialisation will likely be the
  default when there is better MP debug support etc."
  (assert (eq *current-process* *initial-process*) ()
	  "Only the *initial-process* is intended to run the idle loop")
  (init-multi-processing)               ; Initialise in case MP had been shutdown.
  ;; Start a new Top Level loop.
  (setq *top-level-loop*
        (make-process #'top-level :name "Top Level Loop") )
  ;; start the listener
  (ignore-errors (eval (read-from-string "(telnet::start :port 60666)")))

  ;; Enter the idle loop.
  (idle-process-loop))

(in-package "UNIX")

(defun my-sigint-handler (signal code scp)
  (declare (ignore signal code)
           (type system-area-pointer scp)
           (optimize (inhibit-warnings 3)))
  (if mp::*top-level-loop*
      (let ((adr (with-alien ((scp (* sigcontext) scp))
                   (sap-int (vm:sigcontext-program-counter scp)))))
        (mp:process-interrupt mp::*top-level-loop*
                              (lambda ()
                                (break "Interrupted at #x~x."
                                       adr))))
      (break "Interrupted at #x~x." adr)))

(setf ext:*after-save-initializations*
      (append ext:*after-save-initializations*
              (list (lambda ()
                      (enable-interrupt :sigint #'my-sigint-handler)) )))

(in-package "CL-USER")

;;;; Finally dump
;;
;; Enable the garbage collector.  But first fake it into thinking that
;; we don't need to garbage collect.  The save-lisp is going to call
;; purify so any garbage will be collected then.
(setf lisp::*need-to-collect-garbage* nil)
;; (ext:gc-on)
;;
;; Save the lisp.
(setf lisp::*internal-real-time-base-seconds* nil)
(ext:save-lisp "lisp.core"
               :init-function 'mp::startup-idle-and-top-level-loops)
(ext:quit)