/[gcl]/gcl/unixport/init_gcl.lsp.in
ViewVC logotype

Diff of /gcl/unixport/init_gcl.lsp.in

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5 by prw, Sat Oct 19 05:18:32 2002 UTC revision 1.6 by camm, Mon Nov 11 03:43:06 2002 UTC
# Line 1  Line 1 
 ;(in-package "COMPILER")  
1  (make-package "COMPILER" :use '("LISP"))  (make-package "COMPILER" :use '("LISP"))
2  (in-package "SYSTEM")  (in-package "SYSTEM")
3  (defvar *command-args* nil)  (defvar *command-args* nil)
4  (in-package "USER")  (in-package "USER")
5  (in-package "LISP")  (in-package "LISP")
6    
 ;(lisp::in-package "SLOOP")  
7  (make-package "SLOOP" :use '("LISP"))  (make-package "SLOOP" :use '("LISP"))
8  (make-package "SERROR" :use '("LISP" "SLOOP"))  (make-package "SERROR" :use '("LISP" "SLOOP"))
9  (make-package "ANSI-LOOP" :use '("LISP"))  (make-package "ANSI-LOOP" :use '("LISP"))
# Line 19  Line 17 
17    
18  (in-package "USER")  (in-package "USER")
19  (progn  (progn
 ;(allocate 'cons 100) (allocate 'string 40)  
20   (system:init-system) (gbc t)   (system:init-system) (gbc t)
21   (load (concatenate 'string si::*system-directory* "../gcl-tk/tk-package.lsp"))   (load (concatenate 'string si::*system-directory* "../gcl-tk/tk-package.lsp"))
 ; (si::build-symbol-table)  
 ;#+gmp (defun si::multiply-bignum-stack (n) "nothing")  
 ; (si::multiply-bignum-stack 25)  
22   (or lisp::*link-array*   (or lisp::*link-array*
23    (setq lisp::*link-array*    (setq lisp::*link-array*
24       (make-array (ash 1 11)  :element-type 'string-char :fill-pointer 0)))       (make-array (ash 1 11)  :element-type 'string-char :fill-pointer 0)))
# Line 47  Line 41 
41                            :static t)))                            :static t)))
42        (if (si::fread tem 0 (length tem) st)        (if (si::fread tem 0 (length tem) st)
43            (setq compiler::*cmpinclude-string* tem)))))            (setq compiler::*cmpinclude-string* tem)))))
  ;;compile-file is in cmpmain.lsp  
44    
45   (setf (symbol-function 'si:clear-compiler-properties)   (setf (symbol-function 'si:clear-compiler-properties)
46         (symbol-function 'compiler::compiler-clear-compiler-properties))         (symbol-function 'compiler::compiler-clear-compiler-properties))
 ; (load "../lsp/setdoc.lsp")  
47   (setq system::*old-top-level* (symbol-function 'system:top-level))   (setq system::*old-top-level* (symbol-function 'system:top-level))
48    
49  (defvar si::*lib-directory* (namestring "../"))  (defvar si::*lib-directory* (namestring "../"))
# Line 99  Line 91 
91    (in-package 'system::user) (incf system::*ihs-top* 2)    (in-package 'system::user) (incf system::*ihs-top* 2)
92    (funcall system::*old-top-level*))    (funcall system::*old-top-level*))
93    
 ; (setq si::*gcl-version* 600)  
94   (defun lisp-implementation-version nil (format nil "GCL-~a-~a" si::*gcl-major-version* si::*gcl-version*))   (defun lisp-implementation-version nil (format nil "GCL-~a-~a" si::*gcl-major-version* si::*gcl-version*))
95   (terpri)   (terpri)
96   (setq si:*inhibit-macro-special* t)   (setq si:*inhibit-macro-special* t)
  ;(setq *modules* nil)  
97   (gbc t) (system:reset-gbc-count)   (gbc t) (system:reset-gbc-count)
98    
 ; (allocate 'cons 200)  
   
99   (defun system:top-level nil (system::gcl-top-level))   (defun system:top-level nil (system::gcl-top-level))
100    
101   (unintern 'system)   (unintern 'system)
102   (unintern 'lisp)   (unintern 'lisp)
103   (unintern 'compiler)   (unintern 'compiler)
104   (unintern 'user)   (unintern 'user)
  ;system-init  
105    
106   (if (fboundp 'user-init) (user-init))   (if (fboundp 'si::user-init) (si::user-init))
107   (si::set-up-top-level))   (si::set-up-top-level))
108  ; (in-package "USER")  ; (in-package "USER")
109  ; (system:save-system "saved_gcl") (bye)  ; (system:save-system "saved_gcl") (bye)
110    
111    ;
112    ; FIXME Leave the following in until maxima 5.6 is replaced
113    ;
114    ;system-init
115    
116    

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26