(make-package "COMPILER" :use '("LISP"))
(make-package "SLOOP" :use '("LISP"))
(make-package "SERROR" :use '("LISP" "SLOOP"))
(make-package "ANSI-LOOP" :use '("LISP"))
(make-package "DEFPACKAGE" :use '("LISP"))
(make-package "TK" :use '("LISP" "SLOOP"))

(in-package "SYSTEM")

(defvar *command-args* nil)
 ;; if ANY header or license information is printed by the
 ;; program, then the following License and Enhancement notice
 ;; must be printed (see License).

(progn 

  (system:init-system) 
  (gbc t)

  (in-package "USER")

 (or lisp::*link-array*
     (setq lisp::*link-array*
	   (make-array (ash 1 11)  :element-type 'string-char :fill-pointer 0)))
 (si::use-fast-links t)

 (let* ((x (append (pathname-directory si::*system-directory*) (list :parent)))
	(lsp (append x (list "lsp")))
	(cmpnew (append x (list "cmpnew")))
	(h (append x (list "h")))
	(gtk (append x (list "gcl-tk"))))
   (dolist (d (list lsp cmpnew))
       (load (make-pathname :name "sys-proclaim" :type "lisp" :directory d)))
   (load (make-pathname :name "tk-package" :type "lsp" :directory gtk))
   (load (make-pathname :name "gcl_cmpmain" :type "lsp" :directory cmpnew))
   (load (make-pathname :name "gcl_lfun_list" :type "lsp" :directory cmpnew))
   (load (make-pathname :name "gcl_cmpopt" :type "lsp" :directory cmpnew))
   (load (make-pathname :name "gcl_auto_new" :type "lsp" :directory lsp))

   (gbc t)

   (setq compiler::*cmpinclude* "\"cmpinclude.h\"") 
 
   (when compiler::*cmpinclude-string*
     (with-open-file (st (make-pathname :directory h :name "cmpinclude" :type "h"))
		     (let
			 ((tem (make-array (file-length st) :element-type 'standard-char
					   :static t)))
		       (if (si::fread tem 0 (length tem) st)
			   (setq compiler::*cmpinclude-string* tem))))))
 
 (setf (symbol-function 'si:clear-compiler-properties)
       (symbol-function 'compiler::compiler-clear-compiler-properties))
 (setq system::*old-top-level* (symbol-function 'system:top-level))
 
 (defvar si::*lib-directory* (namestring (make-pathname :directory (list :parent))))
 
 (defun system::gcl-top-level (&aux tem)
   (si::set-up-top-level)
   
   (if (si::get-command-arg "-compile")
       (let (;(system::*quit-tag* (cons nil nil))
					;(system::*quit-tags* nil) (system::*break-level* '())
					;(system::*break-env* nil) (system::*ihs-base* 1)
					;(system::*ihs-top* 1) (system::*current-ihs* 1)
	     (*break-enable* nil) result)
	 (setq result
	       (system:error-set
		'(progn
		   (compile-file
		    (si::get-command-arg "-compile")
		    :output-file 
		    (or (si::get-command-arg "-o")
			(si::get-command-arg "-compile"))
		    :o-file
		    (cond ((equalp
			    (si::get-command-arg "-o-file")
			    "nil") nil)
			  ((si::get-command-arg "-o-file" t))
			  (t t))
		    :c-file (si::get-command-arg "-c-file" t)
		    :h-file (si::get-command-arg "-h-file" t)
		    :data-file (si::get-command-arg "-data-file" t)
		    :system-p (si::get-command-arg "-system-p" t)))))
	 (bye (if (or compiler::*error-p* (equal result '(nil))) 1 0))))
   (cond ((si::get-command-arg "-batch")
	  (setq si::*top-level-hook* 'bye))
	 ((si::get-command-arg "-f"))
	 (t (format t si::*system-banner*)
	    (format t "Temporary directory for compiler files set to ~a~%" *tmp-dir*)))
   (setq si::*ihs-top* 1)
   (in-package 'system::user) (incf system::*ihs-top* 2)
   (funcall system::*old-top-level*))
 
 (terpri)
 (setq si:*inhibit-macro-special* t)
 (gbc t) (system:reset-gbc-count)
 
 (defun system:top-level nil (system::gcl-top-level))
 
 (setq compiler::*default-c-file* nil)
 (setq compiler::*default-h-file* nil)
 (setq compiler::*default-data-file* nil)
 (setq compiler::*default-system-p* nil)
 (setq compiler::*keep-gaz* nil)
 
 (unintern 'system)
 (unintern 'lisp)
 (unintern 'compiler)
 (unintern 'user)
 (fmakunbound 'si::init-cmp-anon)
 
 (eval-when (load)
	    (if (fboundp 'get-system-time-zone)
		(setf system:*default-time-zone* (get-system-time-zone))
	      (setf system:*default-time-zone* 6)))
 
 (if (fboundp 'si::user-init) (si::user-init))
 (si::set-up-top-level)
 
 (setq si::*gcl-extra-version* @LI-EXTVERS@
       si::*gcl-minor-version* @LI-MINVERS@
       si::*gcl-major-version* @LI-MAJVERS@)
 (setq compiler::*cc* @LI-CC@)
 (setq compiler::*ld* @LI-LD@)
 (setq compiler::*ld-libs* @LI-LD-LIBS@)
 (setq compiler::*opt-three* @LI-OPT-THREE@)
 (setq compiler::*opt-two* @LI-OPT-TWO@)
 (setq compiler::*init-lsp* @LI-INIT-LSP@)

 (defvar si::*system-banner* (si::default-system-banner))
 
 (in-package 'user)
 (import 'si::info)

 t)
