home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / lisp / kcl_tar.z / kcl_tar / unixport / init_kcl.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1987-06-03  |  2.9 KB  |  66 lines
  1. (in-package "COMPILER")
  2. (in-package "SYSTEM")
  3. (in-package "USER")
  4. (in-package "LISP")
  5. (in-package "USER")
  6. (progn (allocate 'cons 100) (allocate 'string 40)
  7.  (system:init-system) (gbc t)
  8.  (load #"../cmpnew/cmpmain.lsp") (gbc t) (load #"../cmpnew/lfun_list.lsp")
  9.  (gbc t) (load #"../cmpnew/cmpopt.lsp") (gbc t)
  10.  (defun compile-file
  11.   (&rest system::args &aux (*print-pretty* nil) (*package* *package*))
  12.   (compiler::init-env) (apply 'compiler::compile-file1 system::args))
  13.  (defun compile (&rest system::args &aux (*print-pretty* nil))
  14.   (apply 'compiler::compile1 system::args))
  15.  (defun disassemble (&rest system::args &aux (*print-pretty* nil))
  16.   (apply 'compiler::disassemble1 system::args))
  17.  (setf (symbol-function 'si:clear-compiler-properties)
  18.        (symbol-function 'compiler::compiler-clear-compiler-properties))
  19.  (load "../lsp/setdoc.lsp")
  20.  (setq system::*old-top-level* (symbol-function 'system:top-level))
  21.  (defun system::kcl-top-level nil
  22.   (when (> (system:argc) 1)
  23.         (setq system:*system-directory* (system:argv 1)))
  24.   (when (>= (system:argc) 5)
  25.         (let ((system::*quit-tag* (cons nil nil))
  26.               (system::*quit-tags* nil) (system::*break-level* '())
  27.               (system::*break-env* nil) (system::*ihs-base* 1)
  28.               (system::*ihs-top* 1) (system::*current-ihs* 1)
  29.               (*break-enable* nil))
  30.              (system:error-set
  31.               '(let ((system::flags (system:argv 4)))
  32.                     (setq system:*system-directory*
  33.                           (pathname (system:argv 1)))
  34.                     (compile-file (system:argv 2) :output-file
  35.                      (system:argv 3) :o-file
  36.                      (case (schar system::flags 1) (#\0 nil) (#\1 t)
  37.                            (t (system:argv 5)))
  38.                      :c-file
  39.                      (case (schar system::flags 2) (#\0 nil) (#\1 t)
  40.                            (t (system:argv 6)))
  41.                      :h-file
  42.                      (case (schar system::flags 3) (#\0 nil) (#\1 t)
  43.                            (t (system:argv 7)))
  44.                      :data-file
  45.                      (case (schar system::flags 4) (#\0 nil) (#\1 t)
  46.                            (t (system:argv 8)))
  47.                      :system-p
  48.                      (if (char-equal (schar system::flags 0) #\S) t
  49.                          nil))))
  50.              (bye (if compiler::*error-p* 1 0))))
  51.   (format t "KCl (Kyoto Common Lisp)  ~A~%" "June 3, 1987")
  52.   (in-package 'system::user) (incf system::*ihs-top* 2)
  53.   (funcall system::*old-top-level*))
  54.  (defun lisp-implementation-version nil "June 3, 1987")
  55.  (setq si:*inhibit-macro-special* t)
  56.  (setq *modules* nil) (gbc t) (system:reset-gbc-count)
  57.  (allocate 'cons 200)
  58.  (defun system:top-level nil (system::kcl-top-level))
  59.  (unintern 'system)
  60.  (unintern 'lisp)
  61.  (unintern 'compiler)
  62.  (unintern 'user)
  63.  (system:save-system "saved_kcl") (bye)
  64.  (defun system:top-level nil (system::kcl-top-level))
  65.  (save "saved_kcl") (bye))
  66.