;;;-*- Mode:LISP; Package: COMMON-LISP-USER; Base:10; Syntax:Common-Lisp -*-
;;;
;;; Copyright (c) 2000-2015, Toshimi Sawada. All rights reserved.
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;;*****************************************************************************
;;; Template for making CafeOBJ interpreter.
;;;*****************************************************************************
(eval-when (:execute :load-toplevel)
(unless (find-package :common-lisp)
(rename-package :lisp :common-lisp
(union '("CL" "LISP")
(package-nicknames (find-package :lisp)) :test #'string=)))
(unless (find-package :common-lisp-user)
(rename-package :user :common-lisp-user
(union '("CL-USER" "USER")
(package-nicknames (find-package :user)) :test #'string=)))
)
#+LUCID (in-package "user")
#+Excl (in-package :user)
#+(or :ccl CMU :SBCL) (in-package :common-lisp-user)
#+GCL (in-package :user)
#+GCL (setf compiler::*compile-ordinaries* t)
(unless (find-package :chaos)
(make-package :chaos))
#+CLISP (in-package :common-lisp-user)
;;; BEGIN SITE SPECIFIC ------------------------------------------------------
;;;
(defvar *chaos-root*)
#-(or microsoft (and ccl (not :openmcl)))
(eval-when (:execute :load-toplevel)
(setq *chaos-root* "@srcdir@"))
#+clisp
(eval-when (:execute :load-toplevel)
(setq *chaos-root* (namestring (car (directory (concatenate 'string
*chaos-root* "/"))))))
(defvar chaos::*cafeobj-install-dir*)
#-(or microsoft (and ccl (not :openmcl)))
(eval-when (:execute :load-toplevel)
(setq chaos::*cafeobj-install-dir* "@srcdir@")
)
#+(or microsoft (and ccl (not :openmcl)))
(eval-when (:execute :load-toplevel)
;; (setq chaos::*cafeobj-install-dir* *chaos-root*)
(setq *chaos-bin-path-name* (concatenate 'string *chaos-root* "/bin")))
(defvar chaos::*make-bigpink* nil)
;;; END SITE SPECIFIC --------------------------------------------------------
(eval-when (:execute :load-toplevel)
(setq chaos::*make-bigpink* :nil)
;; (push :chaos-debug *features*)
(push :bigpink *features*))
#-:ASDF
(eval-when (:execute :load-toplevel)
#+microsoft
(load (concatenate 'string *chaos-root* "\\asdf.lisp"))
#-(or (and CCL (not :openmcl)) microsoft sbcl)
(load (concatenate 'string *chaos-root* "/asdf.lisp"))
#+SBCL
(require 'asdf)
;; patch by t-seino@jaist.ac.jp
;; patch by sawada@sra.co.jp
#+(and CCL (not :openmcl))
(load (concatenate 'string *chaos-root* ":asdf.lisp"))
;; patch by t-seino@jaist.ac.jp (2000/02/09)
;; patch by sawada@sra.co.jp
#+(and CCL (not :openmcl))
(load (concatenate 'string *chaos-root* ":system"))
#+sbcl (require :asdf))
#+GCL
(defun make-exec-image (path)
(setq chaos::-cafeobj-load-time- (chaos::get-time-string))
(chaos::set-cafeobj-standard-library-path)
(setq *chaos-new* t)
(defun system::top-level () (funcall 'chaos::cafeobj-top-level))
(si::set-up-top-level)
(system::save-system path)
(bye))
#+CMU
(defun make-exec-image (path)
(setq chaos::-cafeobj-load-time- (chaos::get-time-string))
(chaos::set-cafeobj-standard-library-path)
(setq *chaos-new* t)
(ext:save-lisp path
:purify t
:init-function 'chaos::cafeobj-top-level
:print-herald nil
)
)
#+SBCL
(defun make-exec-image (path)
(setq chaos::-cafeobj-load-time- (chaos::get-time-string))
(chaos::set-cafeobj-standard-library-path)
(setq *chaos-new* t)
(sb-ext:save-lisp-and-die path
:toplevel 'chaos::cafeobj-top-level
:purify t
:executable t
:save-runtime-options t
)
)
#+LUCID
(defun make-exec-image (path)
(setq chaos::-cafeobj-load-time- (chaos::get-time-string))
(chaos::set-cafeobj-standard-library-path)
(setq *chaos-new* t)
(disksave path
:full-gc t
:restart-function 'chaos::cafeobj-top-level))
#+(and ccl (not :openmcl))
(defun make-exec-image (path)
(setq chaos::-cafeobj-load-time- (chaos::get-time-string))
(chaos::set-cafeobj-standard-library-path)
(setq *chaos-new* t)
;; patch by t-seino@jaist.ac.jp
(save-application path :toplevel-function 'chaos::cafeobj-top-level)
)
#+:openmcl
(defun make-exec-image (path)
(setq chaos::-cafeobj-load-time- (chaos::get-time-string))
(chaos::set-cafeobj-standard-library-path)
(setq *chaos-new* t)
(ccl::save-application path :toplevel-function 'chaos::cafeobj-top-level)
)
#+:ALLEGRO-V5.0
(require :build)
#+:ALLEGRO
(defun make-exec-image (path)
(setq chaos::-cafeobj-load-time- (chaos::get-time-string))
(chaos::set-cafeobj-standard-library-path)
(setq *chaos-new* t)
(setq excl:*restart-app-function* 'chaos::cafeobj-top-level)
#||
(setq excl:*restart-init-function*
#'(lambda ()
(excl:use-background-streams)
(excl:start-emacs-lisp-interface t)))
||#
(setq excl:*print-startup-message* nil)
(setq excl::.dump-lisp-suppress-allegro-cl-banner. t)
(dumplisp :name path :suppress-allegro-cl-banner t)
)
#+:CLISP
(defun make-exec-image (path)
(setq chaos::-cafeobj-load-time- (chaos::get-time-string))
(chaos::set-cafeobj-standard-library-path)
(setq *chaos-new* t)
(chaos::save-chaos 'chaos::cafeobj-top-level path))
;;;;
(defvar chaos::*compile-builtin-axiom* nil)
(defun make-cafeobj (&optional chaos-root)
(format t "~%** making CafeOBJ (~a)" (or chaos-root
*chaos-root*))
(when chaos-root
(setf *chaos-root* chaos-root))
;; (mk::operate-on-system :chaosx :compile)
(setq chaos::*compile-builtin-axiom* nil)
(load "sysdef.asd")
(load "cl-ppcre/cl-ppcre.asd")
(asdf:oos 'asdf:load-op :cl-ppcre)
(asdf:oos 'asdf:load-op 'chaosx)
(make-exec-image
(concatenate 'string *chaos-root*
#+GCL "/dumps/gcl/@gcl_dump@"
#+microsoft "/dumps/dxl/cafeobj.dxl"
#+(and unix Allegro) "/dumps/acl/@acl_dump@"
#+CMU "/dumps/cmu/@cmu_dump@"
#+SBCL "/dumps/sbcl/@sbcl_dump@"
#+CLISP "/dumps/clisp/@clisp_dump@"
#+:openmcl "/dumps/ccl/@ccl_dump@"
;; patch by t-seino@jaist.ac.jp
;; patch by sawada@sra.co.jp
#+(and CCL (not :openmcl)) ":dumps:ccl:cafeobj.exe"
))
)
(eval-when (:execute :load-toplevel)
(make-cafeobj *chaos-root*)
)
;;; EOF