Skip to content
Snippets Groups Projects
compile-1.lisp 3.05 KiB
Newer Older
cer's avatar
cer committed
;; -*- mode: common-lisp; package: user -*-
;;
;; copyright (c) 1985, 1986 Franz Inc, Alameda, CA  All rights reserved.
;; copyright (c) 1986-1991 Franz Inc, Berkeley, CA  All rights reserved.
;;
;; The software, data and information contained herein are proprietary
;; to, and comprise valuable trade secrets of, Franz, Inc.  They are
;; given in confidence by Franz, Inc. pursuant to a written license
;; agreement, and may be stored and used only in accordance with the terms
;; of such license.
;;
;; Restricted Rights Legend
;; ------------------------
;; Use, duplication, and disclosure of the software, data and information
;; contained herein by any agency, department or entity of the U.S.
;; Government are subject to restrictions of Restricted Rights for
;; Commercial Software developed at private expense as specified in
;; DOD FAR Supplement 52.227-7013 (c) (1) (ii), as applicable.
cer's avatar
cer committed
;;
;; $Id: compile-1.lisp,v 1.36 1999/02/25 08:23:33 layer Exp $
cer's avatar
cer committed

(in-package :user)

(set-case-mode :case-insensitive-upper)

cer's avatar
cer committed
;;;; This should not matter
cer's avatar
cer committed
;;;; (setq *ignore-package-name-case* t)

;; Forgive them, lord, for they know not what they do.
(pushnew :ansi-90 *features*)

cer's avatar
cer committed
(setq comp:generate-call-count-code-switch
  (named-function |(> debug 1)|
cer's avatar
cer committed
		  (lambda (safety size speed debug)
		    (declare (ignore safety size speed))
		    (> debug 1))))
cer's avatar
cer committed
(setq comp:declared-fixnums-remain-fixnums-switch
  (named-function |(> speed 2)|
		  (lambda (safety size speed debug)
		    (declare (ignore safety size debug))
		    (> speed 2))))

(setf (sys:gsgc-parameter :print) t)
cer's avatar
cer committed
(defun compile-it (sys)
  (with-compilation-unit ()
    (let ((excl::*update-entry-points* nil))
      (setf (logical-pathname-translations "clim2")
	(list (list ";**;*.*" 
		    (format nil "~A/**/*.*" 
			    #.(directory-namestring 
			       (make-pathname
				:directory
				(butlast (pathname-directory 
					  *load-pathname*))))))))
      (unless (ignore-errors (excl:find-system 'sys))
	(load "clim2:;sys;sysdcl"))
      (excl:compile-system sys :include-components t)
      (tenuring
       (excl:load-system sys))
      (progn
	(excl:compile-system 'wnn :include-components t)
	(excl:load-system 'wnn))
      ;;(excl:compile-system 'clim-homegrown)
      (load "clim2:;postscript;sysdcl")
      (excl:compile-system 'postscript-clim :include-components t)
      (excl:load-system 'postscript-clim)
      (compile-file-if-needed "clim2:;test;test-suite")
      (load "clim2:;test;test-suite")
      (load "clim2:;demo;sysdcl")
      (excl:compile-system 'clim-demo :include-components t)
      (excl:load-system 'clim-demo)
cer's avatar
 
cer committed

      (progn
	(load "clim2:;test;testdcl")
	(tenuring
	 (excl:compile-system 'testing)
	 (excl:load-system 'testing)))
cer's avatar
 
cer committed

      (when (probe-file "clim2:;climtoys;sysdcl.lisp")
	(load "clim2:;climtoys;sysdcl.lisp")
	(excl:compile-system 'clim-toys))
cer's avatar
 
cer committed

;;;      (load "compatibility/sysdcl.lisp")
;;;      (excl:compile-system 'clim-compatibility :include-components t)
cer's avatar
 
cer committed

      (load "clim2:;hpgl;sysdcl")
      (excl:compile-system 'hpgl-clim :include-components t)
      (excl:load-system 'hpgl-clim))))
cer's avatar
 
cer committed