BUILD

   1 #! /bin/sh
   2 lisp << EOF
   3 (in-package :cl-user)
   4
   5 ;;(gc-off)
   6
   7 (setf *print-case* :upcase)
   8
   9 (setf *features* (delete :no-clx *features* :test #'eq))
  10
  11 (or
  12  (ignore-errors (require :clx))
  13  (ignore-errors (require :cmucl-clx)))
  14
  15 (unless (member :clx *features*)
  16   (error "CLX was not loaded successfully."))
  17
  18 (ignore-errors (require :gray-streams))
  19
  20 (unless (find-class 'ext::fundamental-stream)
  21   (error "The graystreams was not loaded successfully."))
  22
  23 ;; Switch off bullshit
  24 (setf *TOP-LEVEL-AUTO-DECLARE* nil)
  25 (setf *GC-VERBOSE* nil)
  26 (setf *LOAD-VERBOSE* nil)
  27 (setf *LOAD-PRINT* nil)
  28
  29 ;;;; --------------------------------------------------------------------------------
  30
  31 ;;;; fixes
  32
  33 ;;
  34 ;; SIGINTs are now delivered to the "main thread"
  35 ;;
  36
  37 (in-package "MULTIPROCESSING")
  38
  39 (defvar *top-level-loop* nil)
  40
  41 (defun startup-idle-and-top-level-loops ()
  42   "Enter the idle loop, starting a new process to run the top level loop.
  43   The awaking of sleeping processes is timed better with the idle loop process
  44   running, and starting a new process for the top level loop supports a
  45   simultaneous interactive session. Such an initialisation will likely be the
  46   default when there is better MP debug support etc."
  47   (assert (eq *current-process* *initial-process*) ()
  48           "Only the *initial-process* is intended to run the idle loop")
  49   (init-multi-processing)               ; Initialise in case MP had been shutdown.
  50   ;; Start a new Top Level loop.
  51   (setq *top-level-loop*
  52         (make-process #'top-level :name "Top Level Loop") )
  53   ;; start the listener
  54   (ignore-errors (eval (read-from-string "(telnet::start :port 60666)")))
  55
  56   ;; Enter the idle loop.
  57   (idle-process-loop))
  58
  59 (in-package "UNIX")
  60
  61 (defun my-sigint-handler (signal code scp)
  62   (declare (ignore signal code)
  63            (type system-area-pointer scp)
  64            (optimize (inhibit-warnings 3)))
  65   (if mp::*top-level-loop*
  66       (let ((adr (with-alien ((scp (* sigcontext) scp))
  67                    (sap-int (vm:sigcontext-program-counter scp)))))
  68         (mp:process-interrupt mp::*top-level-loop*
  69                               (lambda ()
  70                                 (break "Interrupted at #x~x."
  71                                        adr))))
  72       (break "Interrupted at #x~x." adr)))
  73
  74 (setf ext:*after-save-initializations*
  75       (append ext:*after-save-initializations*
  76               (list (lambda ()
  77                       (enable-interrupt :sigint #'my-sigint-handler))
  78                     ;; mp::start-sigalrm-yield -- not reliable enough :-(
  79                     )))
  80
  81 (in-package "CL-USER")
  82
  83
  84 ;;;; --------------------------------------------------------------------------------
  85
  86 (load "closure.system")
  87
  88 (oos :clim :compile)
  89 (oos :clim-clx :compile)
  90 (oos :closure :compile)
  91
  92 (setf ext:*herald-items*
  93       (list* :clim (list (format nil "    Closure (loaded ~D-~2,'0D-~2,'0D)"
  94                                  (nth-value 5 (decode-universal-time (get-universal-time)))
  95                                  (nth-value 4 (decode-universal-time (get-universal-time)))
  96                                  (nth-value 3 (decode-universal-time (get-universal-time)))))
  97              ext:*herald-items*))
  98
  99 ;;;; Dump
 100
 101 ;; Enable the garbage collector.  But first fake it into thinking that
 102 ;; we don't need to garbage collect.  The save-lisp is going to call
 103 ;; purify so any garbage will be collected then.
 104 (setf lisp::*need-to-collect-garbage* nil)
 105 ;; (ext:gc-on)
 106 ;;
 107 ;; Save the lisp.
 108 (setf lisp::*internal-real-time-base-seconds* nil)
 109 (ext:save-lisp "lisp.core"
 110                :init-function 'mp::startup-idle-and-top-level-loops)
 111 (ext:quit)
 112 EOF