1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
|
(make-package "C")
(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"))
(make-package "JAPI-PRIMITIVES" :use '("LISP"))
(make-package "TK-PRIMITIVES" :use '("LISP"))
#+win32(make-package :WIN32-PRIMITIVES :use '("LISP"))
@LI-PCL-PACKAGE@
(in-package :pcl)
(defvar *the-pcl-package* (find-package :pcl))
(defun load-truename (&optional (errorp nil))
(flet () *load-pathname* nil))
(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 'character :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")))
(pcl (append x (list "pcl")))
(gtk (append x (list "gcl-tk"))))
; (dolist (d (list lsp cmpnew pcl))
; (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))))))
(defvar si::*lib-directory* (namestring (make-pathname :directory (list :parent))))
(terpri)
(setq si:*inhibit-macro-special* t)
(gbc t) (system:reset-gbc-count)
(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)
t)
(progn
(unintern 'system)
(unintern 'lisp)
(unintern 'compiler)
(unintern 'user)
(when (fboundp 'si::init-cmp-anon) (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)))
(si::set-up-top-level)
(if (fboundp 'si::user-init) (si::user-init))
(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)
|