;FIXME (defun make-package (name &key nicknames use) (si::make-package-int name nicknames use)) (make-package :cstruct :use '(:cl)) (make-package :compiler :use '(:cl :si :cstruct)) (make-package :sloop :use '(:cl)) (make-package :ansi-loop :use'(:cl)) (make-package :defpackage :use '(:cl)) (make-package :tk :use '(:cl :sloop)) (make-package :fpe :use '(:cl)) (make-package :cltl1-compat) (make-package "libm") (in-package :system) (use-package '(:fpe :cstruct :gmp)) (export 'si::(object double cnum system cmp-inline cmp-eval type-propagator c1no-side-effects defcfun clines defentry) :si);FIXME (setq *features* (cons :raw-image *features*)) (init-system) (setq *features* (remove :raw-image *features*)) (in-package :si) (gbc t) ;FIXME (progn (do-all-symbols (s) (when (or (coerce-to-standard-class s) (get s 's-data)) (remprop s 'deftype-definition) (remprop s 'deftype-form))) (let* ((p (find-package "PCL"))(x (when p (find-symbol "DO-SATISFIES-DEFTYPE" p)))) (when (and x (fboundp x)) (setf (symbol-function x) (lambda (x y) (declare (ignore x y)) nil))))) (do-symbols (s) (when (get s 'proclaimed-function) (unless (sig s) (let* ((fun (symbol-function s))) (c-set-function-plist fun (apply 'make-function-plist (list (mapcar 'cmp-norm-tp (get s 'proclaimed-arg-types)) (cmp-norm-tp (get s 'proclaimed-return-type))) (or (cdr (c-function-plist fun)) (list nil nil nil 1 s))))));FIXME props (dolist (l '(proclaimed-function proclaimed-arg-types proclaimed-return-type)) (remprop s l)))) (unless *link-array* (setq *link-array* (make-array (ash 1 11) :element-type 'character :fill-pointer 0))) (use-fast-links t) (let* ((x (append (pathname-directory (getenv "GCL_LSPSYSDIR")) (list :back))) (lsp (append x (list "lsp"))) (cmpnew (append x (list "cmpnew"))) (h (append x (list "h"))) (xgcl-2 (append x (list "xgcl-2"))) (pcl (append x (list "pcl"))) (clcs (append x (list "clcs"))) (gtk (append x (list "gcl-tk")))) ;; (dolist (d (list lsp cmpnew #+(and xgcl (not pre-gcl)) xgcl-2 #+(or pcl ansi-cl) pcl #+ansi-cl clcs)) ;; (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_lfun_list" :type "lsp" :directory cmpnew)) (load (make-pathname :name "gcl_cmpopt" :type "lsp" :directory cmpnew)) (let* ((x (merge-pathnames (make-pathname :name "gcl_cmpnopt" :type "lsp") *system-directory*))) (when (probe-file x) (load x))) (load (make-pathname :name "gcl_auto_new" :type "lsp" :directory lsp)) (gbc t)) (terpri) (setq *inhibit-macro-special* t) (gbc t) (reset-gbc-count) (set-up-top-level) (setq *gcl-extra-version* @LI_EXTVERS@ *gcl-minor-version* @LI_MINVERS@ *gcl-major-version* @LI_MAJVERS@ *gcl-git-tag* @LI_GITTAG@ *gcl-release-date* "@LI_RELEASE@") (defvar *system-banner* (default-system-banner)) (fmakunbound 'init-cmp-anon) (when (fboundp 'user-init) (user-init)) (in-package :compiler) (setq *cc* @LI_CC@ *ld* @LI_LD@ *ld-libs* @LI_LD_LIBS@ *ld-libs* (concatenate 'string "-l" #+ansi-cl "ansi_" "gcl" #+gprof "_gprof" " " *ld-libs*) *opt-three* @LI_OPT_THREE@ *opt-two* @LI_OPT_TWO@ *init-lsp* @LI_INIT_LSP@ si::*info-paths* (cons "@prefix@/share/info/" si::*info-paths*)) (import 'si::(clines defentry defcfun object void int double quit bye gbc system commonp *break-on-warnings* make-char char-bits char-font char-bit set-char-bit string-char-p int-char char-font-limit char-bits-limit char-control-bit char-meta-bit char-super-bit char-hyper-bit compiler-let) :cltl1-compat) (deftype cltl1-compat::string-char nil 'character) (do-symbols (s :cltl1-compat) (export s :cltl1-compat)) ;#-ansi-cl(use-package :cltl1-compat :lisp) ;#-ansi-cl(do-symbols (s :cltl1-compat) (export s :lisp)) #+ansi-cl (use-package :pcl :user) (import 'si::(clines defentry defcfun object void int double quit bye gbc system *lib-directory* *system-directory* while) :user) (let* ((i 4096)(j (si::equal-tail-recursion-check i))) (unless (<= (ash i -1) j) (warn "equal is not tail recursive ~s ~s" i j))) (format t "~s heap words available~%" (multiple-value-bind (a b c d) (si::heap-report) (/ (- d c) (/ a 8)))) (progn (setq si::*code-block-reserve* (make-array 30000000 :element-type 'character :static t :initial-element (code-char 0))) nil) (setq *optimize-maximum-pages* t)

AltStyle によって変換されたページ (->オリジナル) /