| 1 | ;;; a quick startup script that can be loaded with all supported lisps |
|---|
| 2 | (in-package :cl-user) |
|---|
| 3 | |
|---|
| 4 | #+sbcl (require 'asdf) |
|---|
| 5 | #+sbcl (require 'sb-posix) |
|---|
| 6 | |
|---|
| 7 | #+sbcl (assert (eql sb-impl::*default-external-format* :utf-8)) |
|---|
| 8 | #+cmu |
|---|
| 9 | (setf stream:*default-external-format* :utf-8 |
|---|
| 10 | ext:*gc-verbose* nil |
|---|
| 11 | *compile-print* nil |
|---|
| 12 | ext:*bytes-consed-between-gcs* (* 64 1024 1024) |
|---|
| 13 | *default-pathname-defaults* (pathname (format nil "~A/" (nth-value 1 (unix:unix-current-directory))))) |
|---|
| 14 | |
|---|
| 15 | (load (compile-file "../../thirdparty/asdf/asdf.lisp")) |
|---|
| 16 | |
|---|
| 17 | ;; cl-gd glue |
|---|
| 18 | #+darwin (assert (zerop (asdf:run-shell-command "cd ../../thirdparty/cl-gd-0.5.6; make cl-gd-glue.dylib"))) |
|---|
| 19 | #-darwin (assert (zerop (asdf:run-shell-command "cd ../../thirdparty/cl-gd-0.5.6; make"))) |
|---|
| 20 | |
|---|
| 21 | ;;; some helpers |
|---|
| 22 | (defun setup-registry () |
|---|
| 23 | (format t "; setting up ASDF registry, please be patient...") |
|---|
| 24 | (finish-output) |
|---|
| 25 | (mapc #'(lambda (asd-pathname) |
|---|
| 26 | (pushnew (make-pathname :directory (pathname-directory asd-pathname)) |
|---|
| 27 | asdf:*central-registry* |
|---|
| 28 | :test #'equal)) |
|---|
| 29 | (directory (merge-pathnames #p"**/*.asd" (truename "../../"))))) |
|---|
| 30 | |
|---|
| 31 | (defun read-configuration (pathname) |
|---|
| 32 | (with-open-file (s pathname) |
|---|
| 33 | (loop for form = (read s nil :end-of-file) |
|---|
| 34 | while (not (eq form :end-of-file)) |
|---|
| 35 | ;; 2008-03-12 kilian: I have added eval here (e.g. for merge-pathnames) |
|---|
| 36 | collect (eval form)))) |
|---|
| 37 | |
|---|
| 38 | ;;; setup asdf:*central-registry* |
|---|
| 39 | (setup-registry) |
|---|
| 40 | |
|---|
| 41 | ;;; load bos project |
|---|
| 42 | (asdf:oos 'asdf:load-op :bos.web) |
|---|
| 43 | |
|---|
| 44 | #+sbcl |
|---|
| 45 | (defvar *sbcl-home* (sb-int:sbcl-homedir-pathname)) |
|---|
| 46 | |
|---|
| 47 | #+sbcl |
|---|
| 48 | (defun ensure-sbcl-home () |
|---|
| 49 | (sb-posix:putenv (format nil "SBCL_HOME=~a" *sbcl-home*))) |
|---|
| 50 | |
|---|
| 51 | (defun env-ascii-check () |
|---|
| 52 | #+sbcl |
|---|
| 53 | (assert (block top |
|---|
| 54 | (dolist (string (posix-environ) t) |
|---|
| 55 | (loop for ch across string |
|---|
| 56 | unless (< 0 (char-code ch) 128) |
|---|
| 57 | do (return-from top nil)))) |
|---|
| 58 | nil |
|---|
| 59 | "We will have a problem if your environment contains anything else than ASCII characters.~ |
|---|
| 60 | ~%So I'd like to enforce this here.")) |
|---|
| 61 | |
|---|
| 62 | (defun start (&key (swank-port 4005)) |
|---|
| 63 | #+sbcl (ensure-sbcl-home) |
|---|
| 64 | (env-ascii-check) |
|---|
| 65 | ;; check for changes that are not yet in the core |
|---|
| 66 | (asdf:oos 'asdf:load-op :bos.web) |
|---|
| 67 | (mapcar #'cl-gd::load-foreign-library ; for now... |
|---|
| 68 | '("/usr/lib/libcrypto.so" |
|---|
| 69 | "/usr/lib/libssl.so" |
|---|
| 70 | "/usr/local/lib/libgd.so" |
|---|
| 71 | )) |
|---|
| 72 | (format t "BOS Online-System~%") |
|---|
| 73 | ;; slime |
|---|
| 74 | (asdf:oos 'asdf:load-op :swank) |
|---|
| 75 | (eval (read-from-string (format nil "(progn (swank-loader::init) |
|---|
| 76 | (swank:create-server :port ~D :dont-close t))" swank-port))) |
|---|
| 77 | ;; start the bos server |
|---|
| 78 | (apply #'bos.m2::reinit (read-configuration "m2.rc")) |
|---|
| 79 | (apply #'bos.web::init (read-configuration "web.rc")) |
|---|
| 80 | (bos.web::start-contract-tree-image-update-daemon) |
|---|
| 81 | (bos.m2::start-postmaster) |
|---|
| 82 | (bknr.cron::start-cron) |
|---|
| 83 | #+(and cmu mp) |
|---|
| 84 | (mp::startup-idle-and-top-level-loops)) |
|---|
| 85 | |
|---|
