<short summary of the patch>
authorCamm Maguire <camm@debian.org>
Sun, 13 Nov 2022 12:55:14 +0000 (12:55 +0000)
committerCamm Maguire <camm@debian.org>
Sun, 13 Nov 2022 12:55:14 +0000 (12:55 +0000)
TODO: Put a short summary on the line above and replace this paragraph
with a longer explanation of this change. Complete the meta-information
with other relevant fields (see below for details). To make it easier, the
information below has been extracted from the changelog. Adjust it or drop
it.

gcl (2.6.12-2) unstable; urgency=medium

  * Version_2_6_13pre1

Gbp-Pq: Name Version_2_6_13pre1

133 files changed:
clcs/package.lisp
clcs/sys-proclaim.lisp
cmpnew/gcl_cmpbind.lsp
cmpnew/gcl_cmpblock.lsp
cmpnew/gcl_cmpcall.lsp
cmpnew/gcl_cmpcatch.lsp
cmpnew/gcl_cmpenv.lsp
cmpnew/gcl_cmpeval.lsp
cmpnew/gcl_cmpflet.lsp
cmpnew/gcl_cmpfun.lsp
cmpnew/gcl_cmpif.lsp
cmpnew/gcl_cmpinline.lsp
cmpnew/gcl_cmplabel.lsp
cmpnew/gcl_cmplam.lsp
cmpnew/gcl_cmplet.lsp
cmpnew/gcl_cmploc.lsp
cmpnew/gcl_cmpmain.lsp
cmpnew/gcl_cmpmap.lsp
cmpnew/gcl_cmpmulti.lsp
cmpnew/gcl_cmpopt.lsp
cmpnew/gcl_cmpspecial.lsp
cmpnew/gcl_cmptag.lsp
cmpnew/gcl_cmptest.lsp
cmpnew/gcl_cmptop.lsp
cmpnew/gcl_cmptype.lsp
cmpnew/gcl_cmputil.lsp
cmpnew/gcl_cmpvar.lsp
cmpnew/gcl_cmpvs.lsp
cmpnew/gcl_cmpwt.lsp
cmpnew/gcl_collectfn.lsp
cmpnew/gcl_lfun_list.lsp
cmpnew/gcl_make_ufun.lsp
cmpnew/gcl_nocmpinc.lsp
cmpnew/sys-proclaim.lisp
configure
configure.in
h/amd64-linux.h
h/att_ext.h
h/compdefs.h
h/elf64_i386_reloc.h
h/lu.h
h/notcomp.h
h/object.h
h/page.h
h/protoize.h
h/symbol.h
h/writable.h
info/form.texi
lsp/gcl_arraylib.lsp
lsp/gcl_auto.lsp
lsp/gcl_auto_new.lsp
lsp/gcl_autoload.lsp
lsp/gcl_debug.lsp
lsp/gcl_defmacro.lsp
lsp/gcl_defstruct.lsp
lsp/gcl_describe.lsp
lsp/gcl_destructuring_bind.lsp
lsp/gcl_doc-file.lsp
lsp/gcl_evalmacros.lsp
lsp/gcl_export.lsp
lsp/gcl_fpe.lsp
lsp/gcl_info.lsp
lsp/gcl_iolib.lsp
lsp/gcl_listlib.lsp
lsp/gcl_mislib.lsp
lsp/gcl_module.lsp
lsp/gcl_numlib.lsp
lsp/gcl_packlib.lsp
lsp/gcl_predlib.lsp
lsp/gcl_profile.lsp
lsp/gcl_seq.lsp
lsp/gcl_seqlib.lsp
lsp/gcl_serror.lsp
lsp/gcl_setf.lsp
lsp/gcl_sloop.lsp
lsp/gcl_stack-problem.lsp
lsp/gcl_top.lsp
lsp/gcl_trace.lsp
lsp/sys-proclaim.lisp
o/alloc.c
o/array.c
o/assignment.c
o/bind.c
o/cfun.c
o/character.d
o/cmpaux.c
o/error.c
o/eval.c
o/fasdump.c
o/file.d
o/funlink.c
o/gbc.c
o/gmp.c
o/hash.d
o/let.c
o/lex.c
o/macros.c
o/main.c
o/package.d
o/predicate.c
o/read.d
o/reference.c
o/run_process.c
o/save.c
o/sfaslbfd.c
o/sfaslelf.c
o/sgbc.c
o/string.d
o/structure.c
o/toplevel.c
o/typespec.c
o/unexelf.c
o/unixsave.c
o/unixsys.c
o/unixtime.c
pcl/defsys.lisp
pcl/gcl_pcl_pkg.lisp
pcl/gcl_pcl_walk.lisp
pcl/impl/gcl/gcl_pcl_impl_low.lisp
pcl/makefile
pcl/package.lisp [new file with mode: 0644]
pcl/sys-proclaim.lisp
unixport/makefile
unixport/sys_ansi_gcl.c
unixport/sys_gcl.c
unixport/sys_init.lsp.in [new file with mode: 0644]
unixport/sys_pcl_gcl.c
unixport/sys_pre_gcl.c
xgcl-2/gcl_init_xgcl.lsp
xgcl-2/makefile
xgcl-2/package.lisp [new file with mode: 0644]
xgcl-2/sys-proclaim.lisp [new file with mode: 0644]
xgcl-2/sysdef.lisp

index d0a72526e400826f71e79934ce76ae83284be964..4c856f30f57b3a49341068273ca27702a98808e6 100755 (executable)
@@ -20,3 +20,4 @@
 (defvar *this-package* (find-package :conditions))
 
 
+(import 'si::(clines defentry defcfun object void int double))
index 7b562defa358e7fc8bf3dfe2015995eb083b0b84..1faff6330f9816e3713e995a48f8ee583d04bfc4 100644 (file)
@@ -1,45 +1,46 @@
 
-(IN-PACKAGE "CONDITIONS") 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T) T) CONDITION-CLASS-P IS-WARNING CONDITIONP
-            IS-CONDITION ESCAPE-SPECIAL-CASES-REPLACE
-            SIMPLE-CONDITION-CLASS-P INTERNAL-SIMPLE-CONDITION-CLASS-P)) 
-(PROCLAIM '(FTYPE (FUNCTION (*) *) CLCS-COMPILE)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T) T) ASSERT-REPORT SYMCAT COERCE-TO-FN
-            SLOT-SYM)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T *) *) CLCS-LOAD CLCS-OPEN CLCS-COMPILE-FILE
-            MAKE-CONDITION)) 
-(PROCLAIM '(FTYPE (FUNCTION (T) (*)) SIMPLE-ASSERTION-FAILURE)) 
-(PROCLAIM '(FTYPE (FUNCTION (T T T) T) ACCUMULATE-CASES)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T) T)
-            |(PCL::FAST-METHOD PRINT-OBJECT (CONDITION T))|)) 
-(PROCLAIM '(FTYPE (FUNCTION (T T) *) ASSERT-PROMPT)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T) *)
-            |(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-WARNING T))|
-            |(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-SLOT T))|
-            |(PCL::FAST-METHOD PRINT-OBJECT (END-OF-FILE T))|
-            |(PCL::FAST-METHOD PRINT-OBJECT (FILE-ERROR T))|
-            |(PCL::FAST-METHOD PRINT-OBJECT (ARITHMETIC-ERROR T))|
-            |(PCL::FAST-METHOD PRINT-OBJECT (SIMPLE-CONDITION T))|
-            |(PCL::FAST-METHOD PRINT-OBJECT (ABORT-FAILURE T))|
-            |(PCL::FAST-METHOD PRINT-OBJECT (CASE-FAILURE T))|
-            |(PCL::FAST-METHOD PRINT-OBJECT (UNDEFINED-FUNCTION T))|
-            |(PCL::FAST-METHOD PRINT-OBJECT (PRINT-NOT-READABLE T))|
-            |(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-ERROR T))|
-            |(PCL::FAST-METHOD PRINT-OBJECT (PACKAGE-ERROR T))|
-            |(PCL::FAST-METHOD PRINT-OBJECT (CELL-ERROR T))|
-            |(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-CONDITION T))|
-            |(PCL::FAST-METHOD PRINT-OBJECT (STREAM-ERROR T))|
-            COERCE-TO-CONDITION
-            |(PCL::FAST-METHOD PRINT-OBJECT (TYPE-ERROR T))|
-            |(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-VARIABLE T))|)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION NIL T) REVERT-CLCS-SYMBOLS INSTALL-CLCS-SYMBOLS
-            READ-EVALUATED-FORM)) 
-(MAPC (LAMBDA (COMPILER::X)
-        (SETF (GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) T))
-      '(INSTALL-SYMBOL REVERT-SYMBOL)) 
\ No newline at end of file
+(COMMON-LISP::IN-PACKAGE "CONDITIONS") 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T)
+         CONDITIONS::IS-WARNING CONDITIONS::DEFAULT-REPORT
+         CONDITIONS::IS-CONDITION CONDITIONS::CONDITIONP)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T)
+             COMMON-LISP::*)
+         CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ARITHMETIC-ERROR T))|
+         CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PACKAGE-ERROR T))|
+         CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (INTERNAL-CONDITION T))|
+         CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNDEFINED-FUNCTION T))|
+         CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-SLOT T))|
+         CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (UNBOUND-VARIABLE T))|
+         CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CASE-FAILURE T))|
+         CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (PRINT-NOT-READABLE T))|
+         CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (SIMPLE-CONDITION T))|
+         CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (ABORT-FAILURE T))|
+         CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (TYPE-ERROR T))|
+         CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CELL-ERROR T))|
+         CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (FILE-ERROR T))|
+         CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (END-OF-FILE T))|
+         CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (STREAM-ERROR T))|)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T)
+             COMMON-LISP::T)
+         CONDITIONS::|(PCL::FAST-METHOD PRINT-OBJECT (CONDITION T))|
+         CONDITIONS::|(PCL::FAST-METHOD MAKE-LOAD-FORM (CONDITION))|)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::T)
+         CONDITIONS::COERCE-TO-FN CONDITIONS::SLOT-SYM)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::*)
+         COMMON-LISP::MAKE-CONDITION)) 
\ No newline at end of file
index fe4a8cdada45b427395e38702f637870bf39ce8c..7860b60f1275eb60634dd13028977f6eb7b8c35a 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (si:putprop 'bds-bind 'set-bds-bind 'set-loc)
 
index 2653cec5c985e6423e181aa3d416cf565261471d..ee46e8c1a6cde65a7efa5418a34a42e0ff0d3a09 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (si:putprop 'block 'c1block 'c1special)
 (si:putprop 'block 'c2block 'c2)
index c2ac971c0e1af51297db753813a1e4866ed9fcf1..b407e19546b48a40fca9aa1cc860e731b61b628b 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (defvar *ifuncall* nil)
 
index b2e776907f7a73a2421e82706fb13638373e641c..4f8a93063e577c8f3efeb250ddbf7d7307340c12 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (si:putprop 'catch 'c1catch 'c1special)
 (si:putprop 'catch 'c2catch 'c2)
index 509d55634079b1970e79fe04808b579d8202da4e..672e80bb98a8f6f721bf25b93ba3657d20a5382c 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (defvar *safe-compile* nil)
 (defvar *compiler-check-args* nil)
       readtable sequence short-float simple-array simple-bit-vector
       simple-string simple-vector single-float standard-char stream string
       dynamic-extent :dynamic-extent
-      string-char symbol t vector signed-byte unsigned-byte)
+      symbol t vector signed-byte unsigned-byte)
      (proclaim-var (car decl) (cdr decl)))
     (otherwise
      (unless (member (car decl) *alien-declarations*)
           (t
            (warn "The variable name ~s is not a symbol." var)))))
 
+(defun mexpand-deftype (tp &aux (l (listp tp))(i (when l (cdr tp)))(tp (if l (car tp) tp)))
+  (when (symbolp tp)
+    (let ((fn (get tp 'si::deftype-definition)))
+      (when fn
+       (apply fn i)))))
+
 (defun c1body (body doc-p &aux (ss nil) (is nil) (ts nil) (others nil)
                     doc form)
   (loop
 ;;; 20040320 CM                
                (cmpck (not (consp decl))
                       "The declaration ~s is illegal." decl)
-               (let* ((dtype (car decl)))
-;; Can process user deftypes here in the future -- 20040318 CM
-;;                    (dft (and (symbolp dtype) (get dtype 'si::deftype-definition)))
-;;                    (dtype (or (and dft (funcall dft)) dtype)))
+               (let* ((dtype (car decl))
+                      (dtype (or (mexpand-deftype dtype) dtype)))
                  (if (consp dtype)
                    (let ((stype (car dtype)))
                      (cmpck (or (not (symbolp stype)) (cdddr dtype)) "The declaration ~s is illegal." decl)
                                 integer keyword list long-float nil null number package pathname
                                 random-state ratio rational readtable sequence simple-array
                                 simple-bit-vector simple-string simple-base-string simple-vector single-float
-                                standard-char stream string string-char symbol t vector
+                                standard-char stream string symbol t vector
                                 signed-byte unsigned-byte)
                         (let ((type (type-filter stype)))
                           (when type
       readtable sequence short-float simple-array simple-bit-vector
       simple-string simple-vector single-float standard-char stream string
       dynamic-extent :dynamic-extent
-      string-char symbol t vector signed-byte unsigned-byte)
+      symbol t vector signed-byte unsigned-byte)
      (let ((type (type-filter (car decl))))
           (dolist** (var (cdr decl) t)
             (if (symbolp var)
index bfefe92478b78cb28c6205d46b070ddd8d319788..ec266c3b4fcb3922e1c9ae0628821bcb3d985816 100755 (executable)
@@ -23,9 +23,9 @@
 
 (export '(si::define-compiler-macro
          si::undef-compiler-macro
-          si::define-inline-function) 'system)
+          si::define-inline-function) :system)
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (si:putprop 'progn 'c1progn 'c1special)
 (si:putprop 'progn 'c2progn 'c2)
                                
 
 (defun result-type-from-args(f args &aux tem)
-  (when (and (setq tem (get f 'return-type))
-             (not (eq tem '*))
-            (not (consp tem)))
+  (when (if (setq tem (get f 'return-type))
+             (and (not (eq tem '*)) (not (consp tem))) t)
     (dolist (v '(inline-always inline-unsafe))
       (dolist (w (get f v))
        (fix-opt w)
 
 (defun c1structure-ref1 (form name index &aux (info (make-info)))
   ;;; Explicitly called from c1expr and c1structure-ref.
-  (declare (special  *aet-types*))
   (cond (*safe-compile* (c1expr `(si::structure-ref ,form ',name ,index)))
-       (t
-  (let* ((sd (get name 'si::s-data))
-        (aet-type (aref (si::s-data-raw sd) index))
-        )
-    (setf (info-type info) (type-filter (aref *aet-types* aet-type)))
-    (list 'structure-ref info
-         (c1expr* form info)
-         (add-symbol name)
-         index sd)
-    
-    ))))
+       ((let* ((sd (get name 'si::s-data))
+               (aet-type (aref (si::s-data-raw sd) index))
+               (sym (find-symbol (si::string-concatenate
+                                  (or (si::s-data-conc-name sd) "")
+                                  (car (nth index (si::s-data-slot-descriptions sd))))))
+               (tp (if sym (get-return-type sym) '*))
+               (tp (type-filter (type-and tp (aref *aet-types* aet-type)))))
+
+          (setf (info-type info) (if (and (eq name 'si::s-data) (= index 2));;FIXME -- this belongs somewhere else.  CM 20050106
+                                     '(vector unsigned-char)
+                                     tp))
+          (list 'structure-ref info
+                (c1expr* form info)
+                (add-symbol name)
+                index sd)))))
 
 (defun coerce-loc-structure-ref (arg type-wanted &aux (form (cdr arg)))
   (let* ((sd (fourth form))
index e9fc44f9bc7cd98d69c60ba6b17c830ee4a62344..ce00ca060b4803d12faf63583f4953695596fdee 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (si:putprop 'flet 'c1flet 'c1special)
 (si:putprop 'flet 'c2flet 'c2)
index 4143af2b9c8aa5e6bef309e0ba021ce54031ffa5..50144a3a84f8da735279810b862a02af1000e70f 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (si:putprop 'princ 'c1princ 'c1)
 (si:putprop 'princ 'c2princ 'c2)
                      (equal (third type) '(*)))))
            (setq tem (si::best-array-element-type
                       (second type)))
-           (cond ((eq tem 'string-char) `(stringp ,x))
+           (cond ((eq tem 'character) `(stringp ,x))
                  ((eq tem 'bit) `(bit-vector-p ,x))
                  ((setq tem (position tem *aet-types*))
                   `(the boolean (vector-type ,x ,tem)))))
 
 
 (defvar *aet-types*
-  #(T STRING-CHAR SIGNED-CHAR FIXNUM SHORT-FLOAT LONG-FLOAT
+  #(T CHARACTER SIGNED-CHAR FIXNUM SHORT-FLOAT LONG-FLOAT
                        SIGNED-CHAR
                        UNSIGNED-CHAR SIGNED-SHORT UNSIGNED-SHORT))
 
 (defun aet-c-type (type)
   (ecase type
     ((t) "object")
-    ((string-char signed-char) "char")
+    ((character signed-char) "char")
     (fixnum "fixnum")
     (unsigned-char "unsigned char")
     (unsigned-short "unsigned short")
index 8c0b100398f5e6bda98f6ffa7c21442f65f6e92b..37633a11d98a11eadd2d7627c516539a798cdaae 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (si:putprop 'if 'c1if 'c1special)
 (si:putprop 'if 'c2if 'c2)
index 21e9257eb8588b2abc9f3d669e56d5b6bec5b368..cdfcbee172b0965d76148a50d006e868951b137d 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 ;;; Pass 1 generates the internal form
 ;;;    ( id  info-object . rest )
index 64811c04a5f7ae82bdc35e50dfa03fe91c0b5017..d66adda60e87786e4d55e15cbc4776bdcc1ddbe8 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (defvar *last-label* 0)
 (defvar *exit*)
index 29d27bf4067d1c13abf99aae9b95254219949c08..2b0b07827bd77b203a018e2d181f0a2e0c2d5e7b 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 ;;; During Pass1, a lambda-list
 ;;;
index 0d244c35999aa61bbd42f88fa0de13b96caa0011..756dd0b26aca0acff9c2007e6475ca9662b049ba 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 (eval-when (compile)
   (or (fboundp 'write-block-open) (load "cmplet.lsp")))
 
index ac761125a0ade7c78a42d320eef340cc96fb7cb1..a5834464efa74206c2e22213f933a9f3e3f3be4f 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (defvar *value-to-go*)
 
index 3e9571ef6436cedb5c8e94f3c3b02ac6cc50ea99..1a72f7f67af2db7524e7266bdc6bb470f3196b73 100755 (executable)
@@ -24,7 +24,7 @@
 ;;;            *****************
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 
 (export '(*compile-print* *compile-verbose*))
 (defvar *cmpinclude* "\"cmpinclude.h\"")
 ;;If the following is a string, then it is inserted instead of
 ;; the include file cmpinclude.h, EXCEPT for system-p calls.
-(defvar *cmpinclude-string* t)
+(defvar *cmpinclude-string* 
+  (si::file-to-string 
+   (namestring
+    (make-pathname :directory (append (pathname-directory si::*system-directory*) (list :parent "h"))
+                  :name "cmpinclude" :type "h"))))
 
 
 ;; Let the user write dump c-file etc to  /dev/null.
index c16448965c204004193480f99d22de64f300d8bb..de5bf78dcf8f5bdb744cd87a749e5d0500654e88 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (si:putprop 'mapcar 'c1mapcar 'c1)
 (si:putprop 'maplist 'c1maplist 'c1)
index 5c9c088871699d609bccb114ac5e818050f830dc..c526b38fc1255a3c59ca4f6704140e6cd75f4b29 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (si:putprop 'multiple-value-call 'c1multiple-value-call 'c1special)
 (si:putprop 'multiple-value-call 'c2multiple-value-call 'c2)
index b6d06495370a5a82a1017a1d92f861ca7178aa79..4b24d00076ed8d1bb6f3f67c3c6a9887a055836b 100755 (executable)
@@ -1,4 +1,4 @@
-(in-package 'compiler)
+(in-package :compiler)
 
 ;; The optimizers have been redone to allow more flags
 ;; The old style optimizations  correspond to the first 2
    (get 'system:aset 'inline-unsafe))
 (push '(((array t) fixnum t) t #.(flags set)"(#0)->v.v_self[#1]= (#2)")
    (get 'system:aset 'inline-unsafe))
-(push '(((array string-char) fixnum character) character #.(flags rfa set)"(#0)->ust.ust_self[#1]= (#2)")
+(push '(((array character) fixnum character) character #.(flags rfa set)"(#0)->ust.ust_self[#1]= (#2)")
    (get 'system:aset 'inline-unsafe))
+(push '(((array bit) fixnum fixnum) fixnum #.(flags rfa)
+       "({object _o=(#0);fixnum _i=(#1)+_o->bv.bv_offset;char _c=1<<BIT_ENDIAN(_i&0x7),*_d=_o->bv.bv_self+(_i>>3);bool _b=(#2);if (_b) *_d|=_c; else *_d&=~_c;_b;})")
+   (get 'si::aset 'inline-unsafe))
 (push '(((array fixnum) fixnum fixnum) fixnum #.(flags set rfa)"(#0)->fixa.fixa_self[#1]= (#2)")
    (get 'system:aset 'inline-unsafe))
 (push '(((array signed-short) fixnum fixnum) fixnum #.(flags rfa set)"((short *)(#0)->ust.ust_self)[#1]=(#2)")
 (push '(((array t) fixnum fixnum t) t #.(flags set)
   "@0;(#0)->a.a_self[(#1)*(#0)->a.a_dims[1]+#2]= (#3)")
    (get 'system:aset 'inline-unsafe))
-(push '(((array string-char) fixnum fixnum character) character
+(push '(((array character) fixnum fixnum character) character
        #.(flags rfa set)
   "@0;(#0)->ust.ust_self[(#1)*(#0)->a.a_dims[1]+#2]= (#3)")
    (get 'system:aset 'inline-unsafe))
    (get 'aref 'inline-unsafe))
 (push '(((array t) fixnum) t #.(flags)"(#0)->v.v_self[#1]")
    (get 'aref 'inline-unsafe))
-(push '(((array string-char) fixnum) character #.(flags rfa)"(#0)->ust.ust_self[#1]")
+(push '(((array character) fixnum) character #.(flags rfa)"(#0)->ust.ust_self[#1]")
+   (get 'aref 'inline-unsafe))
+(push '(((array bit) fixnum) fixnum #.(flags rfa)"({object _o=(#0);fixnum _i=(#1)+(_o)->bv.bv_offset;(_o->bv.bv_self[_i>>3]>>BIT_ENDIAN(_i&0x7))&0x1;})")
    (get 'aref 'inline-unsafe))
 (push '(((array fixnum) fixnum) fixnum #.(flags rfa)"(#0)->fixa.fixa_self[#1]")
    (get 'aref 'inline-unsafe))
 (push '(((array t) fixnum fixnum) t #.(flags )
   "@0;(#0)->a.a_self[(#1)*(#0)->a.a_dims[1]+#2]")
    (get 'aref 'inline-unsafe))
-(push '(((array string-char) fixnum fixnum) character #.(flags rfa)
+(push '(((array character) fixnum fixnum) character #.(flags rfa)
   "@0;(#0)->ust.ust_self[(#1)*(#0)->a.a_dims[1]+#2]")
    (get 'aref 'inline-unsafe))
 (push '(((array fixnum) fixnum fixnum) fixnum #.(flags rfa)
index 7c7d04357b39d00abd7f6001d7e04465e3e4d8c9..5315b22359a8b006e7927c12ef4ef8d40e9b35c0 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (si:putprop 'quote 'c1quote 'c1special)
 (si:putprop 'function 'c1function 'c1special)
index 58ba247399bd2839bac3b9f7b21b2e51b7ab7698..d206f5da552b8579cb5522e44a151d98a6a0a43f 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 (import 'si::switch)
 (import 'si::switch-finish)
 
index cef5c78c1929eb22a4b230fd976871610473dfbf..4381364d58f678ea53ed46b3464a1a4178508f6e 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (defun self-compile ()
  (with-open-file (log "lsplog" :direction :output)
index 6341117fdabd46b9cce7754860eaf21595bf3c5d..db27f85bffc6acbd9f024bfa9cd37e5a106f0bca 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (defvar *objects* (make-hash-table :test 'eq))
 ;(defvar *objects* nil)
 (defun make-inline-string (cfun args fname)
   (if (null args)
       (format nil "~d()" (c-function-name "LI" cfun fname))
-      (let ((o (make-array 100 :element-type 'string-char :fill-pointer 0
+      (let ((o (make-array 100 :element-type 'character :fill-pointer 0
                           :adjustable t )))
            (format o "~d(" (c-function-name "LI" cfun fname))
            (do ((l args (cdr l))
         )))
 
 (defun si::add-debug (fname x)
-  (si::putprop fname x  'si::debug))
+  (si::putprop fname x  'si::debugger))
 
 (defun t3init-fun (fname cfun lambda-expr doc)
 
                         (si::fixnump (cdr (var-ref va))))
                    (setf (nth (cdr (var-ref va)) locals)
                          (var-name va))))
-      (setf (get fname 'si::debug) locals)
-      (let ((locals (get fname 'si::debug)))
+      (setf (get fname 'si::debugger) locals)
+      (let ((locals (get fname 'si::debugger)))
        (if (and locals (or (cdr locals) (not (null (car locals)))))
-           (add-init `(si::debug ',fname ',locals) )
+           (add-init `(debug ',fname ',locals) )
            ))
       ))))
 
        ((and (consp form)
              (symbolp (car form))
              (or (eq (car form) 'setq)
-                 (not (special-form-p (car form))))
+                 (not (special-operator-p (car form))))
              (do ((v (cdr form) (and (consp v) (cdr v)))
                   (i 1 (the fixnum (+ 1 i))))
                  ((or (>= i 1000)
 (setf (get 'si::define-structure 't1) 't1define-structure)
 
 (defun t1define-structure (args)
-  (maybe-eval t `(si::define-structure ,@args ,(not (maybe-eval nil nil))))
+  (maybe-eval t `(si::define-structure ,@(copy-tree args) ,(not (maybe-eval nil nil))));FIXME
   (t1ordinary (cons 'si::define-structure args)))
 
 
     (cond ((stringp s) (push s body))
           ((consp s)
            (cond ((symbolp (car s))
-                  (cmpck (special-form-p (car s))
+                  (cmpck (special-operator-p (car s))
                          "Special form ~s is not allowed in defCfun." (car s))
                   (push (list (cons (car s) (parse-cvspecs (cdr s)))) body))
                  ((and (consp (car s)) (symbolp (caar s))
                                     (not (endp (cddar s)))
                                     (endp (cdr s))
                                     (not (endp (cddr s))))
-                                (special-form-p (caar s)))))
+                                (special-operator-p (caar s)))))
                   (push (cons (cons (caar s)
                                     (if (eq (caar s) 'quote)
                                         (list (add-object (cadar s)))
index ef42161476fc0cf118297df3f882e86e125c1005..dbc5043e029a9e133ae3abd1633eb3312a2b0ff1 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 ;;; CL-TYPE is any valid type specification of Common Lisp.
 ;;;
@@ -51,7 +51,7 @@
   (let ((type (type-of thing)))
     (case type
       ((fixnum short-float long-float) type)
-      ((string-char standard-char character) 'character)
+      ((standard-char character) 'character)
       ((string bit-vector) type)
       (vector (list 'vector (array-element-type thing)))
       (array (list 'array (array-element-type thing)))
@@ -82,7 +82,7 @@
                                (and (consp (caddr type))
                                     (= (length (caddr type)) 1))))
                        (case element-type
-                         (string-char 'string)
+                         (character 'string)
                          (bit 'bit-vector)
                          (t (list 'vector element-type))))
                       (t (list 'array element-type))))
                         ((subtypep type '(vector long-float))
                          '(vector long-float))
                         ((subtypep type '(array t)) '(array t))
-                        ((subtypep type '(array string-char))
-                         '(array string-char))
+                        ((subtypep type '(array character))
+                         '(array character))
                         ((subtypep type '(array bit)) '(array bit))
                         ((subtypep type '(array fixnum)) '(array fixnum))
                         ((subtypep type '(array short-float))
         ((eq type1 t) type2)
        ((eq type2 'object) type1)
         ((eq type2 t) type1)
-        ((consp type1)
+        ((subtypep type2 type1) type2)
+       ((subtypep type1 type2) type1)
+       ((consp type1)
          (case (car type1)
                (array
                 (case (cadr type1)
-                      (string-char (if (eq type2 'string) type2 nil))
+                      (character (if (eq type2 'string) type2 nil))
                       (bit (if (eq type2 'bit-vector) type2 nil))
                       (t (if (and (consp type2)
                                   (eq (car type2) 'vector)
         (t (case type1
                  (string
                   (if (and (consp type2) (eq (car type2) 'array)
-                           (eq (cadr type2) 'string-char))
+                           (eq (cadr type2) 'character))
                       type1 nil))
                  (bit-vector
                   (if (and (consp type2) (eq (car type2) 'array)
index c28d9872ba62df066866e00195cd3e16e4f7a299..dfb6658dcbedf899105b4085c98543376146c3b2 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (export '(*suppress-compiler-warnings*
           *suppress-compiler-notes*
       (do-macro-expansion '(macroexpand-1) form)
     form))
 
-(defun cmp-expand-macro (fd fname args &aux env (form (cons fname args)))
+(defun cmp-expand-macro (fd fname args &aux (form (cons fname args)))
   (if (macro-def-p form)
       (do-macro-expansion `(funcall *macroexpand-hook* ',fd) form)
     form))
 (defun cmp-toplevel-eval (form)
    (let* ((si::*ihs-base* si::*ihs-top*)
           (si::*ihs-top* (1- (si::ihs-top)))
-          (*break-enable* *compiler-break-enable*)
+          (si::*break-enable* *compiler-break-enable*)
           (si::*break-hidden-packages*
            (cons (find-package 'compiler)
                  si::*break-hidden-packages*)))
index 6ab0e24b18db24b06c31b711300ea242cf79749f..33b599771c26822fc7b663e3895d54b89462455c 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (si:putprop 'var 'c2var 'c2)
 (si:putprop 'location 'c2location 'c2)
index 15ef9b1724647c791674ce424202ec7a5052754c..d95b5f84ef1dfaa24ab30271f8fd302446ce8808 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (si:putprop 'vs 'set-vs 'set-loc)
 (si:putprop 'vs 'wt-vs 'wt-loc)
index 1c2d6ee7979cd9008a71771206932010486f1078..660a0f87f529d6e5533c251bee55794b6e5045bc 100755 (executable)
@@ -19,7 +19,7 @@
 ;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (eval-when (compile eval)
   (require 'FASDMACROS "../cmpnew/gcl_fasdmacros.lsp")
index 3f9c7f087b34f34965324eba1fa7748ca9566573..e7c90a4e75869340bcbffaef14c0ed1db5c4fdb7 100755 (executable)
@@ -13,7 +13,7 @@
 ;; Additionally cross reference information about functions in the system is
 ;; collected.
 
-(in-package 'compiler)
+(in-package :compiler)
 (import 'sloop::sloop)
 
 (defstruct fn
index f84ffcf5f50ee51970e63e82a9ebf35531acf807..b70ac3d47a9cebbad4e6b8d31aa112b71332c1f5 100755 (executable)
@@ -3,7 +3,7 @@
 ;; and making the arglists correct if they have optional args.
 ;;
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (DEFSYSFUN 'GENSYM "Lgensym" '(*) 'T NIL NIL) 
 (DEFSYSFUN 'SUBSEQ "Lsubseq" '(T T *) 'T NIL NIL) 
 (DEFSYSFUN 'STRING-NOT-GREATERP "Lstring_not_greaterp" '(T T *) 'T NIL NIL) 
 (DEFSYSFUN 'STRING> "Lstring_g" '(T T *) 'T NIL NIL) 
 (DEFSYSFUN 'FINISH-OUTPUT "Lfinish_output" '(*) 'T NIL NIL) 
-(DEFSYSFUN 'SPECIAL-FORM-P "Lspecial_form_p" '(T) 'T NIL T) 
+(DEFSYSFUN 'SPECIAL-OPERATOR-P "Lspecial_operator_p" '(T) 'T NIL T) 
 (DEFSYSFUN 'STRINGP "Lstringp" '(T) 'T NIL T) 
 (DEFSYSFUN 'GET-INTERNAL-RUN-TIME "Lget_internal_run_time" 'NIL 'T NIL
     NIL) 
 (DEFSYSFUN '= "Lall_the_same" '(T *) 'T NIL T) 
 (DEFSYSFUN 'GENTEMP "Lgentemp" '(*) 'T NIL NIL) 
 (DEFSYSFUN 'RENAME-PACKAGE "Lrename_package" '(T T *) 'T NIL NIL) 
-(DEFSYSFUN 'COMMONP "Lcommonp" '(T) 'T NIL T) 
+(DEFSYSFUN 'COMMONP "siLcommonp" '(T) 'T NIL T) 
 (DEFSYSFUN 'NUMBERP "Lnumberp" '(T) 'T NIL T) 
 (DEFSYSFUN 'COPY-READTABLE "Lcopy_readtable" '(*) 'T NIL NIL) 
 (DEFSYSFUN 'RANDOM-STATE-P "Lrandom_state_p" '(T) 'T NIL T) 
 (DEFSYSFUN 'ASSOC-IF "Lassoc_if" '(T T) 'T NIL NIL) 
 (DEFSYSFUN 'GET-PROPERTIES "Lget_properties" '(T T) '* NIL NIL) 
 (DEFSYSFUN 'STRING<= "Lstring_le" '(T T *) 'T NIL NIL) 
-(DEFSYSFUN 'EVALHOOK "Levalhook" '(T T T *) 'T NIL NIL) 
+(DEFSYSFUN 'EVALHOOK "siLevalhook" '(T T T *) 'T NIL NIL) 
 (DEFSYSFUN 'FILE-WRITE-DATE "Lfile_write_date" '(T) 'T NIL NIL) 
 (DEFSYSFUN 'LOGCOUNT "Llogcount" '(T) 'T NIL NIL) 
 (DEFSYSFUN 'MERGE-PATHNAMES "Lmerge_pathnames" '(T *) 'T NIL NIL) 
index 26bf132d563f93680d14704802df915eb1bc30bd..93865f827b6b2f3f19df7bfc67a3e641facba256 100755 (executable)
 
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (defvar gazonk (make-package 'symbol-table :use nil))
 (defvar eof (cons nil nil))
 (defvar *Ufun-out*)
 
-(defvar *str* (make-array 128 :element-type 'string-char :fill-pointer 0))
+(defvar *str* (make-array 128 :element-type 'character :fill-pointer 0))
 
 (defun make-Ufun (in-files &key (out-file "Ufun_list.lsp"))
   (with-open-file (*Ufun-out* out-file :direction :output)
index 20f1e84f6385c1bbce19f631145e1c5370c6af5b..4544acbf8b0444014a94f1baf2aacdfc268cc5b5 100755 (executable)
@@ -1,6 +1,6 @@
 
 
-(in-package 'compiler)
+(in-package :compiler)
 
 (defvar *cmpinclude-string* nil)
 
@@ -20,4 +20,4 @@
 
       
       
-  
\ No newline at end of file
+  
index 25237c3beeaf1284534cb5b66fb572d0bfb3003c..32afb65b1dfc4c9e2d45a9e48cabfe63724caae3 100755 (executable)
 
-(IN-PACKAGE "COMPILER") 
-(MAPC (LAMBDA (X) (SETF (GET X 'PROCLAIMED-CLOSURE) T))
-      '(CMP-TMP-MACRO COMPILE DISASSEMBLE CMP-ANON)) 
-(PROCLAIM '(FTYPE (FUNCTION (STRING *) T) TS)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T) T) VAR-REP-LOC C1FUNOB C1STRUCTURE-REF
-            T1PROGN GET-RETURN-TYPE ADD-REG1 C1VAR C1ECASE
-            C1SHARP-COMMA C1ASH LTVP CTOP-WRITE C2FUNCTION
-            DECLARATION-TYPE C1TERPRI C1FUNCALL VAR-REGISTER C1ASSOC
-            CONS-TO-LISTA WT-LIST C1NTHCDR-CONDITION
-            C1MULTIPLE-VALUE-CALL CHECK-DOWNWARD TYPE-FILTER
-            C2TAGBODY-LOCAL BLK-NAME C1FSET T1DEFENTRY C1MEMBER
-            C1GETHASH C2GO-CCB SCH-LOCAL-FUN C1RPLACD C1RPLACA-NTHCDR
-            INLINE-POSSIBLE C1MAPC C2VAR WT-FUNCALL-C C1ADD-GLOBALS
-            FUN-NAME SAVE-FUNOB FUN-CFUN PROCLAIM TAG-REF-CCB
-            FIXNUM-LOC-P UNWIND-NO-EXIT WT-H1 MAXARGS C1GO INFO-P TAG-P
-            C1AND INLINE-TYPE VAR-REF-CCB C1MULTIPLE-VALUE-BIND C1THE
-            C2DM-RESERVE-VL WT-DOWNWARD-CLOSURE-MACRO VAR-NAME C1THROW
-            INFO-TYPE C1ASH-CONDITION LTVP-EVAL CHARACTER-LOC-P
-            C2DOWNWARD-FUNCTION C1EXPR C1TAGBODY BLK-REF INFO-VOLATILE
-            VAR-REF CONSTANT-FOLD-P WT-DATA-PACKAGE-OPERATION FUN-P
-            VAR-LOC C1PROGN C1NTHCDR VOLATILE TAG-UNWIND-EXIT
-            REPLACE-CONSTANT NAME-TO-SD SET-TOP C1GET PUSH-ARGS
-            FUN-REF-CCB INLINE-BOOLE3-STRING C1SETQ C1LOCAL-CLOSURE
-            CLINK GET-INCLUDED SET-PUSH-CATCH-FRAME FUNCTION-ARG-TYPES
-            T2DECLARE OBJECT-TYPE CHECK-VREF COPY-INFO
-            T1DEFINE-STRUCTURE C1BOOLE3 FUN-LEVEL C1NTH C2GET FIX-OPT
-            C1OR FUNCTION-RETURN-TYPE T1DEFUN T1CLINES FLAGS-POS
-            SAVE-AVMA WT-DOWN C2GO-CLB C1SWITCH WT-SWITCH-CASE
-            C1FUNCTION C2RPLACD C1LABELS C1MULTIPLE-VALUE-SETQ WT-VV
-            C2TAGBODY-CLB WT-CADR C1MAPCAR MACRO-DEF-P T1DEFMACRO
-            SET-RETURN THE-PARAMETER BLK-REF-CCB AET-C-TYPE
-            PUSH-ARGS-LISPCALL WRITE-BLOCK-OPEN SET-UP-VAR-CVS TAG-VAR
-            INFO-SP-CHANGE ADD-LOOP-REGISTERS C1MULTIPLE-VALUE-PROG1
-            WT-VS C2LOCATION C1COMPILER-LET T3CLINES RESULT-TYPE
-            PROCLAMATION C1MAPL C1PRINC TAG-LABEL C2FUNCALL-AUX BLK-VAR
-            TAG-REF-CLB C2TAGBODY-CCB VERIFY-DATA-VECTOR C1MAPCAN
-            BLK-EXIT WT-VS-BASE REGISTER UNDEFINED-VARIABLE
-            SYSTEM:UNDEF-COMPILER-MACRO C1BLOCK C1MAPLIST
-            ARGS-CAUSE-SIDE-EFFECT C2BIND C1LET WT-SYMBOL-FUNCTION
-            CMP-MACRO-FUNCTION WT1 C1MEMQ BLK-REF-CLB ADD-ADDRESS
-            GET-LOCAL-ARG-TYPES C1UNWIND-PROTECT REP-TYPE ADD-CONSTANT
-            C1IF C1QUOTE C1FMLA-CONSTANT WT-DATA1 NAME-SD1 BLK-P
-            C1CATCH CMP-MACROEXPAND SHORT-FLOAT-LOC-P T3ORDINARY
-            C1LENGTH NEED-TO-SET-VS-POINTERS C1DOWNWARD-FUNCTION C1FLET
-            TAG-SWITCH TAG-REF PARSE-CVSPECS TAG-NAME VAR-P VAR-KIND
-            C1VREF C2GETHASH LONG-FLOAT-LOC-P C1MAPCON C1NTH-CONDITION
-            WT-FUNCTION-LINK WT-VAR-DECL C1STACK-LET ADD-SYMBOL T1DEFLA
-            C2EXPR* C1LOAD-TIME-VALUE C1DM-BAD-KEY C1PROGV FSET-FN-NAME
-            C2VALUES FUN-REF C2VAR-KIND C1PSETQ VARARG-P T1ORDINARY
-            C2GO-LOCAL C1LET* C2DM-RESERVE-V PUSH-DATA-INCF
-            C1DEFINE-STRUCTURE DEFAULT-INIT MDELETE-FILE
-            C1BOOLE-CONDITION C2RPLACA C1VALUES GET-ARG-TYPES WT-CAR
-            FUN-INFO C1DECLARE C1STRUCTURE-SET WT-VS* CMP-MACROEXPAND-1
-            SCH-GLOBAL GET-LOCAL-RETURN-TYPE C1EVAL-WHEN C2TAGBODY-BODY
-            C1APPLY C1LOCAL-FUN C1MACROLET ADD-OBJECT C1RETURN-FROM
-            SAFE-SYSTEM RESET-INFO-TYPE T1DEFCFUN C1RPLACA WT-CDR
-            VAR-TYPE T1MACROLET C1LIST-NTH INFO-CHANGED-ARRAY
-            INFO-REFERRED-ARRAY BLK-VALUE-TO-GO ADD-OBJECT2 WT-CCB-VS)) 
-(PROCLAIM '(FTYPE (FUNCTION (*) *) INLINE-BOOLE3)) 
-(PROCLAIM '(FTYPE (FUNCTION (T) FIXNUM) F-TYPE)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T (VECTOR T) FIXNUM T) FIXNUM) PUSH-ARRAY)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T (VECTOR T) FIXNUM FIXNUM T) FIXNUM)
-            BSEARCHLEQ)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T) *) C2EXPR WT-FIXNUM-LOC WT-LONG-FLOAT-LOC
-            C2OR WT-SHORT-FLOAT-LOC CMP-EVAL C2PROGN WT-TO-STRING
-            SET-LOC CMP-TOPLEVEL-EVAL VV-STR T1EXPR T1EVAL-WHEN WT-LOC
-            C2AND WT-CHARACTER-LOC)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (*) T) FCALLN-INLINE MAKE-BLK MAKE-FUN
-            LIST*-INLINE WT-CLINK COMPILE-FILE C2FSET MAKE-TAG CS-PUSH
-            LIST-INLINE MAKE-VAR COMPILER-COMMAND MAKE-INFO)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (STRING FIXNUM FIXNUM) T) DASH-TO-UNDERSCORE-INT)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T) *) C2COMPILER-LET C2FLET C2LABELS C2IF
-            WT-INLINE)) 
-(PROCLAIM '(FTYPE (FUNCTION (T T *) *) T3DEFUN-AUX)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T) *) C1DM-V C2RETURN-FROM C2DM C1DM-VL
-            C2APPLY-OPTIMIZE)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T) T) C2APPLY C2RETURN-CCB C2BIND-INIT
-            PROCLAIM-VAR PRIN1-CMP C2LAMBDA-EXPR-WITH-KEY
-            SYSTEM::ADD-DEBUG C2LAMBDA-EXPR-WITHOUT-KEY C2STACK-LET
-            MULTIPLE-VALUE-CHECK C1DECL-BODY COMPILER-CC C1EXPR*
-            C2MULTIPLE-VALUE-PROG1 CO1VECTOR-PUSH
-            ARGS-INFO-CHANGED-VARS C2DM-BIND-INIT C1PROGN*
-            CO1WRITE-CHAR COERCE-LOC WT-FIXNUM-VALUE IS-REP-REFERRED
-            C2MULTIPLE-VALUE-CALL CO1SPECIAL-FIX-DECL INLINE-PROC
-            WT-CHARACTER-VALUE SET-VS C2PSETQ T3SHARP-COMMA
-            STRUCT-TYPE-OPT WT-MAKE-DCLOSURE C2DM-BIND-VL SET-JUMP-TRUE
-            DO-MACRO-EXPANSION CO1SCHAR C2BLOCK-CLB
-            C2LIST-NTH-IMMEDIATE C2DM-BIND-LOC WT-LONG-FLOAT-VALUE
-            CO1CONS COMPILER-CLEAR-COMPILER-PROPERTIES C2EXPR-TOP
-            ARGS-INFO-REFERRED-VARS C2MEMBER!2 C2MULTIPLE-VALUE-SETQ
-            C2SETQ ADD-DEBUG-INFO GET-INLINE-LOC RESULT-TYPE-FROM-ARGS
-            C2BIND-LOC CO1STRUCTURE-PREDICATE C1ARGS SHIFT<< UNWIND-BDS
-            MAYBE-EVAL C2UNWIND-PROTECT TYPE-AND C2CALL-LOCAL C2THROW
-            CO1TYPEP SET-BDS-BIND C1SETQ1 C2CATCH TYPE>= C1LAMBDA-FUN
-            NEED-TO-PROTECT C2ASSOC!2 CO1READ-BYTE CO1LDB
-            CONVERT-CASE-TO-SWITCH FAST-READ MAKE-USER-INIT
-            CO1CONSTANT-FOLD C1FMLA CHECK-FNAME-ARGS
-            COERCE-LOC-STRUCTURE-REF WT-SHORT-FLOAT-VALUE C2BLOCK-CCB
-            ADD-INFO CAN-BE-REPLACED CO1READ-CHAR C2CALL-LAMBDA
-            CFAST-WRITE PUSH-CHANGED-VARS SHIFT>> JUMPS-TO-P CO1SUBLIS
-            C1CONSTANT-VALUE C2RETURN-CLB WT-VAR CHECK-END C2EXPR-TOP*
-            WT-V*-MACROS SET-JUMP-FALSE CMPFIX-ARGS SET-DBIND
-            CO1WRITE-BYTE CO1EQL COMPILER-DEF-HOOK WT-REQUIREDS)) 
-(PROCLAIM '(FTYPE (FUNCTION (T *) *) COMPILE-FILE1)) 
-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM FIXNUM) T) MLIN)) 
-(PROCLAIM '(FTYPE (FUNCTION (STRING) T) DASH-TO-UNDERSCORE)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T) FIXNUM) PROCLAIMED-ARGD ANALYZE-REGS1
-            ANALYZE-REGS)) 
-(PROCLAIM '(FTYPE (FUNCTION (T FIXNUM) T) MEMOIZED-HASH-EQUAL)) 
-(PROCLAIM '(FTYPE (FUNCTION ((VECTOR T)) T) COPY-ARRAY)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T) *) C2BLOCK-LOCAL C1SYMBOL-FUN C1BODY
-            C2BLOCK C2DECL-BODY C2RETURN-LOCAL NCONC-FILES
-            WT-INLINE-LOC COMPILER-BUILD)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T *) T) WT-CVAR C1LAMBDA-EXPR UNWIND-EXIT
-            CMPWARN WT-COMMENT WT-INTEGER-LOC CMPERR ADD-INIT
-            FAST-LINK-PROCLAIMED-TYPE-P CMPNOTE C1CASE INIT-NAME)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T) T) T3DEFUN-VARARG C2STRUCTURE-REF
-            C2CALL-UNKNOWN-GLOBAL C1MAKE-VAR C2SWITCH WT-GLOBAL-ENTRY
-            C2CALL-GLOBAL T3INIT-FUN MY-CALL T3DEFUN-NORMAL)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T) T) CJT WT-INLINE-INTEGER CMP-EXPAND-MACRO
-            CHECK-FORM-TYPE SET-VAR C2CASE ADD-FUNCTION-PROCLAMATION
-            INLINE-TYPE-MATCHES T3DEFCFUN C2MAPCAN AND-FORM-TYPE
-            C2PROGV C1DM WT-INLINE-CHARACTER C2MULTIPLE-VALUE-BIND
-            C2FUNCALL-SFUN C2LET MYSUB C-FUNCTION-NAME WT-MAKE-CCLOSURE
-            C2GO WT-INLINE-COND ADD-FAST-LINK C1STRUCTURE-REF1 C2MAPCAR
-            BOOLE3 TOO-FEW-ARGS FIX-DOWN-ARGS COMPILER-PASS2
-            GET-INLINE-INFO C2LET* WT-INLINE-SHORT-FLOAT
-            WT-IF-PROCLAIMED C2PRINC ASSIGN-DOWN-VARS
-            WT-INLINE-LONG-FLOAT C2TAGBODY C1MAP-FUNCTIONS CHECK-VDECL
-            MAKE-INLINE-STRING WT-INLINE-FIXNUM C2MAPC CAN-BE-REPLACED*
-            SUBLIS1-INLINE TOO-MANY-ARGS ADD-FUNCTION-DECLARATION CJF)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T T *) T) T3LOCAL-DCFUN T3LOCAL-FUN)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T T) T) T2DEFUN T3DEFUN C2STRUCTURE-SET
-            C1APPLY-OPTIMIZE T3DEFUN-LOCAL-ENTRY)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T *) T) WT-SIMPLE-CALL GET-OUTPUT-PATHNAME)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T *) T) INLINE-ARGS C2FUNCALL C2LAMBDA-EXPR
-            LINK)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T T T) T) T3DEFMACRO DEFSYSFUN T2DEFENTRY
-            T2DEFMACRO T3DEFENTRY)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION NIL T) WT-DATA-BEGIN PRINT-COMPILER-INFO
-            GAZONK-NAME CCB-VS-PUSH INC-INLINE-BLOCKS
-            PRINT-CURRENT-FORM C1NIL WT-DATA-FILE
-            ADD-LOAD-TIME-SHARP-COMMA CVS-PUSH RESET-TOP WT-CVARS
-            BABOON WT-FASD-DATA-FILE WT-DATA-END INIT-ENV
-            TAIL-RECURSION-POSSIBLE WFS-ERROR C1T VS-PUSH
-            WT-NEXT-VAR-ARG WT-FIRST-VAR-ARG WT-C-PUSH
-            CLOSE-INLINE-BLOCKS)) 
\ No newline at end of file
+(COMMON-LISP::IN-PACKAGE "COMPILER") 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::STRING COMMON-LISP::*)
+             COMMON-LISP::T)
+         COMPILER::TS)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T)
+         COMPILER::C1MULTIPLE-VALUE-BIND COMPILER::C1VALUES
+         COMPILER::C1RPLACA COMPILER::FUN-P
+         COMPILER::FUNCTION-ARG-TYPES COMPILER::C1STRUCTURE-REF
+         COMPILER::GET-RETURN-TYPE COMPILER::WT-FUNCALL-C
+         COMPILER::MACRO-DEF-P COMPILER::T1DEFUN COMPILER::C1ASSOC
+         COMPILER::SET-UP-VAR-CVS COMPILER::C2FUNCTION
+         COMPILER::C1DM-BAD-KEY COMPILER::ADD-OBJECT
+         COMPILER::WT-SWITCH-CASE COMPILER::VARARG-P
+         COMPILER::C1TAGBODY COMPILER::C2GET COMPILER::VAR-REF
+         COMPILER::SCH-LOCAL-FUN COMPILER::ADD-SYMBOL
+         COMPILER::TAG-UNWIND-EXIT COMPILER::C1MULTIPLE-VALUE-SETQ
+         COMPILER::C1PRINC COMPILER::WT-VAR-DECL COMPILER::C1QUOTE
+         COMPILER::C2RPLACD COMPILER::CHECK-VREF
+         COMPILER::PUSH-ARGS-LISPCALL COMPILER::C1MAPLIST
+         COMPILER::ADD-REG1 COMPILER::C1OR COMPILER::WT-SYMBOL-FUNCTION
+         COMPILER::TAG-P COMPILER::SAFE-SYSTEM COMPILER::C1ECASE
+         COMPILER::LTVP COMPILER::GET-INCLUDED COMPILER::INFO-P
+         COMPILER::FUN-INFO COMPILER::C1LOAD-TIME-VALUE
+         COMPILER::GET-LOCAL-ARG-TYPES COMPILER::BLK-P
+         COMPILER::BLK-EXIT COMPILER::C2VAR-KIND COMPILER::C2LOCATION
+         COMPILER::WT1 COMPILER::WT-CCB-VS
+         COMPILER::WT-DOWNWARD-CLOSURE-MACRO COMPILER::BLK-REF-CCB
+         COMPILER::UNDEFINED-VARIABLE COMPILER::C1MULTIPLE-VALUE-CALL
+         COMPILER::VAR-LOC COMPILER::C1SETQ COMPILER::C1NTH-CONDITION
+         COMPILER::C2RPLACA COMPILER::FUN-REF COMPILER::C2VAR
+         COMPILER::WT-CAR COMPILER::WT-LIST COMPILER::WRITE-BLOCK-OPEN
+         COMPILER::INFO-VOLATILE COMPILER::GET-LOCAL-RETURN-TYPE
+         COMPILER::AET-C-TYPE COMPILER::PUSH-ARGS COMPILER::TAG-REF-CLB
+         COMPILER::BLK-REF COMPILER::VAR-P COMPILER::C1ADD-GLOBALS
+         COMPILER::T3ORDINARY COMPILER::ADD-OBJECT2 COMPILER::SET-TOP
+         COMPILER::T1DEFLA COMPILER::C1FUNCTION COMPILER::T3CLINES
+         COMPILER::T1DEFCFUN COMPILER::C1VREF COMPILER::C1ASH
+         COMPILER::BLK-NAME COMPILER::WT-CADR COMPILER::WT-DOWN
+         COMPILER::C1TERPRI COMPILER::C2GETHASH COMPILER::C2GO-CCB
+         COMPILER::SAVE-FUNOB COMPILER::T2DECLARE COMPILER::FUN-REF-CCB
+         COMPILER::C1MAPCAR COMPILER::T1DEFMACRO
+         COMPILER::C2TAGBODY-LOCAL COMPILER::C1STACK-LET
+         COMPILER::INFO-TYPE COMPILER::T1MACROLET COMPILER::C1LET*
+         COMPILER::C1RPLACD COMPILER::DECLARATION-TYPE
+         COMPILER::T1ORDINARY COMPILER::C2EXPR* COMPILER::C1LOCAL-FUN
+         COMPILER::WT-DATA-PACKAGE-OPERATION
+         COMPILER::C1BOOLE-CONDITION SYSTEM::UNDEF-COMPILER-MACRO
+         COMPILER::C2TAGBODY-BODY COMPILER::C1NTHCDR COMPILER::C1VAR
+         COMPILER::C1MULTIPLE-VALUE-PROG1 COMPILER::C1NTHCDR-CONDITION
+         COMPILER::CONSTANT-FOLD-P COMPILER::C1UNWIND-PROTECT
+         COMPILER::PROCLAMATION COMPILER::C1NTH COMPILER::C1RETURN-FROM
+         COMPILER::INFO-SP-CHANGE COMPILER::C1LENGTH
+         COMPILER::CMP-MACRO-FUNCTION COMPILER::BLK-REF-CLB
+         COMPILER::NAME-TO-SD COMPILER::CTOP-WRITE COMPILER::C1MAPCON
+         COMPILER::C1FUNOB COMPILER::FIX-OPT COMPILER::C1RPLACA-NTHCDR
+         COMPILER::C1FLET COMPILER::RESULT-TYPE COMPILER::C1CATCH
+         COMPILER::C2DM-RESERVE-V COMPILER::VAR-NAME
+         COMPILER::CMP-MACROEXPAND COMPILER::VERIFY-DATA-VECTOR
+         COMPILER::T1CLINES COMPILER::C1MAPL COMPILER::T1DEFENTRY
+         COMPILER::TAG-REF-CCB COMPILER::WT-VS
+         COMPILER::LONG-FLOAT-LOC-P COMPILER::C1MAPCAN
+         COMPILER::OBJECT-TYPE COMPILER::ADD-ADDRESS
+         COMPILER::RESET-INFO-TYPE COMPILER::C1BOOLE3 COMPILER::C1MEMQ
+         COMPILER::C1DEFINE-STRUCTURE COMPILER::TYPE-FILTER
+         COMPILER::UNWIND-NO-EXIT COMPILER::C1FMLA-CONSTANT
+         COMPILER::C2DM-RESERVE-VL COMPILER::C1FSET COMPILER::LTVP-EVAL
+         COMPILER::C1GO COMPILER::WT-VV COMPILER::INFO-CHANGED-ARRAY
+         COMPILER::C1FUNCALL COMPILER::C2TAGBODY-CCB
+         COMPILER::TAG-LABEL COMPILER::VAR-KIND COMPILER::WT-VS*
+         COMPILER::VAR-TYPE COMPILER::C2GO-LOCAL COMPILER::REGISTER
+         COMPILER::T1PROGN COMPILER::C1BLOCK COMPILER::TAG-SWITCH
+         COMPILER::VAR-REP-LOC COMPILER::C2BIND
+         COMPILER::SET-PUSH-CATCH-FRAME COMPILER::COPY-INFO
+         COMPILER::C1LIST-NTH COMPILER::CONS-TO-LISTA
+         COMPILER::FUN-LEVEL COMPILER::C1DOWNWARD-FUNCTION
+         COMPILER::THE-PARAMETER COMPILER::C2VALUES COMPILER::C1LABELS
+         COMPILER::MAXARGS COMPILER::VAR-REF-CCB COMPILER::MDELETE-FILE
+         COMPILER::WT-FUNCTION-LINK COMPILER::SAVE-AVMA
+         COMPILER::VOLATILE COMPILER::ADD-CONSTANT COMPILER::C1APPLY
+         COMPILER::C1GETHASH COMPILER::FUN-NAME COMPILER::DEFAULT-INIT
+         COMPILER::CLINK COMPILER::WT-CDR COMPILER::PARSE-CVSPECS
+         COMPILER::REP-TYPE COMPILER::C2GO-CLB
+         COMPILER::ARGS-CAUSE-SIDE-EFFECT COMPILER::PUSH-DATA-INCF
+         COMPILER::SCH-GLOBAL COMPILER::C1STRUCTURE-SET
+         COMPILER::TAG-NAME COMPILER::INFO-REFERRED-ARRAY
+         COMPILER::C1EXPR COMPILER::C1GET COMPILER::BLK-VAR
+         COMPILER::TAG-REF COMPILER::C1MAPC COMPILER::SET-RETURN
+         COMPILER::SHORT-FLOAT-LOC-P COMPILER::C1DECLARE
+         COMPILER::WT-DATA1 COMPILER::FLAGS-POS
+         COMPILER::BLK-VALUE-TO-GO COMPILER::NAME-SD1
+         COMPILER::C2DOWNWARD-FUNCTION COMPILER::C1SHARP-COMMA
+         COMPILER::INLINE-POSSIBLE COMPILER::WT-H1
+         COMPILER::FIXNUM-LOC-P COMPILER::C1LET COMPILER::C1IF
+         COMPILER::C1THE COMPILER::FUNCTION-RETURN-TYPE
+         COMPILER::GET-ARG-TYPES COMPILER::INLINE-TYPE
+         COMPILER::FUN-CFUN COMPILER::TAG-VAR COMPILER::CHARACTER-LOC-P
+         COMPILER::CHECK-DOWNWARD COMPILER::C1PSETQ
+         COMPILER::INLINE-BOOLE3-STRING COMPILER::C1THROW
+         COMPILER::FSET-FN-NAME COMPILER::T1DEFINE-STRUCTURE
+         COMPILER::NEED-TO-SET-VS-POINTERS COMPILER::C1PROGN
+         COMPILER::C2FUNCALL-AUX COMPILER::C1MACROLET COMPILER::C1AND
+         COMPILER::WT-VS-BASE COMPILER::ADD-LOOP-REGISTERS
+         COMPILER::VAR-REGISTER COMPILER::C1PROGV COMPILER::C1SWITCH
+         COMPILER::C1MEMBER COMPILER::C2TAGBODY-CLB
+         COMPILER::CMP-MACROEXPAND-1 COMMON-LISP::PROCLAIM
+         COMPILER::C1ASH-CONDITION COMPILER::C1EVAL-WHEN
+         COMPILER::C1LOCAL-CLOSURE COMPILER::REPLACE-CONSTANT)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*)
+         COMPILER::INLINE-BOOLE3)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T)
+             COMMON-LISP::*)
+         COMPILER::C2DM COMPILER::C1DM-V COMPILER::C1DM-VL
+         COMPILER::C2RETURN-FROM COMPILER::C2APPLY-OPTIMIZE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::*)
+         COMPILER::WT-INLINE COMPILER::C2IF COMPILER::C2LABELS
+         COMPILER::C2FLET)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::*)
+         COMPILER::T3DEFUN-AUX)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM)
+         COMPILER::F-TYPE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::STRING) COMMON-LISP::T)
+         COMPILER::DASH-TO-UNDERSCORE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::T)
+         COMPILER::INIT-NAME COMPILER::ADD-INIT COMPILER::C1LAMBDA-EXPR
+         COMPILER::WT-CVAR COMPILER::C1CASE COMPILER::WT-COMMENT
+         COMPILER::CMPERR COMPILER::WT-INTEGER-LOC COMPILER::CMPNOTE
+         COMPILER::FAST-LINK-PROCLAIMED-TYPE-P COMPILER::UNWIND-EXIT
+         COMPILER::CMPWARN)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::*)
+         COMPILER::C2RETURN-LOCAL COMPILER::C2BLOCK-LOCAL
+         COMPILER::NCONC-FILES COMPILER::C1SYMBOL-FUN COMPILER::C2BLOCK
+         COMPILER::C1BODY COMPILER::COMPILER-BUILD
+         COMPILER::C2DECL-BODY COMPILER::WT-INLINE-LOC)) 
+(COMMON-LISP::MAPC
+    (COMMON-LISP::LAMBDA (COMPILER::X)
+      (COMMON-LISP::SETF
+          (COMMON-LISP::GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE)
+          COMMON-LISP::T))
+    '(COMPILER::CMP-ANON COMMON-LISP::COMPILE COMPILER::CMP-TMP-MACRO
+         COMMON-LISP::DISASSEMBLE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T (COMMON-LISP::VECTOR COMMON-LISP::T)
+                 COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM
+                 COMMON-LISP::T)
+             COMMON-LISP::FIXNUM)
+         COMPILER::BSEARCHLEQ)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T (COMMON-LISP::VECTOR COMMON-LISP::T)
+                 COMMON-LISP::FIXNUM COMMON-LISP::T)
+             COMMON-LISP::FIXNUM)
+         COMPILER::PUSH-ARRAY)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::T)
+         COMPILER::AND-FORM-TYPE COMPILER::SET-VAR COMPILER::C2LET*
+         COMPILER::COMPILER-PASS2 COMPILER::ADD-FUNCTION-DECLARATION
+         COMPILER::BOOLE3 COMPILER::C1MAP-FUNCTIONS
+         COMPILER::TOO-MANY-ARGS COMPILER::CHECK-FORM-TYPE
+         COMPILER::C2LET COMPILER::C-FUNCTION-NAME
+         COMPILER::WT-INLINE-SHORT-FLOAT COMPILER::FIX-DOWN-ARGS
+         COMPILER::C2PRINC COMPILER::WT-IF-PROCLAIMED
+         COMPILER::ADD-FAST-LINK COMPILER::C2MULTIPLE-VALUE-BIND
+         COMPILER::C2MAPCAN COMPILER::CJT COMPILER::CHECK-VDECL
+         COMPILER::INLINE-TYPE-MATCHES COMPILER::WT-INLINE-LONG-FLOAT
+         COMPILER::C2GO COMPILER::CAN-BE-REPLACED* COMPILER::MYSUB
+         COMPILER::ASSIGN-DOWN-VARS COMPILER::C2MAPC
+         COMPILER::WT-INLINE-INTEGER COMPILER::GET-INLINE-INFO
+         COMPILER::CJF COMPILER::TOO-FEW-ARGS COMPILER::T3DEFCFUN
+         COMPILER::CMP-EXPAND-MACRO COMPILER::WT-MAKE-CCLOSURE
+         COMPILER::C2FUNCALL-SFUN COMPILER::C1DM
+         COMPILER::WT-INLINE-COND COMPILER::C2TAGBODY
+         COMPILER::WT-INLINE-CHARACTER COMPILER::C2PROGV
+         COMPILER::C2MAPCAR COMPILER::C1STRUCTURE-REF1 COMPILER::C2CASE
+         COMPILER::ADD-FUNCTION-PROCLAMATION
+         COMPILER::MAKE-INLINE-STRING COMPILER::SUBLIS1-INLINE
+         COMPILER::WT-INLINE-FIXNUM)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::T)
+         COMPILER::C2LAMBDA-EXPR COMPILER::C2FUNCALL COMPILER::LINK
+         COMPILER::INLINE-ARGS)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T)
+             COMMON-LISP::T)
+         COMPILER::C2STRUCTURE-REF COMPILER::WT-GLOBAL-ENTRY
+         COMPILER::T3DEFUN-VARARG COMPILER::T3DEFUN-NORMAL
+         COMPILER::C2CALL-GLOBAL COMPILER::C1MAKE-VAR
+         COMPILER::C2CALL-UNKNOWN-GLOBAL COMPILER::C2SWITCH
+         COMPILER::T3INIT-FUN COMPILER::MY-CALL)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::T)
+         COMPILER::DEFSYSFUN COMPILER::T2DEFMACRO COMPILER::T2DEFENTRY
+         COMPILER::T3DEFMACRO COMPILER::T3DEFENTRY)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::T)
+         COMPILER::T2DEFUN COMPILER::C1APPLY-OPTIMIZE COMPILER::T3DEFUN
+         COMPILER::C2STRUCTURE-SET COMPILER::T3DEFUN-LOCAL-ENTRY)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::*)
+             COMMON-LISP::T)
+         COMPILER::WT-SIMPLE-CALL COMPILER::GET-OUTPUT-PATHNAME)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::T)
+         COMPILER::T3LOCAL-FUN COMPILER::T3LOCAL-DCFUN)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*)
+         COMPILER::C2PROGN COMPILER::WT-LONG-FLOAT-LOC COMPILER::C2EXPR
+         COMPILER::WT-FIXNUM-LOC COMPILER::WT-CHARACTER-LOC
+         COMPILER::C2AND COMPILER::T1EXPR COMPILER::CMP-TOPLEVEL-EVAL
+         COMPILER::WT-SHORT-FLOAT-LOC COMPILER::C2OR COMPILER::WT-LOC
+         COMPILER::CMP-EVAL COMPILER::T1EVAL-WHEN COMPILER::SET-LOC
+         COMPILER::VV-STR COMPILER::WT-TO-STRING)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T)
+         COMPILER::MAKE-FUN COMPILER::MAKE-BLK
+         COMMON-LISP::COMPILE-FILE COMPILER::FCALLN-INLINE
+         COMPILER::MAKE-INFO COMPILER::CS-PUSH COMPILER::MAKE-VAR
+         COMPILER::LIST-INLINE COMPILER::C2FSET COMPILER::WT-CLINK
+         COMPILER::COMPILER-COMMAND COMPILER::MAKE-TAG
+         COMPILER::LIST*-INLINE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION ((COMMON-LISP::VECTOR COMMON-LISP::T))
+             COMMON-LISP::T)
+         COMPILER::COPY-ARRAY)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::T)
+         COMPILER::C2EXPR-TOP COMPILER::CO1SUBLIS
+         COMPILER::C2CALL-LAMBDA COMPILER::GET-INLINE-LOC
+         COMPILER::CHECK-END COMPILER::C2PSETQ COMPILER::TYPE-AND
+         COMPILER::TYPE>= COMPILER::C2MULTIPLE-VALUE-PROG1
+         COMPILER::CO1SCHAR SYSTEM::ADD-DEBUG COMPILER::C2BLOCK-CCB
+         COMPILER::C2DM-BIND-VL COMPILER::MAKE-USER-INIT
+         COMPILER::NEED-TO-PROTECT COMPILER::FAST-READ
+         COMPILER::RESULT-TYPE-FROM-ARGS COMPILER::C2BIND-INIT
+         COMPILER::JUMPS-TO-P COMPILER::C2MEMBER!2
+         COMPILER::C2CALL-LOCAL COMPILER::C2BLOCK-CLB
+         COMPILER::ARGS-INFO-CHANGED-VARS COMPILER::INLINE-PROC
+         COMPILER::C2THROW COMPILER::C1DECL-BODY
+         COMPILER::WT-MAKE-DCLOSURE COMPILER::CO1WRITE-CHAR
+         COMPILER::C1SETQ1 COMPILER::SET-JUMP-FALSE COMPILER::CO1CONS
+         COMPILER::CO1VECTOR-PUSH COMPILER::SET-VS COMPILER::SHIFT>>
+         COMPILER::COERCE-LOC-STRUCTURE-REF COMPILER::WT-FIXNUM-VALUE
+         COMPILER::C2CATCH COMPILER::C2RETURN-CCB COMPILER::MAYBE-EVAL
+         COMPILER::C2ASSOC!2 COMPILER::C2DM-BIND-INIT
+         COMPILER::C2STACK-LET COMPILER::C2LAMBDA-EXPR-WITH-KEY
+         COMPILER::ARGS-INFO-REFERRED-VARS
+         COMPILER::C2MULTIPLE-VALUE-SETQ COMPILER::C1PROGN*
+         COMPILER::WT-LONG-FLOAT-VALUE COMPILER::C2MULTIPLE-VALUE-CALL
+         COMPILER::WT-SHORT-FLOAT-VALUE COMPILER::CO1CONSTANT-FOLD
+         COMPILER::C1CONSTANT-VALUE COMPILER::C1EXPR*
+         COMPILER::CO1SPECIAL-FIX-DECL COMPILER::C2RETURN-CLB
+         COMPILER::CMPFIX-ARGS COMPILER::PROCLAIM-VAR COMPILER::C2APPLY
+         COMPILER::DO-MACRO-EXPANSION COMPILER::CFAST-WRITE
+         COMPILER::PRIN1-CMP COMPILER::SHIFT<< COMPILER::WT-REQUIREDS
+         COMPILER::C2EXPR-TOP* COMPILER::UNWIND-BDS
+         COMPILER::MULTIPLE-VALUE-CHECK COMPILER::COERCE-LOC
+         COMPILER::STRUCT-TYPE-OPT COMPILER::CO1READ-CHAR
+         COMPILER::ADD-DEBUG-INFO COMPILER::C2LIST-NTH-IMMEDIATE
+         COMPILER::WT-VAR COMPILER::C2LAMBDA-EXPR-WITHOUT-KEY
+         COMPILER::CHECK-FNAME-ARGS COMPILER::CAN-BE-REPLACED
+         COMPILER::WT-CHARACTER-VALUE COMPILER::C2UNWIND-PROTECT
+         COMPILER::SET-DBIND COMPILER::T3SHARP-COMMA
+         COMPILER::IS-REP-REFERRED COMPILER::C1FMLA
+         COMPILER::WT-V*-MACROS COMPILER::C2DM-BIND-LOC
+         COMPILER::C2BIND-LOC
+         COMPILER::COMPILER-CLEAR-COMPILER-PROPERTIES
+         COMPILER::ADD-INFO COMPILER::C2SETQ
+         COMPILER::PUSH-CHANGED-VARS COMPILER::CO1STRUCTURE-PREDICATE
+         COMPILER::SET-BDS-BIND COMPILER::SET-JUMP-TRUE
+         COMPILER::CO1READ-BYTE COMPILER::C1LAMBDA-FUN
+         COMPILER::CO1TYPEP COMPILER::CONVERT-CASE-TO-SWITCH
+         COMPILER::COMPILER-DEF-HOOK COMPILER::CO1LDB COMPILER::C1ARGS
+         COMPILER::CO1WRITE-BYTE COMPILER::CO1EQL
+         COMPILER::COMPILER-CC)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM) COMMON-LISP::T)
+         COMPILER::MLIN)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::*)
+         COMPILER::COMPILE-FILE1)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T)
+         COMPILER::WT-DATA-BEGIN COMPILER::WT-C-PUSH COMPILER::WT-CVARS
+         COMPILER::C1T COMPILER::CVS-PUSH COMPILER::WT-DATA-FILE
+         COMPILER::ADD-LOAD-TIME-SHARP-COMMA
+         COMPILER::CLOSE-INLINE-BLOCKS COMPILER::WT-FASD-DATA-FILE
+         COMPILER::GAZONK-NAME COMPILER::WFS-ERROR
+         COMPILER::WT-NEXT-VAR-ARG COMPILER::WT-FIRST-VAR-ARG
+         COMPILER::C1NIL COMPILER::WT-DATA-END COMPILER::RESET-TOP
+         COMPILER::TAIL-RECURSION-POSSIBLE
+         COMPILER::PRINT-COMPILER-INFO COMPILER::CCB-VS-PUSH
+         COMPILER::BABOON COMPILER::INIT-ENV
+         COMPILER::PRINT-CURRENT-FORM COMPILER::VS-PUSH
+         COMPILER::INC-INLINE-BLOCKS)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::FIXNUM)
+             COMMON-LISP::T)
+         COMPILER::MEMOIZED-HASH-EQUAL)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::FIXNUM)
+         COMPILER::PROCLAIMED-ARGD COMPILER::ANALYZE-REGS1
+         COMPILER::ANALYZE-REGS)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::STRING COMMON-LISP::FIXNUM
+                 COMMON-LISP::FIXNUM)
+             COMMON-LISP::T)
+         COMPILER::DASH-TO-UNDERSCORE-INT)) 
\ No newline at end of file
index 6ea12fb8caa007b69f18dc5d81b2a825bfacbf67..00a24b6967e6fcb48eca003b3941bb2f9407cbaa 100755 (executable)
--- a/configure
+++ b/configure
@@ -7569,9 +7569,6 @@ fi
 
 if test "$enable_ansi" = "yes" ; then
        SYSTEM=ansi_gcl
-
-$as_echo "#define ANSI_COMMON_LISP 1" >>confdefs.h
-
        CLSTANDARD=ANSI
 else
        SYSTEM=gcl
index 855ae25f0fda4a31f1d5add996b40681164dc0e8..3c2a2b363ab7c8d344e5e0f8cd38c6bb5ee7a331 100644 (file)
@@ -2112,7 +2112,6 @@ AC_ARG_ENABLE(ansi,[--enable-ansi builds a large gcl aiming for ansi compliance,
 
 if test "$enable_ansi" = "yes" ; then
        SYSTEM=ansi_gcl
-       AC_DEFINE(ANSI_COMMON_LISP,1,[compile ansi compliant image])
        CLSTANDARD=ANSI
 else
        SYSTEM=gcl
index 92b2d7b0d9517c6c23071b83846b16f496911f12..c7272e1acb9c3ff428b27ca5a876ea738d8b7fdb 100644 (file)
@@ -21,3 +21,4 @@
 #define C_GC_OFFSET 4
 
 #define RELOC_H "elf64_i386_reloc.h"
+#define MAX_CODE_ADDRESS (1L<<31)/*large memory model broken gcc 4.8*/
index b55158c92abdba0854937b871d594c1c444e7c44..f87bd9be73b01ddf57ced17c1d97f0ca83f42abe 100755 (executable)
@@ -145,8 +145,8 @@ object simple_lispcall();
 object simple_lispcall_no_event();
 object simple_symlispcall();
 object simple_symlispcall_no_event();
-EXTER object Vevalhook;
-EXTER object Vapplyhook;
+EXTER object siVevalhook;
+EXTER object siVapplyhook;
 object ieval();
 object ifuncall(object,int,...);
 object ifuncall1();
@@ -301,13 +301,13 @@ EXTER object sLquote;
 
 EXTER object sLlambda;
 
-EXTER object sLlambda_block;
-EXTER object sLlambda_closure;
-EXTER object sLlambda_block_closure;
+EXTER object sSlambda_block;
+EXTER object sSlambda_closure;
+EXTER object sSlambda_block_closure;
 
 EXTER object sLfunction;
-EXTER object sLmacro;
-EXTER object sLtag;
+EXTER object sSmacro;
+EXTER object sStag;
 EXTER object sLblock;
 
 
@@ -359,9 +359,6 @@ object shift_integer();
 /*  package.d  */
 EXTER object lisp_package;
 EXTER object user_package;
-#ifdef ANSI_COMMON_LISP
-EXTER object common_lisp_package;
-#endif
 EXTER object keyword_package;
 EXTER object system_package;
 EXTER object sLApackageA;
@@ -565,15 +562,13 @@ EXTER object sSfunction_documentation;
 /*  typespec.c  */
 EXTER object sLcommon,sLnull,sLcons,sLlist,sLsymbol,sLarray,sLvector,sLbit_vector,sLstring;
 EXTER object sLsequence,sLsimple_array,sLsimple_vector,sLsimple_bit_vector,sLsimple_string;
-EXTER object sLcompiled_function,sLpathname,sLcharacter,sLnumber,sLrational,sLfloat,sLstring_char;
+EXTER object sLcompiled_function,sLpathname,sLcharacter,sLnumber,sLrational,sLfloat;
 EXTER object sLinteger,sLreal,sLratio,sLshort_float,sLstandard_char,sLfixnum,sLpositive_fixnum, sLcomplex;
 EXTER object sLsingle_float,sLpackage,sLbignum,sLrandom_state,sLdouble_float,sLstream,sLbit,sLreadtable;
 EXTER object sLlong_float,sLhash_table,sLstructure,sLboolean;
 EXTER object sLdivision_by_zero,sLfloating_point_inexact,sLfloating_point_invalid_operation;
 EXTER object sLfloating_point_overflow,sLfloating_point_underflow;
 
-/* #ifdef ANSI_COMMON_LISP */
-/* new ansi types */
 EXTER object sLarithmetic_error,sLbase_char,sLbase_string,sLbroadcast_stream,sLbuilt_in_class;
 EXTER object sLcell_error,sLclass,sLconcatenated_stream,sLcondition,sLcontrol_error;
 EXTER object sLecho_stream,sLend_of_file,sLerror,sLextended_char,sLfile_error,sLfile_stream;
@@ -584,7 +579,6 @@ EXTER object sLstandard_generic_function,sLstandard_method,sLstandard_object,sLs
 EXTER object sLstream_error,sLstring_stream,sLstructure_class,sLstyle_warning,sLsynonym_stream;
 EXTER object sLtwo_way_stream,sLtype_error,sLunbound_slot,sLunbound_variable,sLundefined_function,sLwarning;
 EXTER object sLmethod_combination,sLstructure_object;
-/* #endif */
 
 EXTER object sLsatisfies;
 EXTER object sLmember;
@@ -595,10 +589,10 @@ EXTER object sLvalues;
 EXTER object sLmod;
 EXTER object sLsigned_byte;
 EXTER object sLunsigned_byte;
-EXTER object sLsigned_char;
-EXTER object sLunsigned_char;
-EXTER object sLsigned_short;
-EXTER object sLunsigned_short;
+EXTER object sSsigned_char;
+EXTER object sSunsigned_char;
+EXTER object sSsigned_short;
+EXTER object sSunsigned_short;
 EXTER object sLA;
 EXTER object sLplusp;
 EXTER object TSor_symbol_string;
index 79318aa30e4e99f9d5e1467764b90ee67331bb8a..d8bcd61ad753c0d6af1662ea9e4bb93d02b128d1 100644 (file)
@@ -114,3 +114,4 @@ stp_ordinary
 SIGNED_CHAR(x)
 FEerror(x,y...)
 FEwrong_type_argument(x,y)
+BIT_ENDIAN(x)
index da0eb478b883d584b327f9f2657822b6e128e3fe..d1c03f65cf2242178f470ed0ea104446538d77dd 100644 (file)
@@ -8,5 +8,6 @@
       add_val(where,~0L,s+a);
       break;
     case R_X86_64_PC32:
+      massert(ovchks(s+a-p,~MASK(32)));                  
       add_val(where,MASK(32),s+a-p);
       break;
diff --git a/h/lu.h b/h/lu.h
index 6c0cc3e0fdebff1093ed06a73b26558e8990513f..cff9f3ef5174b7e690fbaedd8b2bdcd2a4b66aad 100644 (file)
--- a/h/lu.h
+++ b/h/lu.h
@@ -94,12 +94,12 @@ struct symbol {
   object s_dbind;
   void (*s_sfdef) ();
   char *s_self;
+  short s_stype;
+  short s_mflag;
   int s_fillp;
   object s_gfdef;
   object s_plist;
   object s_hpack;
-  short s_stype;
-  short s_mflag;
   SPAD;
 
 };
@@ -142,6 +142,7 @@ struct hashtable {
   int ht_nent;
   int ht_size;
   short ht_test;
+  short ht_static;
   SPAD;
 
 };
@@ -152,10 +153,10 @@ struct array {
   short a_rank;
   short a_elttype;
   object *a_self;
-  short a_adjustable;
-  short a_offset;
   int a_dim;
   int *a_dims;
+  short a_adjustable;
+  short a_offset;
   SPAD;
 
 };
@@ -168,8 +169,8 @@ struct vector {
   short v_hasfillp;
   short v_elttype;
   object *v_self;
-  int v_fillp;
   int v_dim;
+  int v_fillp;
   short v_adjustable;
   short v_offset;
   SPAD;
@@ -181,8 +182,8 @@ struct string {
   short st_hasfillp;
   short st_adjustable;
   char *st_self;
-  int st_fillp;
   int st_dim;
+  int st_fillp;
 };
 
 struct ustring {
@@ -191,8 +192,8 @@ struct ustring {
   short ust_hasfillp;
   short ust_adjustable;
   unsigned char *ust_self;
-  int ust_fillp;
   int ust_dim;
+  int ust_fillp;
 };
 
 struct bitvector {
@@ -201,8 +202,8 @@ struct bitvector {
   short bv_hasfillp;
   short bv_elttype;
   char *bv_self;
-  int bv_fillp;
   int bv_dim;
+  int bv_fillp;
   short bv_adjustable;
   short bv_offset;
   SPAD;
@@ -214,10 +215,10 @@ struct fixarray {
   short fixa_rank;
   short fixa_elttype;
   fixnum *fixa_self;
-  short fixa_adjustable;
-  short fixa_offset;
   int fixa_dim;
   int *fixa_dims;
+  short fixa_adjustable;
+  short fixa_offset;
   SPAD;
 };
 
@@ -227,10 +228,10 @@ struct sfarray {
   short sfa_rank;
   short sfa_elttype;
   shortfloat *sfa_self;
-  short sfa_adjustable;
-  short sfa_offset;
   int sfa_dim;
   int *sfa_dims;
+  short sfa_adjustable;
+  short sfa_offset;
   SPAD;
 };
 
@@ -240,10 +241,10 @@ struct lfarray {
   short lfa_rank;
   short lfa_elttype;
   longfloat *lfa_self;
-  short lfa_adjustable;
-  short lfa_offset;
   int lfa_dim;
   int *lfa_dims;
+  short lfa_adjustable;
+  short lfa_offset;
   SPAD;
 };
 
index 50cdc2a6dfdf85c706b8438a064a5b874b2958c1..3b5bc743cc1f9ea17a13abfdfa937662d7e2d648 100755 (executable)
@@ -22,9 +22,6 @@ void segmentation_catcher();
 EXTER int gc_enabled, saving_system;
 
 EXTER object lisp_package,user_package;
-#ifdef ANSI_COMMON_LISP
-EXTER object common_lisp_package;
-#endif
 EXTER char *core_end;
 EXTER int catch_fatal;
 EXTER long real_maxpage;
@@ -105,6 +102,7 @@ void old(void) \
 #define make_function(a_,b_) make_function_internal(a_,FFN(b_))
 #define make_si_function(a_,b_) make_si_function_internal(a_,FFN(b_))
 #define make_special_form(a_,b_) make_special_form_internal(a_,FFN(b_))
+#define make_si_special_form(a_,b_) make_si_special_form_internal(a_,FFN(b_))
 #define make_si_sfun(a_,b_,c_) make_si_sfun_internal(a_,FFN(b_),c_)
 #define STATD static
 #else
@@ -114,6 +112,7 @@ void old(void) \
 #define make_function(a_,b_) make_function_internal(a_,b_)
 #define make_si_function(a_,b_) make_si_function_internal(a_,b_)
 #define make_special_form(a_,b_) make_special_form_internal(a_,b_)
+#define make_si_special_form(a_,b_) make_si_special_form_internal(a_,b_)
 #define make_si_sfun(a_,b_,c_) make_si_sfun_internal(a_,b_,c_)
 #define STATD
 #endif
index f3c37ee2bb6c073869836217608342e21afab0ab..d2bda443301ab1554ae439c7005743b3b47b3ad0 100755 (executable)
@@ -77,7 +77,7 @@ Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
        Definition of the type of LISP objects.
 */
 typedef union int_object iobject;
-union int_object {object o; fixnum i;};
+union int_object {object *o; fixnum i;};
 
 #define        SMALL_FIXNUM_LIMIT      1024
 
@@ -150,6 +150,12 @@ enum aelttype {                    /*  array element type  */
 #define SET_BV_OFFSET(x,val) ((type_of(x)==t_bitvector ? x->bv.bv_offset = val : \
                       type_of(x)== t_array ? x->a.a_offset=val : (abort(),0)))
 
+#if !defined(DOUBLE_BIGENDIAN)
+#define BIT_ENDIAN(a_) (7-(a_))
+#else
+#define BIT_ENDIAN(a_) (a_)
+#endif
+
 
 #define S_DATA(x) ((struct s_data *)((x)->str.str_self))
 #define SLOT_TYPE(def,i) (((S_DATA(def))->raw->ust.ust_self[i]))
@@ -304,9 +310,9 @@ EXTER struct typemanager tm_table[ 32  /* (int) t_relocatable */];
 /*
        Contiguous block header.
 */
-EXTER bool prefer_low_mem_contblock;
+EXTER ufixnum contblock_lim;
 struct contblock {             /*  contiguous block header  */
-       int     cb_size;        /*  size in bytes  */
+       ufixnum cb_size;        /*  size in bytes  */
        struct contblock
                *cb_link;       /*  contiguous block link  */
 };
@@ -324,7 +330,6 @@ EXTER struct contblock *old_cb_pointer;     /*  old contblock pointer when in SGC  *
 /*
        Variables for memory management.
 */
-EXTER long ncb;                        /*  number of contblocks  */
 #define ncbpage tm_table[t_contiguous].tm_npage
 #define maxcbpage tm_table[t_contiguous].tm_maxpage
 #define cbgbccount tm_table[t_contiguous].tm_gbccount  
@@ -337,15 +342,12 @@ EXTER long holepage;                      /*  hole pages  */
 EXTER long new_holepage,starting_hole_div,starting_relb_heap_mult;
   
 
-#ifdef SGC
-EXTER char *old_rb_start;                      /*  read-only relblock start  */
-#endif
 EXTER char *rb_start;                  /*  relblock start  */
 EXTER char *rb_end;                    /*  relblock end  */
 EXTER char *rb_limit;                  /*  relblock limit  */
 EXTER char *rb_pointer;                /*  relblock pointer  */
-EXTER char *rb_start1;         /*  relblock start in copy space  */
-EXTER char *rb_pointer1;               /*  relblock pointer in copy space  */
+/* EXTER char *rb_start1;              /\*  relblock start in copy space  *\/ */
+/* EXTER char *rb_pointer1;            /\*  relblock pointer in copy space  *\/ */
 
 EXTER char *heap_end;                  /*  heap end  */
 EXTER char *core_end;                  /*  core end  */
index 83aa6c7830fd7c5ba05d6c2205228f9928372a64..ae7990c21f273c1c2c210ded8878f6f647345bf3 100755 (executable)
--- a/h/page.h
+++ b/h/page.h
@@ -21,9 +21,6 @@
 #define PTR_ALIGN SIZEOF_LONG
 #endif
 
-#define ROUND_UP_PTR(n)        (((long)(n) + (PTR_ALIGN-1)) & ~(PTR_ALIGN-1))
-#define ROUND_DOWN_PTR(n) (((long)(n)  & ~(PTR_ALIGN-1)))
-
 /* minimum size required for contiguous pointers */
 #if PTR_ALIGN < SIZEOF_CONTBLOCK
 #define CPTR_SIZE SIZEOF_CONTBLOCK
 #define CPTR_SIZE PTR_ALIGN
 #endif
 
-#define ROUND_UP_PTR_CONT(n)   (((long)(n) + (CPTR_SIZE-1)) & ~(CPTR_SIZE-1))
-#define ROUND_DOWN_PTR_CONT(n) (((long)(n)  & ~(CPTR_SIZE-1)))
-
+#define FLR(x,r) (((x))&~(r-1))
+#define CEI(x,r) FLR((x)+(r-1),r)
+#define PFLR(x,r) ((void *)FLR((ufixnum)x,r))
+#define PCEI(x,r) ((void *)CEI((ufixnum)x,r))
 
 #ifdef SGC
 
 
 #define SGC_WRITABLE  (SGC_PERM_WRITABLE | SGC_PAGE_FLAG)
 
-#define WRITABLE_PAGE_P(p)  IS_WRITABLE(p)
-#define ON_WRITABLE_PAGE(x) WRITABLE_PAGE_P(page(x))
-
-#define  IF_WRITABLE(x,if_code) ({if (IS_WRITABLE(page(x))) {if_code;}})/*FIXME maxpage*/
-
-#define sgc_mark_object(x) IF_WRITABLE(x,if(!is_marked(x)) sgc_mark_object1(x))
-
 /* When not 0, the free lists in the type manager are freelists
    on SGC_PAGE's, for those types supporting sgc.
    Marking and sweeping is done specially */
    
 int sgc_on;
 
+#define SGC_WHOLE_PAGE /* disallow old data on sgc pages*/
 
+#ifndef SGC_WHOLE_PAGE
 /* for the S field of the FIRSTWORD */
 enum sgc_type { SGC_NORMAL,   /* not allocated since the last sgc */
                 SGC_RECENT    /* allocated since last sgc */
                };
-
+#define SGC_OR_M(x)  (!TYPEWORD_TYPE_P(pageinfo(x)->type)  ? pageinfo(x)->sgc_flags&SGC_PAGE_FLAG : ((object)x)->d.s)
+#endif
 
 #define TM_BASE_TYPE_P(i) (tm_table[i].tm_type == i)
 
-/* check if a relblock address is new relblock */
-#define SGC_RELBLOCK_P(x)  ((char *)(x) >= rb_start)
-
 /* is this an sgc cell? encompasses all free cells.  Used where cell cannot yet be marked */
-#define SGC_OR_M(x)  (!TYPEWORD_TYPE_P(pageinfo(x)->type)  ? pageinfo(x)->sgc_flags&SGC_PAGE_FLAG : ((object)x)->d.s)
 
 #ifndef SIGPROTV
 #define SIGPROTV SIGSEGV
@@ -107,28 +97,26 @@ extern fixnum writable_pages;
 
 #define CLEAR_WRITABLE(i) set_writable(i,0)
 #define SET_WRITABLE(i) set_writable(i,1)
-#define IS_WRITABLE(i) is_writable(i)
+#define WRITABLE_PAGE_P(i) is_writable(i)
+#define CACHED_WRITABLE_PAGE_P(i) is_writable_cached(i)
+#define ON_WRITABLE_PAGE(x) WRITABLE_PAGE_P(page(x))
+#define ON_WRITABLE_PAGE_CACHED(x) CACHED_WRITABLE_PAGE_P(page(x))
+
 
 
 EXTER long first_data_page,real_maxpage,phys_pages,available_pages;
-EXTER void *data_start;
+EXTER void *data_start,*initial_sbrk;
 
 #if !defined(IN_MAIN) && defined(SGC)
 #include "writable.h"
 #endif
 
-#ifdef SGC
-#define REAL_RB_START (sgc_enabled ? old_rb_start : rb_start)
-#else
-#define REAL_RB_START rb_start
-#endif
-
 #define CB_BITS     CPTR_SIZE*CHAR_SIZE
 #define ceil(a_,b_) (((a_)+(b_)-1)/(b_))
 #define npage(m_)   ceil(m_,PAGESIZE)
 #define cpage(m_)   ({ufixnum _m=(m_);ceil(sizeof(struct pageinfo)+_m+2*ceil(_m,(CB_BITS-2)),PAGESIZE);})
 #define mbytes(p_)  ceil((p_)*PAGESIZE-sizeof(struct pageinfo),CB_BITS)
-#define tpage(tm_,m_) (tm_->tm_type==t_relocatable ? npage(m_-(rb_limit-rb_pointer)) : (tm_->tm_type==t_contiguous ? cpage(m_) : npage(m_)))
+#define tpage(tm_,m_) (tm_->tm_type==t_relocatable ? npage(m_-(rb_limit-rb_pointer)+1) : (tm_->tm_type==t_contiguous ? cpage(m_) : npage(m_)))
 
 #define CB_DATA_SIZE(z_)   ({fixnum _z=(z_);_z*PAGESIZE-2*mbytes(_z)-sizeof(struct pageinfo);})
 #define CB_MARK_START(pi_) ((void *)(pi_)+sizeof(struct pageinfo))
index 7b45710d0fead104e43ce6964a2b60a3854519a8..7f0eeab15a208901fb12e9d2a3ad2564371fb4bc 100644 (file)
@@ -7,7 +7,7 @@
 /* alloc.c:364:OF */ extern object on_stack_cons (object x, object y); /* (x, y) object x; object y; */
 /* alloc.c:376:OF */ extern object fSallocated (object typ); /* (typ) object typ; */
 /* alloc.c:401:OF */ extern object fSreset_number_used (object typ); /* (typ) object typ; */
-/* alloc.c:480:OF */ extern void insert_contblock (char *p, int s); /* (p, s) char *p; int s; */
+/* alloc.c:480:OF */ extern void insert_contblock (void *p, ufixnum s); /* (p, s) char *p; int s; */
 /* alloc.c:480:OF */ extern void insert_maybe_sgc_contblock (char *p, int s); /* (p, s) char *p; int s; */
 /* alloc.c:611:OF */ extern void set_maxpage (void); /* () */
 /* alloc.c:635:OF */ extern void gcl_init_alloc (void *); /* () */
@@ -124,6 +124,7 @@ struct key {short n,allow_other_keys;
 /* cfun.c:299:OF */ extern object make_si_sfun_internal (char *s, object (*f)(), int argd); /* (s, f, argd) char *s; int (*f)(); int argd; */
 /* cfun.c:322:OF */ extern object make_si_function_internal (char *s, void (*f) ()); /* (s, f) char *s; int (*f)(); */
 /* cfun.c:341:OF */ extern object make_special_form_internal (char *s, void (*f)()); /* (s, f) char *s; int (*f)(); */
+/* cfun.c:341:OF */ extern object make_si_special_form_internal (char *s, void (*f)()); /* (s, f) char *s; int (*f)(); */
 /* cfun.c:352:OF */ extern object fScompiled_function_name (object fun); /* (fun) object fun; */
 /* cfun.c:371:OF */ extern void turbo_closure (object fun); /* (fun) object fun; */
 /* cfun.c:392:OF */ extern object fSturbo_closure (object funobj); /* (funobj) object funobj; */
@@ -467,7 +468,7 @@ typedef void (*funcvoid)(void);
 /* regexp.c:1588:OF */ extern void regerror (char *s); /* (s) char *s; */
 /* regexpr.c:48:OF */ extern object fSmatch_beginning (fixnum i); /* (i) int i; */
 /* regexpr.c:57:OF */ extern object fSmatch_end (fixnum i); /* (i) int i; */
-/* save.c:17:OF */ extern void Lsave (void); /* () */
+/* save.c:17:OF */ extern void siLsave (void); /* () */
 #include <unistd.h>
 /* sbrk.c:9:OF */ /*  extern void * sbrk (int n); */ /* (n) int n; */
 /* strcspn.c:3:OF */ /*  extern size_t strcspn (const char *s1, const char *s2); */ /* (s1, s2) char *s1; char *s2; */
@@ -861,9 +862,6 @@ Lpackage_used_by_list(void);
 void
 Lstandard_char_p(void);
 
-void
-Lstring_char_p(void);
-
 void
 Lchar_code(void);
 
@@ -954,9 +952,6 @@ Lreconc(void);
 void
 Lstandard_char_p(void);
 
-void
-Lstring_char_p(void);
-
 void
 Lcharacter(void);
 
@@ -1405,7 +1400,6 @@ void Lforce_output(void);
 void Lnthcdr(void);
 void Llogior(void);
 void Lchar_downcase(void);
-void Lstring_char_p(void);
 void Lstream_element_type(void);
 void Lpackage_used_by_list(void);
 void Ldivide(void);
@@ -1923,3 +1917,21 @@ rl_stream_p(FILE *f);
 
 void
 sigint(void);
+
+void
+allocate_code_block_reserve(void);
+
+inline void
+resize_hole(ufixnum,enum type);
+
+inline void *
+alloc_contblock_no_gc(size_t);
+
+inline void
+reset_contblock_freelist(void);
+
+inline void
+empty_relblock(void);
+
+fixnum
+check_avail_pages(void);
index aeffcf3e5a1897647ff94d62aa3b5a9e4a65ebcf..8baf2ca5f605b286c33d1833e3a102e8936f97c7 100755 (executable)
@@ -23,6 +23,6 @@ object sLquote;
 
 object sLlambda;
 
-object sLlambda_block;
-object sLlambda_closure;
-object sLlambda_block_closure;
+object sSlambda_block;
+object sSlambda_closure;
+object sSlambda_block_closure;
index 42c68996b23c7330ecf809638f06d27e13c4c5b6..5f17c74d34b29d5fbc9a938fcde877e2c7d462a0 100644 (file)
@@ -1,11 +1,16 @@
+EXTER fixnum last_page;
+EXTER int last_result;
+
 EXTER inline int
-set_writable(fixnum i,fixnum m) {
+set_writable(fixnum i,bool m) {
 
   fixnum j;
   object v;
 
-  if (i<first_data_page || i>=page(core_end))
-    error("out of core in set_writable");
+  last_page=last_result=0;
+
+  if (i<first_data_page || i>=page(heap_end))
+    error("out of heap in set_writable");
 
   if ((v=sSAwritableA ? sSAwritableA->s.s_dbind : Cnil)==Cnil)
     error("no wrimap in set_writable");
@@ -16,13 +21,13 @@ set_writable(fixnum i,fixnum m) {
   if ((void *)wrimap!=(void *)v->v.v_self)
     error("set_writable called in gc");
 
+  writable_pages+=m-((wrimap[j/8]>>(j%8))&0x1);
+
   if (m)
     wrimap[j/8]|=(1<<(j%8));
   else
     wrimap[j/8]&=~(1<<(j%8));
 
-  writable_pages+=m ? 1 : -1;
-
   return 0;
 
 }
@@ -35,13 +40,24 @@ is_writable(fixnum i) {
 
   if (i<first_data_page || i>=page(core_end))
     return 0;
-
+  
   if ((v=sSAwritableA ? sSAwritableA->s.s_dbind : Cnil)==Cnil)
     return 1;
-
+  
   if ((j=i-first_data_page)<0 || j>=v->v.v_dim)
     return 1;
-
+  
   return (wrimap[j/8]>>(j%8))&0x1;
+  
+}
+
+EXTER inline int
+is_writable_cached(fixnum i) {
+
+  if (last_page==i)
+    return last_result;
+
+  last_page=i;
+  return last_result=is_writable(i);
 
 }
index bd0b8d0450f5f736e597e2d045c99e97646d5d16..bb477e8d6db98d38b974a2237f424f23c358287b 100755 (executable)
@@ -8,18 +8,6 @@ List of all the lambda-list keywords used in GCL.
 
 @end defvr
 
-@defun GET-SETF-METHOD (form)
-Package:LISP
-
-Returns the five values (or five 'gangs') constituting the SETF method for
-FORM.  See the doc of DEFINE-SETF-METHOD for the meanings of the gangs.  It
-is an error if the third value (i.e., the list of store variables) is not a
-one-element list.  See the doc of GET-SETF-METHOD-MULTIPLE-VALUE for
-comparison.
-
-
-@end defun
-
 @deffn {Special Form} THE 
 Package:LISP
 
index 135bac8399b0a8feca5726f84f57f58545f24fc4..ff0416e9e57157c90f3c60d806d3f3743d9d2120 100755 (executable)
 ;;;;                            array routines
 
 
-(in-package 'lisp)
-
-
-(export '(make-array array-displacement vector
-          array-element-type array-rank array-dimension
-          array-dimensions
-          array-in-bounds-p array-row-major-index
-          adjustable-array-p
-          bit sbit 
-          bit-and bit-ior bit-xor bit-eqv bit-nand bit-nor
-          bit-andc1 bit-andc2 bit-orc1 bit-orc2 bit-not
-          array-has-fill-pointer-p fill-pointer
-          vector-push vector-push-extend vector-pop
-          adjust-array upgraded-array-element-type))
-
-(in-package 'system)
-
+(in-package :si)
 
 (proclaim '(optimize (safety 2) (space 3)))
 
@@ -47,7 +31,7 @@
   (or (gethash type *baet-hash*)
       (setf (gethash type *baet-hash*)
            (if type
-               (car (member type '(string-char bit signed-char unsigned-char signed-short unsigned-short
+               (car (member type '(character bit signed-char unsigned-char signed-short unsigned-short
                                        fixnum short-float long-float t)
                             :test 'subtypep)) t)))))
         
index 73fa995c4f1a6e852b2f2c8760a2bb365b8adab2..b6e1f6ab1b225ee9bd351ae2abf12a14ba75c1ba 100755 (executable)
@@ -1,4 +1,4 @@
-(in-package 'si)
+(in-package :si)
 ;;; Autoloaders.
 
 
index ec4e01361e9b349e23e5a8c1396782564bbeebd2..c24851b229ca1a15c739860390b0330fd09c9420 100755 (executable)
@@ -1,4 +1,4 @@
-(in-package 'si)
+(in-package :si)
 ;;; Autoloaders.
 
 
@@ -67,8 +67,7 @@
 (autoload 'ftruncate '|gcl_numlib|)
 #-unix (autoload 'get-decoded-time '|gcl_mislib|)
 #+aosvs (autoload 'get-universal-time '|gcl_mislib|)
-(autoload 'get-setf-method '|gcl_setf|)
-(autoload 'get-setf-method-multiple-value '|gcl_setf|)
+(autoload 'get-setf-expansion '|gcl_setf|)
 (autoload 'inspect '|gcl_describe|)
 (autoload 'intersection '|gcl_listlib|)
 (autoload 'isqrt '|gcl_numlib|)
index a604ac10611c3b7d0ae18cc6045aa22a42069c0e..7149ab2b28c510fb8189efe34d679cbc8f62e6c3 100755 (executable)
@@ -21,8 +21,9 @@
 ;;;;    AUTOLOAD
 
 
-;;; Go into LISP.
-(in-package 'lisp)
+(in-package :si)
+
+(export '(clines defentry defcfun object void int double))
 
 ;(defvar *features*)
 
 
 ;;; Allocator.
 
-(import 'si::allocate)
-(export '(allocate
+;(import 'si::allocate)
+;(export '(allocate
          ;allocated-pages maximum-allocatable-pages
           ;allocate-contiguous-pages
           ;allocated-contiguous-pages maximum-contiguous-pages
           ;allocate-relocatable-pages allocated-relocatable-pages 
-          sfun gfun cfun cclosure spice structure))
+;          sfun gfun cfun cclosure spice structure))
 
 ;(defvar type-character-alist
 ;             '((cons . #\.)
             ncbpage maxcbpage (if (zerop cbgbccount) nil cbgbccount) ncb)
     (format t "~9T~D~35Thole~%" holepage)
     (format t "~8D/~D~19T~6,1F%~@[~8D~]~35Trelocatable~%~%"
-            nrbpage maxrbpage (/ rbused 0.01 (+ rbused rbfree))
+            nrbpage maxrbpage (if (zerop (+ rbused rbfree)) 0.0 (/ rbused 0.01 (+ rbused rbfree)))
             (if (zerop rbgbccount) nil rbgbccount))
     (format t "~10D pages for cells~%~%" npage)
     (format t "~10D total pages in core~%" (+ npage ncbpage nrbpage))
     (format t "~10D current core maximum pages~%" (+ maxnpage maxcbpage maxrbpage))
-    (format t "~10D pages reserved for gc~%" maxrbpage)
+    (format t "~10D pages reserved for gc~%" nrbpage)
     (format t "~10D pages available for adding to core~%" leftpage)
     (format t "~10D pages reserved for core exhaustion~%~%" (- maxpage (+ maxnpage maxcbpage (ash maxrbpage 1) leftpage)))
     (format t "~10D maximum pages~%" maxpage)
@@ -411,8 +412,8 @@ Good luck!                           The GCL Development Team")
 (setf (get 'with-output-to-string 'si:pretty-print-format) 1)
 
 
-(in-package 'si)
+(in-package :si)
 
 (defvar *lib-directory* (namestring (truename "../")))
 
-(import '(*lib-directory* *load-path* *system-directory*) 'si::user) 
+(import '(*lib-directory* *load-path* *system-directory*) :user) 
index 5925792a36273bc473ae3086cd1dad66aaeb5122..3f1c7de0d40163643f8a614b1a7aa99d558a042c 100755 (executable)
@@ -1,8 +1,8 @@
 ;;Copyright William F. Schelter 1990, All Rights Reserved 
 
 
-(In-package "SYSTEM")
-(import 'sloop::sloop)
+(In-package :si)
+(import '(sloop::sloop))
 
 (eval-when (compile eval)
   (proclaim '(optimize (safety 2) (space 3)))
@@ -98,7 +98,7 @@
         (cond ((compiled-function-p fun)
                (setq name (compiled-function-name fun)))
               (t (setq name fun)))
-         (if (symbolp name)(setq args (get name 'debug)))
+         (if (symbolp name)(setq args (get name 'debugger)))
         (let ((next (ihs-vs (f + 1 *current-ihs*))))
           (cond (next
                  (format *debug-io* ">> ~a():" name)
 ;; in other common lisps this should be a string output stream.
 
 (defvar *display-string*
-  (make-array 100 :element-type 'string-char :fill-pointer 0 :adjustable t))
+  (make-array 100 :element-type 'character :fill-pointer 0 :adjustable t))
 
 (defun display-env (n env)
   (do ((v (reverse env) (cdr v)))
        (mv-values nil j))
     (let
        ((na  (ihs-fname j)))
-      (cond ((special-form-p na))
+      (cond ((special-operator-p na))
            ((get na 'dbl-invisible))
            ((fboundp na)(return (mv-values na j)))))))
 
                                        (vs (1+ k))
                                        (vs (+ k 2)))
                                  )))))))
-        ((special-form-p na) nil)
+        ((special-operator-p na) nil)
         ((get na 'dbl-invisible))
         ((fboundp na)
          (mv-values i na nil nil
                                      (end (min (ihs-vs (1+ ihs)) (vs-top))))
   (format *display-string* "")
   (do ((i base )
-       (v (get (ihs-fname ihs) 'debug) (cdr v)))
+       (v (get (ihs-fname ihs) 'debugger) (cdr v)))
       ((or (fb >= i end)(fb > (fill-pointer *display-string*) plength)))
     (format *display-string* "~a~@[~d~]=~s~@[,~]"
            (or (car v)  'loc) (if (not (car v)) (f - i base)) (vs i)
index 3e4494c8057be87ec5027b64cc0cacb2a49c8031..6caaaee9a87a80d1acc7a644a403cdc8cbb7ded9 100755 (executable)
 ;;;;         defines SI:DEFMACRO*, the defmacro preprocessor
 
 
-(in-package 'lisp)
-(export '(&whole &environment &body))
-
-
-(in-package 'system)
+(in-package :si)
 
 
 (eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
index 011b29349bcbda38e47a2cb588d343cdcec541af..8b429e899772a8a664b0d663b5d26cd0d815ea69 100755 (executable)
 ;;;;        The structure routines.
 
 
-(in-package 'lisp)
-(export 'defstruct)
-
-
-(in-package 'system)
+(in-package :si)
 
 
 (proclaim '(optimize (safety 2) (space 3)))
 
 
 
-;(in-package 'system)
-
-
-
 (defvar *accessors* (make-array 10 :adjustable t))
 (defvar *list-accessors* (make-array 2 :adjustable t))
 (defvar *vector-accessors* (make-array 2 :adjustable t))
                      (setq dont-overwrite t)
                      )
                     (t  (setf (get access-function 'structure-access)
-                              (cons (if type type name) offset)))))))
+                              (cons (if type type name) offset))
+                        (when slot-type
+                          (proclaim `(ftype (function (,name) ,slot-type) ,access-function)))
+                        )))))
     nil))
 
 
         ;bootstrapping code!
         (setq def (make-s-data-structure
                     (make-array (* leng (size-of t))
-                                :element-type 'string-char :static t)
+                                :element-type 'character :static t)
                     (make-t-type leng nil slot-descriptions)
                     *standard-slot-positions*
                     slot-descriptions
              (setf (symbol-function predicate)
                    #'(lambda (x)
                        (si::structure-subtype-p x name))))
-         (setf (get predicate 'compiler::co1)
-               'compiler::co1structure-predicate)
-         (setf (get predicate 'struct-predicate) name)
+         (proclaim `(ftype (function (,name) t) ,predicate));FIXME boolean is unboxed
          )
   ) nil)
 
index 01faf92b3ab558381a70ba4002f51e6ea4ac6ba8..2c94e385d802ac9e189846b440a719b15c30fcbc 100755 (executable)
 ;;;;                           DESCRIBE and INSPECT
 
 
-(in-package 'lisp)
-
-(export '(describe inspect))
-
-
-(in-package 'system)
+(in-package :si)
 
 
 (proclaim '(optimize (safety 2) (space 3)))
 (defun inspect-character (character)
   (format t
           (cond ((standard-char-p character) "~S - standard character")
-                ((string-char-p character) "~S - string character")
                 (t "~S - character"))
           character)
   (inspect-print "code:  #x~X" (char-code character))
                (find-package "SYSTEM")
                *package*)))
 
-    (cond ((special-form-p symbol)
+    (cond ((special-operator-p symbol)
            (doc1 (or (documentation symbol 'function) "")
                  (if (macro-function symbol)
                      "[Special form and Macro]"
index a5e36bd00ce02d62cd50d7a90ec8906863dbc71a..f8b9963d8f12225d3f77946191200fc72ca989ef 100644 (file)
@@ -8,9 +8,7 @@
 ;;; in DEFMACRO are the reason this isn't as easy as it sounds.
 ;;;
 
-(in-package 'lisp)
-
-(export '(destructuring-bind))
+(in-package :si)
 
 (defvar *arg-tests* ()
   "A list of tests that do argument counting at expansion time.")
index 7693a531bfeabee910c1f264ef458d0238186cfd..d1176b6fee093ea7eac12cf5745d7c175b2285dc 100755 (executable)
@@ -13,7 +13,7 @@
        for w in-package v
        when  (setq doc (documentation w 'function))
        do (format st "\1fF~a~%~ain ~a package:~a" w
-                  (cond ((special-form-p w) "Special Form ")
+                  (cond ((special-operator-p w) "Special Form ")
                         ((functionp w) "Function ")
                         ((macro-function w) "Macro ")
                         (t ""))
index dc824f0ddaa52e0381a5ed8091003199d330b416..545b697b72b9d893c11f532e90bea28967310b64 100755 (executable)
 ;;;;   evalmacros.lsp
 
 
-(in-package "LISP")
-
-(export '(defvar defparameter defconstant))
-
-(in-package "SYSTEM")
+(in-package :si)
 
 
 (eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
index def21658403104fc87f67fddfe36a7869830a677..4b21c8d9a8b4c9bcbc53bdf7b35da3595fc1ebd6 100755 (executable)
 ;;;;
 ;;;;                    Exporting external symbols of LISP package
 
-
-(in-package 'lisp)
-
+(in-package :common-lisp)
 
 (export '(
-
-&whole
-&environment
-&body
-*
-**
-***
-*break-enable*
-*break-on-warnings*
-*features*
-*modules*
-+
-++
-+++
--
-/
-//
-///
-COMMON
-KYOTO
-KCL
-abs
-acos
-acosh
-adjust-array
-adjustable-array-p
-apropos
-apropos-list
-array-dimension
-array-dimensions
-array-element-type
-array-has-fill-pointer-p
-array-in-bounds-p
-array-rank
-array-row-major-index
-asin
-asinh
-assert
-atanh
-bit
-bit-and
-bit-andc1
-bit-andc2
-bit-eqv
-bit-ior
-bit-nand
-bit-nor
-bit-not
-bit-orc1
-bit-orc2
-bit-xor
-break
-byte
-byte-position
-byte-size
-ccase
-cerror
-check-type
-cis
-coerce
-compile
-compile-file
-concatenate
-cosh
-count
-count-if
-count-if-not
-ctypecase
-decf
-declaim
-decode-universal-time
-defconstant
-define-modify-macro
-define-setf-method
-defparameter
-defsetf
-defstruct
-deftype
-defvar
-delete
-delete-duplicates
-delete-if
-delete-if-not
-deposit-field
-describe
-disassemble
-do*
-do-all-symbols
-do-external-symbols
-do-symbols
-documentation
-dolist
-dotimes
-dpb
-dribble
-ecase
-ed
-eighth
-encode-universal-time
-error
-etypecase
-eval-when
-every
-fceiling
-ffloor
-fifth
-fill
-fill-pointer
-find
-find-all-symbols
-find-if
-find-if-not
-first
-format
-fourth
-fround
-ftruncate
-get-decoded-time
-get-setf-method
-get-setf-method-multiple-value
-get-universal-time
-getf
-ignore
-ignorable
-incf
-inspect
-intersection
-isqrt
-ldb
-ldb-test
-lisp-implementation-type
-logandc1
-logandc2
-lognand
-lognor
-lognot
-logorc1
-logorc2
-logtest
-long-site-name
-machine-instance
-machine-type
-machine-version
-make-array
-make-sequence
-map
-mask-field
-merge
-mismatch
-mod
-multiple-value-setq
-nintersection
-ninth
-notany
-notevery
-nset-difference
-nset-exclusive-or
-nsubstitute
-nsubstitute-if
-nsubstitute-if-not
-nunion
-phase
-pop
-position
-position-if
-position-if-not
-prin1-to-string
-princ-to-string
-prog*
-provide
-psetf
-push
-pushnew
-rational
-rationalize
-real
-read-from-string
-reduce
-rem
-remf
-remove
-remove-duplicates
-remove-if
-remove-if-not
-replace
-require
-rotatef
-room
-sbit
-search
-second
-set-difference
-set-exclusive-or
-setf
-seventh
-shiftf
-short-site-name
-signum
-sinh
-sixth
-software-type
-software-version
-some
-sort
-stable-sort
-step
-structure
-subsetp
-substitute
-substitute-if
-substitute-if-not
-subtypep
-tanh
-tenth
-third
-time
-trace
-type
-typecase
-typep
-union
-untrace
-variable
-vector
-vector-pop
-vector-push
-vector-push-extend
-warn
-with-input-from-string
-with-open-file
-with-open-stream
-with-output-to-string
-write-to-string
-y-or-n-p
-yes-or-no-p
-
-proclaim
-proclamation
-special
-type
-ftype
-function
-inline
-notinline
-ignore
-optimize
-speed
-space
-safety
-compilation-speed
-declaration
-
-*eval-when-compile*
-
-clines
-defcfun
-defentry
-defla
-
-void
-object
-char
-int
-float
-double
-
-define-compiler-macro
-compiler-macro
-compiler-macro-function
-
-with-compilation-unit
-with-standard-io-syntax
-*print-lines*
-*print-miser-width*
-*print-pprint-dispatch*
-*print-right-margin*
-
-*read-eval*
-
-dynamic-extent
-
-loop
-check-type assert typecase etypecase ctypecase case ecase ccase
-
-restart-bind restart-case with-condition-restarts muffle-warning continue abort
-                      store-value use-value
-                      restart restart-name restart-function restart-report-function
-                      restart-interactive-function restart-test-function
-                      compute-restarts find-restart invoke-restart invoke-restart-interactively
-                      with-simple-restart signal
-
-simple-condition simple-error simple-warning invoke-debugger *debugger-hook* *break-on-signals*
-
-handler-case handler-bind ignore-errors define-condition make-condition
-         condition warning serious-condition simple-condition-format-control simple-condition-format-arguments
-         storage-condition stack-overflow storage-exhausted type-error
-         type-error-datum type-error-expected-type simple-type-error
-         program-error control-error stream-error stream-error-stream
-         end-of-file file-error file-error-pathname cell-error cell-error-name
-         unbound-variable undefined-function arithmetic-error
-         arithmetic-error-operation arithmetic-error-operands
-         package-error package-error-package
-         division-by-zero floating-point-overflow floating-point-underflow
-
-))
+       &allow-other-keys            *print-miser-width*          
+       &aux                         *print-pprint-dispatch*      
+       &body                        *print-pretty*               
+       &environment                 *print-radix*                
+       &key                         *print-readably*             
+       &optional                    *print-right-margin*         
+       &rest                        *query-io*                   
+       &whole                       *random-state*               
+       *                            *read-base*                  
+       **                           *read-default-float-format*  
+       ***                          *read-eval*                  
+       *break-on-signals*           *read-suppress*              
+       *compile-file-pathname*      *readtable*                  
+       *compile-file-truename*      *standard-input*             
+       *compile-print*              *standard-output*            
+       *compile-verbose*            *terminal-io*                
+       *debug-io*                   *trace-output*               
+       *debugger-hook*              +                            
+       *default-pathname-defaults*  ++                           
+       *error-output*               +++                          
+       *features*                   -                            
+       *gensym-counter*             /                            
+       *load-pathname*              //                           
+       *load-print*                 ///                          
+       *load-truename*              /=                           
+       *load-verbose*               1+                           
+       *macroexpand-hook*           1-                           
+       *modules*                    <                            
+       *package*                    <=                           
+       *print-array*                =                            
+       *print-base*                 >                            
+       *print-case*                 >=                           
+       *print-circle*               abort                        
+       *print-escape*               abs                          
+       *print-gensym*               acons                        
+       *print-length*               acos                         
+       *print-level*                acosh                        
+       *print-lines*                add-method                   
+       
+       adjoin                      atom          boundp                    
+       adjust-array                base-char     break                     
+       adjustable-array-p          base-string   broadcast-stream          
+       allocate-instance           bignum        broadcast-stream-streams  
+       alpha-char-p                bit           built-in-class            
+       alphanumericp               bit-and       butlast                   
+       and                         bit-andc1     byte                      
+       append                      bit-andc2     byte-position             
+       apply                       bit-eqv       byte-size                 
+       apropos                     bit-ior       caaaar                    
+       apropos-list                bit-nand      caaadr                    
+       aref                        bit-nor       caaar                     
+       arithmetic-error            bit-not       caadar                    
+       arithmetic-error-operands   bit-orc1      caaddr                    
+       arithmetic-error-operation  bit-orc2      caadr                     
+       array                       bit-vector    caar                      
+       array-dimension             bit-vector-p  cadaar                    
+       array-dimension-limit       bit-xor       cadadr                    
+       array-dimensions            block         cadar                     
+       array-displacement          boole         caddar                    
+       array-element-type          boole-1       cadddr                    
+       array-has-fill-pointer-p    boole-2       caddr                     
+       array-in-bounds-p           boole-and     cadr                      
+       array-rank                  boole-andc1   call-arguments-limit      
+       array-rank-limit            boole-andc2   call-method               
+       array-row-major-index       boole-c1      call-next-method          
+       array-total-size            boole-c2      car                       
+       array-total-size-limit      boole-clr     case                      
+       arrayp                      boole-eqv     catch                     
+       ash                         boole-ior     ccase                     
+       asin                        boole-nand    cdaaar                    
+       asinh                       boole-nor     cdaadr                    
+       assert                      boole-orc1    cdaar                     
+       assoc                       boole-orc2    cdadar                    
+       assoc-if                    boole-set     cdaddr                    
+       assoc-if-not                boole-xor     cdadr                     
+       atan                        boolean       cdar                      
+       atanh                       both-case-p   cddaar                    
+       
+       cddadr             clear-input                  copy-tree                  
+       cddar              clear-output                 cos                        
+       cdddar             close                        cosh                       
+       cddddr             clrhash                      count                      
+       cdddr              code-char                    count-if                   
+       cddr               coerce                       count-if-not               
+       cdr                compilation-speed            ctypecase                  
+       ceiling            compile                      debug                      
+       cell-error         compile-file                 decf                       
+       cell-error-name    compile-file-pathname        declaim                    
+       cerror             compiled-function            declaration                
+       change-class       compiled-function-p          declare                    
+       char               compiler-macro               decode-float               
+       char-code          compiler-macro-function      decode-universal-time      
+       char-code-limit    complement                   defclass                   
+       char-downcase      complex                      defconstant                
+       char-equal         complexp                     defgeneric                 
+       char-greaterp      compute-applicable-methods   define-compiler-macro      
+       char-int           compute-restarts             define-condition           
+       char-lessp         concatenate                  define-method-combination  
+       char-name          concatenated-stream          define-modify-macro        
+       char-not-equal     concatenated-stream-streams  define-setf-expander       
+       char-not-greaterp  cond                         define-symbol-macro        
+       char-not-lessp     condition                    defmacro                   
+       char-upcase        conjugate                    defmethod                  
+       char/=             cons                         defpackage                 
+       char<              consp                        defparameter               
+       char<=             constantly                   defsetf                    
+       char=              constantp                    defstruct                  
+       char>              continue                     deftype                    
+       char>=             control-error                defun                      
+       character          copy-alist                   defvar                     
+       characterp         copy-list                    delete                     
+       check-type         copy-pprint-dispatch         delete-duplicates          
+       cis                copy-readtable               delete-file                
+       class              copy-seq                     delete-if                  
+       class-name         copy-structure               delete-if-not              
+       class-of           copy-symbol                  delete-package             
+       
+       denominator                    eq                   
+       deposit-field                  eql                  
+       describe                       equal                
+       describe-object                equalp               
+       destructuring-bind             error                
+       digit-char                     etypecase            
+       digit-char-p                   eval                 
+       directory                      eval-when            
+       directory-namestring           evenp                
+       disassemble                    every                
+       division-by-zero               exp                  
+       do                             export               
+       do*                            expt                 
+       do-all-symbols                 extended-char        
+       do-external-symbols            fboundp              
+       do-symbols                     fceiling             
+       documentation                  fdefinition          
+       dolist                         ffloor               
+       dotimes                        fifth                
+       double-float                   file-author          
+       double-float-epsilon           file-error           
+       double-float-negative-epsilon  file-error-pathname  
+       dpb                            file-length          
+       dribble                        file-namestring      
+       dynamic-extent                 file-position        
+       ecase                          file-stream          
+       echo-stream                    file-string-length   
+       echo-stream-input-stream       file-write-date      
+       echo-stream-output-stream      fill                 
+       ed                             fill-pointer         
+       eighth                         find                 
+       elt                            find-all-symbols     
+       encode-universal-time          find-class           
+       end-of-file                    find-if              
+       endp                           find-if-not          
+       enough-namestring              find-method          
+       ensure-directories-exist       find-package         
+       ensure-generic-function        find-restart         
+       
+       find-symbol                       get-internal-run-time        
+       finish-output                     get-macro-character          
+       first                             get-output-stream-string     
+       fixnum                            get-properties               
+       flet                              get-setf-expansion           
+       float                             get-universal-time           
+       float-digits                      getf                         
+       float-precision                   gethash                      
+       float-radix                       go                           
+       float-sign                        graphic-char-p               
+       floating-point-inexact            handler-bind                 
+       floating-point-invalid-operation  handler-case                 
+       floating-point-overflow           hash-table                   
+       floating-point-underflow          hash-table-count             
+       floatp                            hash-table-p                 
+       floor                             hash-table-rehash-size       
+       fmakunbound                       hash-table-rehash-threshold  
+       force-output                      hash-table-size              
+       format                            hash-table-test              
+       formatter                         host-namestring              
+       fourth                            identity                     
+       fresh-line                        if                           
+       fround                            ignorable                    
+       ftruncate                         ignore                       
+       ftype                             ignore-errors                
+       funcall                           imagpart                     
+       function                          import                       
+       function-keywords                 in-package                   
+       function-lambda-expression        incf                         
+       functionp                         initialize-instance          
+       gcd                               inline                       
+       generic-function                  input-stream-p               
+       gensym                            inspect                      
+       gentemp                           integer                      
+       get                               integer-decode-float         
+       get-decoded-time                  integer-length               
+       get-dispatch-macro-character      integerp                     
+       get-internal-real-time            interactive-stream-p         
+       
+       intern                                  lisp-implementation-type            
+       internal-time-units-per-second          lisp-implementation-version         
+       intersection                            list                                
+       invalid-method-error                    list*                               
+       invoke-debugger                         list-all-packages                   
+       invoke-restart                          list-length                         
+       invoke-restart-interactively            listen                              
+       isqrt                                   listp                               
+       keyword                                 load                                
+       keywordp                                load-logical-pathname-translations  
+       labels                                  load-time-value                     
+       lambda                                  locally                             
+       lambda-list-keywords                    log                                 
+       lambda-parameters-limit                 logand                              
+       last                                    logandc1                            
+       lcm                                     logandc2                            
+       ldb                                     logbitp                             
+       ldb-test                                logcount                            
+       ldiff                                   logeqv                              
+       least-negative-double-float             logical-pathname                    
+       least-negative-long-float               logical-pathname-translations       
+       least-negative-normalized-double-float  logior                              
+       least-negative-normalized-long-float    lognand                             
+       least-negative-normalized-short-float   lognor                              
+       least-negative-normalized-single-float  lognot                              
+       least-negative-short-float              logorc1                             
+       least-negative-single-float             logorc2                             
+       least-positive-double-float             logtest                             
+       least-positive-long-float               logxor                              
+       least-positive-normalized-double-float  long-float                          
+       least-positive-normalized-long-float    long-float-epsilon                  
+       least-positive-normalized-short-float   long-float-negative-epsilon         
+       least-positive-normalized-single-float  long-site-name                      
+       least-positive-short-float              loop                                
+       least-positive-single-float             loop-finish                         
+       length                                  lower-case-p                        
+       let                                     machine-instance                    
+       let*                                    machine-type                        
+       
+       machine-version                mask-field                  
+       macro-function                 max                         
+       macroexpand                    member                      
+       macroexpand-1                  member-if                   
+       macrolet                       member-if-not               
+       make-array                     merge                       
+       make-broadcast-stream          merge-pathnames             
+       make-concatenated-stream       method                      
+       make-condition                 method-combination          
+       make-dispatch-macro-character  method-combination-error    
+       make-echo-stream               method-qualifiers           
+       make-hash-table                min                         
+       make-instance                  minusp                      
+       make-instances-obsolete        mismatch                    
+       make-list                      mod                         
+       make-load-form                 most-negative-double-float  
+       make-load-form-saving-slots    most-negative-fixnum        
+       make-method                    most-negative-long-float    
+       make-package                   most-negative-short-float   
+       make-pathname                  most-negative-single-float  
+       make-random-state              most-positive-double-float  
+       make-sequence                  most-positive-fixnum        
+       make-string                    most-positive-long-float    
+       make-string-input-stream       most-positive-short-float   
+       make-string-output-stream      most-positive-single-float  
+       make-symbol                    muffle-warning              
+       make-synonym-stream            multiple-value-bind         
+       make-two-way-stream            multiple-value-call         
+       makunbound                     multiple-value-list         
+       map                            multiple-value-prog1        
+       map-into                       multiple-value-setq         
+       mapc                           multiple-values-limit       
+       mapcan                         name-char                   
+       mapcar                         namestring                  
+       mapcon                         nbutlast                    
+       maphash                        nconc                       
+       mapl                           next-method-p               
+       maplist                        nil                         
+       
+       nintersection         package-error                  
+       ninth                 package-error-package          
+       no-applicable-method  package-name                   
+       no-next-method        package-nicknames              
+       not                   package-shadowing-symbols      
+       notany                package-use-list               
+       notevery              package-used-by-list           
+       notinline             packagep                       
+       nreconc               pairlis                        
+       nreverse              parse-error                    
+       nset-difference       parse-integer                  
+       nset-exclusive-or     parse-namestring               
+       nstring-capitalize    pathname                       
+       nstring-downcase      pathname-device                
+       nstring-upcase        pathname-directory             
+       nsublis               pathname-host                  
+       nsubst                pathname-match-p               
+       nsubst-if             pathname-name                  
+       nsubst-if-not         pathname-type                  
+       nsubstitute           pathname-version               
+       nsubstitute-if        pathnamep                      
+       nsubstitute-if-not    peek-char                      
+       nth                   phase                          
+       nth-value             pi                             
+       nthcdr                plusp                          
+       null                  pop                            
+       number                position                       
+       numberp               position-if                    
+       numerator             position-if-not                
+       nunion                pprint                         
+       oddp                  pprint-dispatch                
+       open                  pprint-exit-if-list-exhausted  
+       open-stream-p         pprint-fill                    
+       optimize              pprint-indent                  
+       or                    pprint-linear                  
+       otherwise             pprint-logical-block           
+       output-stream-p       pprint-newline                 
+       package               pprint-pop                     
+       
+       pprint-tab                 read-char                   
+       pprint-tabular             read-char-no-hang           
+       prin1                      read-delimited-list         
+       prin1-to-string            read-from-string            
+       princ                      read-line                   
+       princ-to-string            read-preserving-whitespace  
+       print                      read-sequence               
+       print-not-readable         reader-error                
+       print-not-readable-object  readtable                   
+       print-object               readtable-case              
+       print-unreadable-object    readtablep                  
+       probe-file                 real                        
+       proclaim                   realp                       
+       prog                       realpart                    
+       prog*                      reduce                      
+       prog1                      reinitialize-instance       
+       prog2                      rem                         
+       progn                      remf                        
+       program-error              remhash                     
+       progv                      remove                      
+       provide                    remove-duplicates           
+       psetf                      remove-if                   
+       psetq                      remove-if-not               
+       push                       remove-method               
+       pushnew                    remprop                     
+       quote                      rename-file                 
+       random                     rename-package              
+       random-state               replace                     
+       random-state-p             require                     
+       rassoc                     rest                        
+       rassoc-if                  restart                     
+       rassoc-if-not              restart-bind                
+       ratio                      restart-case                
+       rational                   restart-name                
+       rationalize                return                      
+       rationalp                  return-from                 
+       read                       revappend                   
+       read-byte                  reverse                     
+       
+       room                          simple-bit-vector                  
+       rotatef                       simple-bit-vector-p                
+       round                         simple-condition                   
+       row-major-aref                simple-condition-format-arguments  
+       rplaca                        simple-condition-format-control    
+       rplacd                        simple-error                       
+       safety                        simple-string                      
+       satisfies                     simple-string-p                    
+       sbit                          simple-type-error                  
+       scale-float                   simple-vector                      
+       schar                         simple-vector-p                    
+       search                        simple-warning                     
+       second                        sin                                
+       sequence                      single-float                       
+       serious-condition             single-float-epsilon               
+       set                           single-float-negative-epsilon      
+       set-difference                sinh                               
+       set-dispatch-macro-character  sixth                              
+       set-exclusive-or              sleep                              
+       set-macro-character           slot-boundp                        
+       set-pprint-dispatch           slot-exists-p                      
+       set-syntax-from-char          slot-makunbound                    
+       setf                          slot-missing                       
+       setq                          slot-unbound                       
+       seventh                       slot-value                         
+       shadow                        software-type                      
+       shadowing-import              software-version                   
+       shared-initialize             some                               
+       shiftf                        sort                               
+       short-float                   space                              
+       short-float-epsilon           special                            
+       short-float-negative-epsilon  special-operator-p                 
+       short-site-name               speed                              
+       signal                        sqrt                               
+       signed-byte                   stable-sort                        
+       signum                        standard                           
+       simple-array                  standard-char                      
+       simple-base-string            standard-char-p                    
+       
+       standard-class             sublis                      
+       standard-generic-function  subseq                      
+       standard-method            subsetp                     
+       standard-object            subst                       
+       step                       subst-if                    
+       storage-condition          subst-if-not                
+       store-value                substitute                  
+       stream                     substitute-if               
+       stream-element-type        substitute-if-not           
+       stream-error               subtypep                    
+       stream-error-stream        svref                       
+       stream-external-format     sxhash                      
+       streamp                    symbol                      
+       string                     symbol-function             
+       string-capitalize          symbol-macrolet             
+       string-downcase            symbol-name                 
+       string-equal               symbol-package              
+       string-greaterp            symbol-plist                
+       string-left-trim           symbol-value                
+       string-lessp               symbolp                     
+       string-not-equal           synonym-stream              
+       string-not-greaterp        synonym-stream-symbol       
+       string-not-lessp           t                           
+       string-right-trim          tagbody                     
+       string-stream              tailp                       
+       string-trim                tan                         
+       string-upcase              tanh                        
+       string/=                   tenth                       
+       string<                    terpri                      
+       string<=                   the                         
+       string=                    third                       
+       string>                    throw                       
+       string>=                   time                        
+       stringp                    trace                       
+       structure                  translate-logical-pathname  
+       structure-class            translate-pathname          
+       structure-object           tree-equal                  
+       style-warning              truename                    
+       
+       truncate                             values-list               
+       two-way-stream                       variable                  
+       two-way-stream-input-stream          vector                    
+       two-way-stream-output-stream         vector-pop                
+       type                                 vector-push               
+       type-error                           vector-push-extend        
+       type-error-datum                     vectorp                   
+       type-error-expected-type             warn                      
+       type-of                              warning                   
+       typecase                             when                      
+       typep                                wild-pathname-p           
+       unbound-slot                         with-accessors            
+       unbound-slot-instance                with-compilation-unit     
+       unbound-variable                     with-condition-restarts   
+       undefined-function                   with-hash-table-iterator  
+       unexport                             with-input-from-string    
+       unintern                             with-open-file            
+       union                                with-open-stream          
+       unless                               with-output-to-string     
+       unread-char                          with-package-iterator     
+       unsigned-byte                        with-simple-restart       
+       untrace                              with-slots                
+       unuse-package                        with-standard-io-syntax   
+       unwind-protect                       write                     
+       update-instance-for-different-class  write-byte                
+       update-instance-for-redefined-class  write-char                
+       upgraded-array-element-type          write-line                
+       upgraded-complex-part-type           write-sequence            
+       upper-case-p                         write-string              
+       use-package                          write-to-string           
+       use-value                            y-or-n-p                  
+       user-homedir-pathname                yes-or-no-p               
+       values                               zerop))
index 44a37c3817ddeb3864cdd9530363943f48b37e21..0f1d277b52aa9bd330f06081bcd229e7ae2d7902 100644 (file)
@@ -1,8 +1,8 @@
-(in-package :fpe :use '(:lisp))
+(in-package :fpe)
 
 (import 'si::(disassemble-instruction feenableexcept fedisableexcept fld *fixnum *float *double
                                      +fe-list+ +mc-context-offsets+ floating-point-error 
-                                     function-by-address))
+                                     function-by-address clines defentry))
 (export '(break-on-floating-point-exceptions read-instruction))
 
 (eval-when
index 7c146d96907090a78ab5c8ce5b06962e0c793cce..4204b8b8a7016501dbcf488238d178818c09b7d3 100755 (executable)
@@ -1,4 +1,4 @@
-(in-package "SI"  )
+(in-package :si)
 
 (eval-when (compile eval)
 (defmacro while (test &body body)
@@ -11,7 +11,7 @@
 (eval-when (compile eval load)
 (defun sharp-u-reader (stream subchar arg)
   subchar arg
-  (let ((tem (make-array 10 :element-type 'string-char :fill-pointer 0)))
+  (let ((tem (make-array 10 :element-type 'character :fill-pointer 0)))
     (or (eql (read-char stream) #\")
        (error "sharp-u-reader reader needs a \" right after it"))
     (loop
@@ -44,7 +44,7 @@
    (or (and (<= 0 start ) (<= start len))
        (error "illegal file start ~a" start))
    (let ((tem (make-array (- len start)
-                         :element-type 'string-char)))
+                         :element-type 'character)))
      (if (> start 0) (file-position st start))
      (si::fread tem 0 (length tem) st) tem)))
 
             ((> extra 0)
              (setq tem 
                    (make-array (f + (length x) extra)
-                               :element-type 'string-char :fill-pointer 0))
+                               :element-type 'character :fill-pointer 0))
              (setq i 0)
              (go AGAIN))
             (t (setq tem x)))
index b2be57fc6cb65a80968f9a4bc0f8d371c083bd4b..2c1caea635748a21d463e5623b6685c401f54dd8 100755 (executable)
 ;;;;        The IO library.
 
 
-(in-package 'lisp)
-
-
-(export '(with-open-stream with-input-from-string with-output-to-string 
-                          ensure-directories-exist wild-pathname-p
-                          read-byte write-byte read-sequence write-sequence))
-(export '(read-from-string))
-(export '(write-to-string prin1-to-string princ-to-string))
-(export 'with-open-file)
-(export '(y-or-n-p yes-or-no-p))
-(export 'dribble)
-
-
-(in-package 'system)
-
+(in-package :si)
 
 (proclaim '(optimize (safety 2) (space 3)))
 
index 128442bbb5186393e8996a74de66f09fec16747e..88143b73da817f1040ad03b7dd9fbf7e6010d596 100755 (executable)
 ; rather than recursion, as needed for large data sets.
 
 
-(in-package 'lisp)
-
-(export '(union nunion intersection nintersection
-          set-difference nset-difference set-exclusive-or nset-exclusive-or
-          subsetp nth nth-value nthcdr first second third fourth fifth sixth seventh eighth ninth tenth))
-
-(in-package 'system)
+(in-package :si)
 
 (eval-when (compile)
   (proclaim '(optimize (safety 0) (space 3)))
index 4bffc774a2756b52833be1aa5dfc0430fa090630..08e2e05a942f7f5a8a9c8baa766e634df0ed10a7 100755 (executable)
 ;;;; This file is IMPLEMENTATION-DEPENDENT.
 
 
-(in-package 'lisp)
-
-
-(export 'time)
-(export '(reset-sys-paths decode-universal-time encode-universal-time compile-file-pathname complement constantly))
-
-
-(in-package 'system)
-
+(in-package :si)
 
 (proclaim '(optimize (safety 2) (space 3)))
 
   (let ((real-start (gensym)) (real-end (gensym)) (gbc-time-start (gensym))
        (gbc-time (gensym)) (x (gensym)) (run-start (gensym)) (run-end (gensym))
        (child-run-start (gensym)) (child-run-end (gensym)))
-  `(let (,real-start ,real-end (,gbc-time-start (si::gbc-time)) ,gbc-time ,x)
+  `(let (,real-start ,real-end (,gbc-time-start (gbc-time)) ,gbc-time ,x)
      (setq ,real-start (get-internal-real-time))
      (multiple-value-bind (,run-start ,child-run-start) (get-internal-run-time)
-       (si::gbc-time 0)
+       (gbc-time 0)
        (setq ,x (multiple-value-list ,form))
-       (setq ,gbc-time (si::gbc-time))
-       (si::gbc-time (+ ,gbc-time-start ,gbc-time))
+       (setq ,gbc-time (gbc-time))
+       (gbc-time (+ ,gbc-time-start ,gbc-time))
        (multiple-value-bind (,run-end ,child-run-end) (get-internal-run-time)
         (setq ,real-end (get-internal-real-time))
         (fresh-line *trace-output*)
@@ -139,7 +131,7 @@ x))
            *gcl-major-version* *gcl-minor-version* *gcl-extra-version*
            (if (member :ansi-cl *features*) "ANSI" "CLtL1")
            (if (member :gprof *features*) "profiling" "")
-           (si::gcl-compile-time)
+           (gcl-compile-time)
            "Source License: LGPL(gcl,gmp), GPL(unexec,bfd,xgcl)"
            "Binary License: "
            (if gpled-modules (format nil "GPL due to GPL'ed components: ~a" gpled-modules)
@@ -150,13 +142,13 @@ x))
 
  (defun lisp-implementation-version nil
    (format nil "GCL ~a.~a.~a"
-          si::*gcl-major-version*
-          si::*gcl-minor-version*
-          si::*gcl-extra-version*))
+          *gcl-major-version*
+          *gcl-minor-version*
+          *gcl-extra-version*))
 
 (defun objlt (x y)
   (declare (object x y))
-  (let ((x (si::address x)) (y (si::address y)))
+  (let ((x (address x)) (y (address y)))
     (declare (fixnum x y))
     (if (< y 0)
        (if (< x 0) (< x y) t)
@@ -164,10 +156,10 @@ x))
 
 (defun reset-sys-paths (s)
   (declare (string s))
-  (setq si::*lib-directory* s)
-  (setq si::*system-directory* (si::string-concatenate s "unixport/"))
+  (setq *lib-directory* s)
+  (setq *system-directory* (string-concatenate s "unixport/"))
   (let (nl)
     (dolist (l '("cmpnew/" "gcl-tk/" "lsp/" "xgcl-2/"))
-      (push (si::string-concatenate s l) nl))
-    (setq si::*load-path* nl))
+      (push (string-concatenate s l) nl))
+    (setq *load-path* nl))
   nil)
index 63d122a93abe01727ae1c43d29eabcd99f7b403b..579591621188edcd3e0033e7f8f33fb515c67ad1 100755 (executable)
 ;;;;                            module routines
 
 
-(in-package 'lisp)
-
-(export '(*modules* provide require))
-(export 'documentation)
-(export '(variable function structure type setf))
-
-(in-package 'system)
+(in-package :si)
 
 
 (eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
index a8375f507c4983812b1efac30229ea46186d16d3..cafc2f2c55fca3664bea590cff6009c33b2113b1 100755 (executable)
 ;;;;                           number routines
 
 
-(in-package 'lisp)
-(export
- '(isqrt abs phase signum cis asin acos sinh cosh tanh
-   asinh acosh atanh
-   rational rationalize
-   ffloor fround ftruncate fceiling
-   lognand lognor logandc1 logandc2 logorc1 logorc2
-   lognot logtest
-   byte byte-size byte-position
-   ldb ldb-test mask-field dpb deposit-field
-   ))
-
-
-(in-package 'system)
+(in-package :si)
 
 
 (proclaim '(optimize (safety 2) (space 3)))
index e70f487b505e278fb8ebebc8062d2ca3d96a98d6..84198718ecda5a551aea190765d1abc28deb1073 100755 (executable)
 ;;;;                    package routines
 
 
-(in-package 'lisp)
-
-
-(export '(find-all-symbols do-symbols do-external-symbols do-all-symbols with-package-iterator))
-(export '(apropos apropos-list))
-
-
-(in-package 'system)
+(in-package :si)
 
 
 (proclaim '(optimize (safety 2) (space 3)))
 (defun print-symbol-apropos (symbol)
   (prin1 symbol)
   (when (fboundp symbol)
-        (if (special-form-p symbol)
+        (if (special-operator-p symbol)
             (princ "  Special form")
             (if (macro-function symbol)
                 (princ "  Macro")
index 146a6bc80dccb183c8b3f64ef27d999201ce5556..106089030e83cb10dfc942c996c95f22c95f3879 100755 (executable)
@@ -22,9 +22,7 @@
 ;;;;                              predicate routines
 
 
-(in-package 'system)
-
-(export '(lisp::deftype lisp::typep lisp::subtypep lisp::coerce) 'lisp)
+(in-package :si)
 
 (eval-when (compile)
 (proclaim '(optimize (safety 2) (space 3)))
@@ -87,7 +85,7 @@
 (deftype vector (&optional element-type size)
   `(array ,element-type (,size)))
 (deftype string (&optional size)
-  `(vector string-char ,size))
+  `(vector character ,size))
 (deftype base-string (&optional size)
   `(vector base-char ,size))
 (deftype bit-vector (&optional size)
@@ -96,7 +94,7 @@
 (deftype simple-vector (&optional size)
   `(simple-array t (,size)))
 (deftype simple-string (&optional size)
-  `(simple-array string-char (,size)))
+  `(simple-array character (,size)))
 (deftype simple-base-string (&optional size)
   `(simple-array base-char (,size)))
 (deftype simple-bit-vector (&optional size)
     (ratio (eq (type-of object) 'ratio))
     (standard-char
      (and (characterp object) (standard-char-p object)))
-    ((base-char string-char)
-     (and (characterp object) (string-char-p object)))
+    ((base-char character)
+     (characterp object))
     (integer
      (and (integerp object) (in-interval-p object i)))
     (rational
                      signed-char unsigned-char signed-short unsigned-short
                      number integer bignum rational ratio float method-combination
                      short-float single-float double-float long-float complex
-                     character standard-char string-char real 
+                     character standard-char character real 
                      package stream pathname readtable hash-table random-state
                      structure array simple-array function compiled-function
                      arithmetic-error base-char base-string broadcast-stream 
                       (if (sub-interval-p '(* *) i2) (values t t) (values nil t)))
                      (t (values nil ntp2))))
                   (standard-char
-           (if (member t2 '(base-char string-char character))
+           (if (member t2 '(base-char character character))
                (values t t)
                (values nil ntp2)))
                   (base-char
-           (if (member t2 '(character string-char))
+           (if (member t2 '(character character))
                (values t t)
                (values nil ntp2)))
                   (extended-char
-           (if (member t2 '(character string-char))
+           (if (member t2 '(character character))
                (values t t)
                (values nil ntp2)))
-          (string-char
+          (character
            (if (eq t2 'character)
                (values t t)
                (values nil ntp2)))
           (character
-           (if (eq t2 'string-char)
+           (if (eq t2 'character)
                (values t t)
                (values nil ntp2)))
           (integer
                               (unless (or (equal (car i1) (car i2))
                                           ; FIXME
                                           (and (eq (car i1) 'base-char)
-                                               (eq (car i2) 'string-char)))
+                                               (eq (car i2) 'character)))
                                       ;; Unless the element type matches,
                                       ;;  return NIL T.
                                       ;; Is this too strict?
                               (unless (or (equal (car i1) (car i2))
                                           ; FIXME
                                           (and (eq (car i1) 'base-char)
-                                               (eq (car i2) 'string-char)))
+                                               (eq (car i2) 'character)))
                                       (return-from subtypep
                                                    (values nil t)))))
                   (when (or (endp (cdr i1)) (eq (cadr i1) '*))
index abb8d4f4c087a1a6f85476ff9ebefbc478323bc1..166ae10a10f060b342d8274565aeddc01d0ddd40 100755 (executable)
@@ -1,5 +1,5 @@
 
-(in-package 'si)
+(in-package :si)
 (use-package "SLOOP")
 
 ;; Sample Usage:
index 6a9c2e8e1bd98d94e4732278aa547b17bdd5820a..6ce5aa2eb80d4e9529d51caa499e4d9d4f32476d 100755 (executable)
 ;;;;                           sequence routines
 
 
-(in-package 'lisp)
-
-(export '(make-sequence concatenate map some every notany notevery))
-
-(in-package 'system)
+(in-package :si)
 
 
 (proclaim '(optimize (safety 2) (space 3)))
@@ -40,7 +36,7 @@
                 (if iesp
                     (make-list size :initial-element initial-element)
                     (make-list size))))
-              ((or (eq type 'simple-string) (eq type 'string)) 'string-char)
+              ((or (eq type 'simple-string) (eq type 'string)) 'character)
               ((or (eq type 'simple-bit-vector) (eq type 'bit-vector)) 'bit)
               ((or (eq type 'simple-vector) (eq type 'vector)) t)
               (t
index c2b41c9372af8fdba14bd634ba458cfe0bbe6104..4cc6a1ca3c098899544cd79b8f2aaefefbdb3677 100755 (executable)
 ;;;;                           sequence routines
 
 
-(in-package 'lisp)
-
-
-(export '(reduce fill replace
-          remove remove-if remove-if-not
-          delete delete-if delete-if-not
-          count count-if count-if-not
-          substitute substitute-if substitute-if-not
-          nsubstitute nsubstitute-if nsubstitute-if-not
-          find find-if find-if-not
-          position position-if position-if-not
-          remove-duplicates delete-duplicates
-          mismatch search
-         with-hash-table-iterator
-          sort stable-sort merge map-into))
-
-
-(in-package 'system)
+(in-package :si)
 
 
 (proclaim '(optimize (safety 2) (space 3)))
index 0181f80214da6cb456e1b4b03f48fb8aced84056..5c110a8afaa4481bae4d4c6bd36eb907c39b1b68 100755 (executable)
             args))))
        ("unknown error")))
 
+(defvar *break-on-warnings* nil)
+
 (defun warn (datum &rest arguments)
   (declare (optimize (safety 2)))
   (let ((c (process-error datum arguments 'simple-warning)))
index 9ada67915c99d344748b7daf653b2a594d722372..26ce547d982305cbddb7348407c7434b3f69bc88 100755 (executable)
 ;;;;                                setf routines
 
 
-(in-package 'lisp)
-
-
-(export '(setf psetf shiftf rotatef
-          define-modify-macro defsetf
-          getf remf incf decf push pushnew pop
-          define-setf-method get-setf-method get-setf-method-multiple-value))
-
-
-(in-package 'system)
+(in-package :si)
 
 
 (eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
           ',access-fn))
 
 
-;;; GET-SETF-METHOD.
+;;; GET-SETF-EXPANSION.
 ;;; It just calls GET-SETF-METHOD-MULTIPLE-VALUE
 ;;;  and checks the number of the store variable.
-(defun get-setf-method (form &optional env)
+(defun get-setf-expansion (form &optional env)
   (multiple-value-bind (vars vals stores store-form access-form)
       (get-setf-method-multiple-value form env)
     (unless (= (list-length stores) 1)
 
 (define-setf-method getf (&environment env place indicator &optional default)
   (multiple-value-bind (vars vals stores store-form access-form)
-      (get-setf-method place env)
+      (get-setf-expansion place env)
     (let ((itemp (gensym)) (store (gensym)))
       (values `(,@vars ,itemp)
               `(,@vals ,indicator)
 
 (define-setf-method the (&environment env type form)
   (multiple-value-bind (vars vals stores store-form access-form)
-      (get-setf-method form env)
+      (get-setf-expansion form env)
     (let ((store (gensym)))
       (values vars vals (list store)
              `(let ((,(car stores) (the ,type ,store))) ,store-form)
               (null (cddr fn)))
          (error "Can't get the setf-method of ~S." fn))
   (multiple-value-bind (vars vals stores store-form access-form)
-      (get-setf-method (cons (cadr fn) rest) env)
+      (get-setf-expansion (cons (cadr fn) rest) env)
     (unless (eq (car (last store-form)) (car (last vars)))
             (error "Can't get the setf-method of ~S." fn))
     (values vars vals stores
                (null (cddr fn)))
     (error "Can't get the setf-method of ~S." fn))
   (multiple-value-bind (vars vals stores store-form access-form)
-      (get-setf-method (cons (cadr fn) rest) env)
+      (get-setf-expansion (cons (cadr fn) rest) env)
     (cond ((eq (car (last store-form)) (car (last vars)))
            (values vars vals stores
                    `(apply #',(car store-form) ,@(cdr store-form))
 
 (define-setf-method char-bit (&environment env char name)
   (multiple-value-bind (temps vals stores store-form access-form)
-      (get-setf-method char env)
+      (get-setf-expansion char env)
     (let ((ntemp (gensym))
          (store (gensym))
          (stemp (first stores)))
 
 (define-setf-method ldb (&environment env bytespec int)
   (multiple-value-bind (temps vals stores store-form access-form)
-      (get-setf-method int env)
+      (get-setf-expansion int env)
     (let ((btemp (gensym))
          (store (gensym))
          (stemp (first stores)))
 
 (define-setf-method mask-field (&environment env bytespec int)
   (multiple-value-bind (temps vals stores store-form access-form)
-      (get-setf-method int env)
+      (get-setf-expansion int env)
     (let ((btemp (gensym))
          (store (gensym))
          (stemp (first stores)))
           (setf-structure-access (cadr place) (car g) (cdr g) newvalue))))
             
   (multiple-value-bind (vars vals stores store-form access-form)
-      (get-setf-method place env)
+      (get-setf-expansion place env)
     (declare (ignore access-form))
     `(let* ,(mapcar #'list
                    (append vars stores)
                 nil))
           (when (endp (cdr r)) (error "~S is an illegal PSETF form." rest))
           (multiple-value-bind (vars vals stores store-form access-form)
-              (get-setf-method (car r) env)
+              (get-setf-expansion (car r) env)
              (declare (ignore access-form))
             (setq store-forms (cons store-form store-forms))
             (setq pairs
            ,@store-forms
            ,g))
     (multiple-value-bind (vars vals stores1 store-form access-form)
-       (get-setf-method (car r) env)
+       (get-setf-expansion (car r) env)
       (setq pairs (nconc pairs (mapcar #'list vars vals)))
       (setq stores (cons (car stores1) stores))
       (setq store-forms (cons store-form store-forms))
            nil
            ))
     (multiple-value-bind (vars vals stores1 store-form access-form)
-       (get-setf-method (car r) env)
+       (get-setf-expansion (car r) env)
       (setq pairs (nconc pairs (mapcar #'list vars vals)))
       (setq stores (cons (car stores1) stores))
       (setq store-forms (cons store-form store-forms))
                (let ((access-form reference))
                  (list 'setq reference ,update-form))))
        (multiple-value-bind (vars vals stores store-form access-form)
-          (get-setf-method reference env)
+          (get-setf-expansion reference env)
          (list 'let*
               (mapcar #'list
                       (append vars stores)
 
 (defmacro remf (&environment env place indicator)
   (multiple-value-bind (vars vals stores store-form access-form)
-      (get-setf-method place env)
+      (get-setf-expansion place env)
     `(let* ,(mapcar #'list vars vals)
        (multiple-value-bind (,(car stores) flag)
            (si:rem-f ,access-form ,indicator)
       (return-from push `(let* ((,myitem ,item))
                           (setq ,place (cons ,myitem ,place)))))
     (multiple-value-bind (vars vals stores store-form access-form)
-                        (get-setf-method place env)
+                        (get-setf-expansion place env)
                         `(let* ,(mapcar #'list
                                         (append (list myitem) vars stores)
                                         (append (list   item) vals (list (list 'cons myitem access-form))))
           (return-from pushnew `(let* ((,myitem ,item))
                                   (setq ,place (adjoin ,myitem ,place ,@rest))))))
     (multiple-value-bind (vars vals stores store-form access-form)
-                        (get-setf-method place env)
+                        (get-setf-expansion place env)
                         `(let* ,(mapcar #'list
                                         (append (list myitem) vars stores)
                                         (append (list   item) vals
                 (setq ,place (cdr ,place))
                 ,temp))))
   (multiple-value-bind (vars vals stores store-form access-form)
-      (get-setf-method place env)
+      (get-setf-expansion place env)
     `(let* ,(mapcar #'list
                    (append vars stores)
                    (append vals (list (list 'cdr access-form))))
index 6bfce2f3a1de9a2dac19434132b136b083d879cd..fa6783edc5372008ec468b9a375ba69fc4bd3b3c 100755 (executable)
@@ -71,7 +71,7 @@
 ;;; some other package.
 
 
-(in-package "SLOOP"  :use '(LISP))  
+(in-package "SLOOP"  :use '(:LISP))  
 (eval-when (compile eval load)
 
 (export '(loop-return sloop def-loop-collect def-loop-map
index 4733639f94e93c31fe5cb461a807c8e76c85e8cf..4ad95a1857a31ebd5c15e1816ff2d12c332e37ed 100755 (executable)
@@ -1,4 +1,4 @@
-(in-package 'si)
+(in-package :si)
 
 (defvar *old-handler* #'si::universal-error-handler)
 
index 65fff7fa2c2546abca535a74710128d1bd5211f0..db842670ee0984ee4ef7149deb33d2a8f87538f9 100755 (executable)
 ;;;;  Revised on July 11, by Carl Hoffman.
 
 
-(in-package "LISP")
-;(export 'lisp)
-(export '(+ ++ +++ - * ** *** / // ///))
-(export '(break warn))
-(export '*break-on-warnings*)
-(export '*break-enable*)
-
-(in-package 'system)
+(in-package :si)
 
 (export '*break-readtable*)
 (export '(loc *debug-print-level*))
 
 (export '(vs ihs-vs ihs-fun frs-vs frs-bds frs-ihs bds-var bds-val super-go))
 
-(eval-when 
-    (compile)
-  (proclaim '(optimize (safety 2) (space 3)))
-  (defvar *command-args* nil))
+(defvar *command-args* nil)
 
 (defvar +)
 (defvar ++)
@@ -75,8 +65,6 @@
 (defvar *break-enable* t)
 (defvar *break-message* "")
 
-(defvar *break-on-warnings* nil)
-
 (defvar *break-readtable* nil)
 
 (defvar *top-level-hook* nil)
                      (lambda-block-closure (cddddr fun))
                      (t (cond
                         ((and (symbolp (car fun))
-                              (or (special-form-p(car fun))
+                              (or (special-operator-p(car fun))
                                   (fboundp (car fun))))
                          (car fun))
                         (t '(:zombi))))))
              (lambda-block-closure (nth 4 fun))
              (lambda-closure 'lambda-closure)
              (t (if (and (symbolp (car fun))
-                        (or (special-form-p (car fun))
+                        (or (special-operator-p (car fun))
                             (fboundp (car fun))))
                    (car fun) :zombi)
                    )))
index f97ed950005f03f9aac8097aa91922aef5cebc58..cbfae16a17d656721e3d63b650b1d1cf39ba1405 100755 (executable)
 ;; If you are working in another package you should (import 'si::arglist)
 ;; to avoid typing the si::
 
-(in-package 'lisp)
-
-(export '(trace untrace))
-(export 'step)
-
-
-(in-package 'system)
+(in-package :si)
 
 ;;(proclaim '(optimize (safety 2) (space 3)))
 
   (when (null (fboundp fname))
         (format *trace-output* "The function ~S is not defined.~%" fname)
         (return-from trace-one nil))
-  (when (special-form-p fname)
+  (when (special-operator-p fname)
         (format *trace-output* "~S is a special form.~%" fname)
         (return-from trace-one nil))
   (when (macro-function fname)
index 601987780d983a195431c8b7b3a46be5cb42d07e..208f94ba2cd701dfd78b3158afdd9d7f7dba302b 100755 (executable)
 
-(IN-PACKAGE "SYSTEM") 
-(MAPC (LAMBDA (COMPILER::X)
-        (SETF (GET COMPILER::X 'PROCLAIMED-CLOSURE) T))
-      '(SI-CLASS-PRECEDENCE-LIST BREAK-ON-FLOATING-POINT-EXCEPTIONS
-           SI-FIND-CLASS AUTOLOAD SI-CLASS-NAME TRACE-ONE SI-CLASSP
-           SIMPLE-CONDITION-CLASS-P CONDITIONP MAKE-ACCESS-FUNCTION
-           UNTRACE-ONE WARNINGP DEFINE-STRUCTURE CONDITION-CLASS-P
-           SI-CLASS-OF AUTOLOAD-MACRO)) 
-(PROCLAIM '(FTYPE (FUNCTION (T) (VALUES T T)) LISP::MAKE-KEYWORD)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T) T) S-DATA-HAS-HOLES CONSTANTLY
-            COMPUTING-ARGS-P ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS
-            ANSI-LOOP::LOOP-COLLECTOR-NAME FIRST INSPECT-SYMBOL
-            CONTEXT-P ANSI-LOOP::LOOP-MAKE-PSETQ TENTH
-            COMPILER-MACRO-FUNCTION ANSI-LOOP::LOOP-COLLECTOR-DATA
-            ARRAY-DIMENSIONS ASINH FPE::XMM-LOOKUP KNOWN-TYPE-P
-            CONTEXT-VEC CONTEXT-HASH SHOW-ENVIRONMENT
-            CHECK-DECLARATIONS BKPT-FILE-LINE PROVIDE
-            ANSI-LOOP::LOOP-PATH-P DWIM RESTART-P FPE::LOOKUP ACOSH
-            PRINT-SYMBOL-APROPOS SIGNUM ANSI-LOOP::LOOP-UNIVERSE-ANSI
-            IHS-NOT-INTERPRETED-ENV BYTE-SIZE THIRD RESTART-FUNCTION
-            ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS DO-F
-            ANSI-LOOP::LOOP-EMIT-BODY COSH S-DATA-CONC-NAME
-            INSTREAM-STREAM-NAME PATCH-SHARP INSPECT-STRING
-            S-DATA-INCLUDES SHOW-BREAK-POINT FPE::GREF
-            FIND-KCL-TOP-RESTART RESTART-REPORT-FUNCTION S-DATA-NAMED
-            S-DATA-CONSTRUCTORS S-DATA-P SLOOP::PARSE-LOOP
-            INSPECT-STRUCTURE BKPT-FORM PHASE SETUP-INFO
-            ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS
-            RESET-TRACE-DECLARATIONS SLOOP::SLOOP-SLOOP-MACRO EIGHTH
-            SECOND SLOOP::TRANSLATE-NAME
-            ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE NINTH
-            ANSI-LOOP::LOOP-COLLECTOR-P MAKE-KCL-TOP-RESTART
-            SEARCH-STACK ANSI-LOOP::LOOP-COLLECTOR-DTYPE ACOS
-            ANSI-LOOP::LOOP-MAXMIN-COLLECTION MAKE-DEFPACKAGE-FORM
-            INSPECT-NUMBER SINH ANSI-LOOP::LOOP-HACK-ITERATION
-            INSTREAM-STREAM WALK-THROUGH PRINT-IHS SIXTH S-DATA-FROZEN
-            INSPECT-CHARACTER SLOOP::RETURN-SLOOP-MACRO
-            FREEZE-DEFSTRUCT NEXT-STACK-FRAME
-            SLOOP::LOOP-COLLECT-KEYWORD-P DM-BAD-KEY
-            COMPILE-FILE-PATHNAME SEVENTH
-            ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD
-            SLOOP::PARSE-LOOP-INITIALLY TERMINAL-INTERRUPT
-            ANSI-LOOP::LOOP-EMIT-FINAL-VALUE FRS-KIND CHECK-TRACE-SPEC
-            CONTEXT-SPICE ANSI-LOOP::DESTRUCTURING-SIZE
-            ANSI-LOOP::LOOP-MINIMAX-OPERATIONS INSPECT-VECTOR ATANH
-            ANSI-LOOP::LOOP-PATH-NAMES S-DATA-OFFSET
-            SLOOP::REPEAT-SLOOP-MACRO FIND-ALL-SYMBOLS
-            ANSI-LOOP::LOOP-PATH-FUNCTION REWRITE-RESTART-CASE-CLAUSE
-            ANSI-LOOP::LOOP-COLLECTOR-CLASS
-            RESTART-INTERACTIVE-FUNCTION DM-KEY-NOT-ALLOWED
-            INSPECT-PACKAGE S-DATA-PRINT-FUNCTION NODE-OFFSET
-            RESTART-NAME RATIONAL NORMALIZE-TYPE
-            SLOOP::SUBSTITUTE-SLOOP-BODY FIFTH INFO-GET-TAGS S-DATA-RAW
-            RE-QUOTE-STRING SHORT-NAME LOGNOT INSPECT-ARRAY
-            TRACE-ONE-PREPROCESS SIMPLE-ARRAY-P FIND-DOCUMENTATION
-            BKPT-FUNCTION ANSI-LOOP::LOOP-PATH-USER-DATA EVAL-FEATURE
-            ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA ABS S-DATA-STATICP
-            ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE INSERT-BREAK-POINT
-            S-DATA-DOCUMENTATION PRINT-FRS IHS-VISIBLE GET-INSTREAM
-            INFO-GET-FILE GET-NEXT-VISIBLE-FUN DBL-EVAL FOURTH
-            ANSI-LOOP::LOOP-COLLECTOR-HISTORY BYTE-POSITION
-            ANSI-LOOP::LOOP-TYPED-INIT ASIN
-            ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS FIX-LOAD-PATH BKPT-FILE
-            VECTOR-POP IDESCRIBE UNIQUE-ID
-            ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS
-            ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED
-            SLOOP::POINTER-FOR-COLLECT FPE::ST-LOOKUP
-            ANSI-LOOP::LOOP-CONSTANTP ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS
-            ADD-TO-HOTLIST ANSI-LOOP::LOOP-DO-THEREIS
-            ANSI-LOOP::LOOP-LIST-COLLECTION S-DATA-TYPE
-            SLOOP::LOOP-LET-BINDINGS
-            ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED
-            BREAK-FORWARD-SEARCH-STACK ISQRT S-DATA-SLOT-POSITION
-            BREAK-BACKWARD-SEARCH-STACK
-            ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE RESTART-TEST-FUNCTION
-            INVOKE-DEBUGGER SLOOP::PARSE-NO-BODY
-            ANSI-LOOP::LOOP-MAKE-DESETQ
-            ANSI-LOOP::LOOP-CONSTRUCT-RETURN COMPLEMENT
-            ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS TANH INSTREAM-P
-            NODES-FROM-INDEX ANSI-LOOP::LOOP-PSEUDO-BODY
-            S-DATA-INCLUDED ANSI-LOOP::LOOP-MINIMAX-TYPE
-            NUMBER-OF-DAYS-FROM-1900 INFO-NODE-FROM-POSITION
-            ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE
-            ANSI-LOOP::LOOP-MINIMAX-P BEST-ARRAY-ELEMENT-TYPE
-            S-DATA-NAME SLOOP::AVERAGING-SLOOP-MACRO
-            ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS CIS SEQTYPE
-            LEAP-YEAR-P GET-BYTE-STREAM-NCHARS IHS-FNAME
-            ANSI-LOOP::LOOP-UNIVERSE-P INSPECT-CONS
-            S-DATA-SLOT-DESCRIPTIONS)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (*) *) INFO-ERROR BREAK-PREVIOUS BREAK-NEXT
-            CONTINUE BREAK-LOCAL SHOW-BREAK-VARIABLES BREAK-BDS
-            MUFFLE-WARNING DBL-BACKTRACE ANSI-LOOP::LOOP-OPTIONAL-TYPE
-            IHS-BACKTRACE BREAK-QUIT BREAK-VS)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (FIXNUM) FIXNUM) FPE::FE-ENABLE DBL-WHAT-FRAME)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T) FIXNUM) INSTREAM-LINE FPE::REG-LOOKUP
-            S-DATA-SIZE S-DATA-LENGTH THE-START)) 
-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM) T) PUSH-CONTEXT GET-CONTEXT)) 
-(PROCLAIM '(FTYPE (FUNCTION (STRING FIXNUM) FIXNUM) ATOI)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (*) T) ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE
-            MAYBE-CLEAR-INPUT ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL
-            DRIBBLE ANSI-LOOP::MAKE-LOOP-COLLECTOR
-            ANSI-LOOP::MAKE-LOOP-UNIVERSE Y-OR-N-P COMPUTE-RESTARTS
-            DESCRIBE-ENVIRONMENT TRANSFORM-KEYWORDS
-            SLOOP::PARSE-LOOP-DECLARE MAKE-RESTART MAKE-INSTREAM
-            ANSI-LOOP::LOOP-GENTEMP DBL-READ LOC CURRENT-STEP-FUN
-            VECTOR YES-OR-NO-P BREAK
-            ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL STEP-INTO MAKE-CONTEXT
-            ANSI-LOOP::MAKE-LOOP-PATH MAKE-S-DATA BREAK-LOCALS ABORT
-            SLOOP::PARSE-LOOP-WITH STEP-NEXT)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T) *) PRINC-TO-STRING GET-&ENVIRONMENT DESCRIBE
-            INSPECT ANSI-LOOP::NAMED-VARIABLE WAITING
-            ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES PRIN1-TO-STRING
-            BREAK-LEVEL-INVOKE-RESTART END-WAITING
-            ANSI-LOOP::LOOP-LIST-STEP ALOAD INSTREAM-NAME
-            INVOKE-RESTART-INTERACTIVELY FIND-DECLARATIONS BREAK-GO
-            INSPECT-OBJECT INFO-SUBFILE)) 
-(PROCLAIM '(FTYPE (FUNCTION (T FIXNUM T T) T) BIGNTHCDR)) 
-(PROCLAIM '(FTYPE (FUNCTION (T FIXNUM FIXNUM T T) T) QUICK-SORT)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T) *) SHARP-S-READER SHARP---READER
-            ANSI-LOOP::LOOP-GET-COLLECTION-INFO SHARP-+-READER
-            LIST-MERGE-SORT LISP::VERIFY-KEYWORDS READ-INSPECT-COMMAND
-            RESTART-PRINT)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T *) *) REDUCE SUBTYPEP SORT
-            SLOOP::FIND-IN-ORDERED-LIST STABLE-SORT LISP::PARSE-BODY)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T T *) *) LISP::PARSE-DEFMACRO-LAMBDA-LIST
-            LISP::PARSE-DEFMACRO)) 
-(PROCLAIM '(FTYPE (FUNCTION (T T T *) *) MASET)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T T T T T) *) LISP::PUSH-OPTIONAL-BINDING)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T *) *) DECODE-UNIVERSAL-TIME STEPPER USE-VALUE
-            FROUND INFO SHOW-INFO INVOKE-RESTART FCEILING
-            PARSE-BODY-HEADER ENSURE-DIRECTORIES-EXIST PRINT-DOC
-            APROPOS-DOC WRITE-TO-STRING FFLOOR NLOAD BREAK-FUNCTION
-            REQUIRE APROPOS GET-SETF-METHOD APROPOS-LIST
-            ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE STORE-VALUE
-            GET-SETF-METHOD-MULTIPLE-VALUE READ-FROM-STRING
-            WILD-PATHNAME-P FTRUNCATE)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T) T) QUOTATION-READER
-            SLOOP::IN-PACKAGE-SLOOP-MAP SLOOP::NEVER-SLOOP-COLLECT
-            MATCH-DIMENSIONS OBJLT ANSI-LOOP::LOOP-TEQUAL DBL-UP
-            GET-INFO-CHOICES NTHCDR ANSI-LOOP::LOOP-DECLARE-VARIABLE
-            ANSI-LOOP::MAKE-LOOP-MINIMAX LDB
-            OVERWRITE-SLOT-DESCRIPTIONS GET-LINE-OF-FORM DOCUMENTATION
-            DM-NTH ANSI-LOOP::LOOP-LOOKUP-KEYWORD DM-NTH-CDR
-            SLOOP::=-SLOOP-FOR LIST-DELQ SET-DIR LOGANDC2
-            SLOOP::IN-FRINGE-SLOOP-MAP DISPLAY-COMPILED-ENV SET-BACK
-            SLOOP::LOGXOR-SLOOP-COLLECT LEFT-PARENTHESIS-READER
-            ANSI-LOOP::LOOP-DO-IF FPE::%-READER LDB-TEST
-            COMPILER::COMPILER-DEF-HOOK BYTE
-            SLOOP::IN-CAREFULLY-SLOOP-FOR INCREMENT-CURSOR
-            IN-INTERVAL-P LISP::LOOKUP-KEYWORD SUPER-GO WRITE-BYTE
-            ANSI-LOOP::LOOP-DO-WHILE READ-INSTRUCTION LOGANDC1
-            SLOOP::THEREIS-SLOOP-COLLECT COERCE-TO-STRING LOGORC2
-            SEQUENCE-CURSOR LOGNOR FPE::READ-OPERANDS
-            SLOOP::MAXIMIZE-SLOOP-COLLECT ALL-MATCHES
-            SLOOP::IN-TABLE-SLOOP-MAP SLOOP::COLLATE-SLOOP-COLLECT
-            CHECK-SEQ-START-END BREAK-STEP-NEXT FPE::RF
-            SLOOP::PARSE-LOOP-MAP VECTOR-PUSH FPE::PAREN-READER
-            FPE::0-READER ANSI-LOOP::LOOP-TASSOC SETF-HELPER
-            SETF-EXPAND SLOOP::MINIMIZE-SLOOP-COLLECT ADD-FILE LOGORC1
-            SLOOP::COUNT-SLOOP-COLLECT SLOOP::MAKE-VALUE
-            PARSE-SLOT-DESCRIPTION SLOOP::DESETQ1
-            ANSI-LOOP::LOOP-DO-ALWAYS SLOOP::L-EQUAL GET-MATCH
-            SLOOP::SUM-SLOOP-COLLECT DM-V BREAK-STEP-INTO LOGNAND NTH
-            SUBSTRINGP INFO-AUX SUB-INTERVAL-P *BREAK-POINTS* SAFE-EVAL
-            ANSI-LOOP::HIDE-VARIABLE-REFERENCES COERCE
-            ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION CONDITION-PASS
-            GET-NODES ANSI-LOOP::LOOP-TMEMBER
-            SLOOP::ALWAYS-SLOOP-COLLECT DISPLAY-ENV SLOOP::THE-TYPE
-            ANSI-LOOP::LOOP-MAYBE-BIND-FORM ITERATE-OVER-BKPTS LOGTEST
-            LISP::KEYWORD-SUPPLIED-P)) 
-(PROCLAIM '(FTYPE (FUNCTION (T T T T T T T) *) TRACE-CALL)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION NIL *) GCL-TOP-LEVEL SIMPLE-BACKTRACE
-            BREAK-CURRENT BREAK-MESSAGE ANSI-LOOP::LOOP-DO-FOR
-            BREAK-HELP)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (STRING) T) RESET-SYS-PATHS
-            COERCE-SLASH-TERMINATED)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T) FIXNUM) RELATIVE-LINE GET-NODE-INDEX
-            ANSI-LOOP::DUPLICATABLE-CODE-P THE-END)) 
-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T) T) SMALLNTHCDR)) 
-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM FIXNUM) FIXNUM) ROUND-UP)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T *) T)
-            ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES SBIT
-            INFO-SEARCH PROCESS-ARGS LIST-MATCHES ARRAY-ROW-MAJOR-INDEX
-            FIND-RESTART SLOOP::LOOP-ADD-TEMPS ANSI-LOOP::LOOP-WARN
-            ANSI-LOOP::LOOP-ERROR BAD-SEQ-LIMIT ARRAY-IN-BOUNDS-P
-            MAKE-ARRAY SIGNAL BIT PROCESS-SOME-ARGS CONCATENATE ERROR
-            REMOVE-DUPLICATES SLOOP::ADD-FROM-DATA READ-BYTE
-            FILE-SEARCH FILE-TO-STRING UPGRADED-ARRAY-ELEMENT-TYPE WARN
-            BREAK-LEVEL BIT-NOT NTH-STACK-FRAME DELETE-DUPLICATES)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T) *) ANSI-LOOP::ESTIMATE-CODE-SIZE-1 NEWLINE
-            FIND-DOC RESTART-REPORT ANSI-LOOP::ESTIMATE-CODE-SIZE
-            NEW-SEMI-COLON-READER)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T *) T) NOTANY BIT-ORC1
-            ANSI-LOOP::LOOP-CHECK-DATA-TYPE REMOVE BIT-ANDC1
-            INTERNAL-COUNT-IF-NOT READ-SEQUENCE SUBSETP
-            VECTOR-PUSH-EXTEND TYPEP CERROR REPLACE COUNT-IF
-            NSET-DIFFERENCE DELETE REMOVE-IF NSET-EXCLUSIVE-OR
-            PROCESS-ERROR INTERNAL-COUNT SLOOP::IN-ARRAY-SLOOP-FOR
-            SEARCH MAKE-SEQUENCE ADJUST-ARRAY BIT-NAND FIND-IF
-            NINTERSECTION FILL BIT-ORC2 BIT-XOR UNION DELETE-IF-NOT
-            SLOOP::PARSE-LOOP-MACRO WRITE-SEQUENCE SOME COUNT-IF-NOT
-            MAP-INTO FIND FIND-IF-NOT BIT-NOR BIT-ANDC2 POSITION-IF
-            NOTEVERY NUNION SET-DIFFERENCE INTERSECTION POSITION-IF-NOT
-            EVERY POSITION FIND-IHS BIT-EQV REMOVE-IF-NOT MISMATCH
-            BIT-AND INTERNAL-COUNT-IF DELETE-IF COUNT BREAK-CALL
-            SET-EXCLUSIVE-OR SLOOP::LOOP-ADD-BINDING BIT-IOR)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T) T) ANSI-LOOP::LOOP-FOR-IN
-            FLOATING-POINT-ERROR CHECK-TRACE-ARGS
-            ANSI-LOOP::HIDE-VARIABLE-REFERENCE SETF-EXPAND-1
-            MAKE-BREAK-POINT FPE::REF SHARP-A-READER SHARP-U-READER DPB
-            DM-VL CHECK-S-DATA ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE
-            APPLY-DISPLAY-FUN ANSI-LOOP::LOOP-STANDARD-EXPANSION
-            ANSI-LOOP::LOOP-TRANSLATE DEPOSIT-FIELD
-            ANSI-LOOP::LOOP-ANSI-FOR-EQUALS
-            SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS
-            ANSI-LOOP::LOOP-FOR-ON GET-SLOT-POS
-            ANSI-LOOP::PRINT-LOOP-UNIVERSE DEFMACRO* WARN-VERSION
-            RESTART-CASE-EXPRESSION-CONDITION MAKE-T-TYPE
-            ANSI-LOOP::LOOP-SUM-COLLECTION ANSI-LOOP::LOOP-FOR-BEING
-            ANSI-LOOP::LOOP-FOR-ACROSS)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T *) T) CHECK-TYPE-SYMBOL
-            ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH NSUBSTITUTE-IF
-            SUBSTITUTE-IF
-            ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH NSUBSTITUTE
-            ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH
-            LISP::PUSH-LET-BINDING ANSI-LOOP::ADD-LOOP-PATH
-            SUBSTITUTE-IF-NOT MAP SLOOP::LOOP-DECLARE-BINDING
-            SUBSTITUTE ANSI-LOOP::LOOP-MAKE-VARIABLE NSUBSTITUTE-IF-NOT
-            COMPLETE-PROP)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T T T) T) LISP::DO-ARG-COUNT-ERROR
-            LISP::PUSH-SUB-LIST-BINDING)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T T) T) MAKE-CONSTRUCTOR MAKE-PREDICATE
-            DO-BREAK-LEVEL)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T *) T) PRINT-STACK-FRAME MERGE
-            SLOOP::DEF-LOOP-INTERNAL)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T FIXNUM) T) SHARP-EQ-READER
-            SHARP-SHARP-READER)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T) T) CALL-TEST COERCE-TO-CONDITION
-            FIND-LINE-IN-FUN ANSI-LOOP::LOOP-FOR-ARITHMETIC MAYBE-BREAK
-            SLOOP::FIRST-USE-SLOOP-FOR SLOOP::FIRST-SLOOP-FOR
-            SETF-STRUCTURE-ACCESS)) 
-(PROCLAIM '(FTYPE (FUNCTION (T T T T T T *) T) ENCODE-UNIVERSAL-TIME)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T T T T T T T) T)
-            ANSI-LOOP::LOOP-SEQUENCER)) 
-(PROCLAIM '(FTYPE (FUNCTION (T T T T T *) T) UNIVERSAL-ERROR-HANDLER)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION NIL T) ANSI-LOOP::LOOP-DO-NAMED
-            SLOOP::LOOP-UN-POP ANSI-LOOP::LOOP-DO-INITIALLY
-            SLOOP::PARSE-LOOP-WHEN SLOOP::LOOP-POP SLOOP::LOOP-PEEK
-            SLOOP::PARSE-LOOP-DO SET-ENV ANSI-LOOP::LOOP-DO-REPEAT
-            READ-EVALUATED-FORM ANSI-LOOP::LOOP-DO-RETURN
-            ANSI-LOOP::LOOP-GET-FORM ANSI-LOOP::LOOP-DO-FINALLY
-            SET-CURRENT DEFAULT-SYSTEM-BANNER DM-TOO-FEW-ARGUMENTS
-            ANSI-LOOP::LOOP-DO-DO SLOOP::PARSE-ONE-WHEN-CLAUSE
-            DEFAULT-INFO-HOTLIST KCL-TOP-RESTARTS TYPE-ERROR
-            SET-UP-TOP-LEVEL INSPECT-INDENT GET-INDEX-NODE
-            ALL-TRACE-DECLARATIONS DBL ANSI-LOOP::LOOP-GET-PROGN
-            INIT-BREAK-POINTS STEP-READ-LINE
-            ANSI-LOOP::LOOP-ITERATION-DRIVER GET-SIG-FN-NAME
-            SETUP-LINEINFO CLEANUP ANSI-LOOP::LOOP-WHEN-IT-VARIABLE
-            ANSI-LOOP::LOOP-DO-WITH SHOW-RESTARTS
-            SLOOP::PARSE-LOOP-COLLECT INSPECT-READ-LINE
-            DM-TOO-MANY-ARGUMENTS INSPECT-INDENT-1
-            ANSI-LOOP::LOOP-POP-SOURCE TEST-ERROR SLOOP::PARSE-LOOP1
-            ANSI-LOOP::LOOP-CONTEXT ANSI-LOOP::LOOP-BIND-BLOCK
-            WINE-TMP-REDIRECT ILLEGAL-BOA SLOOP::PARSE-LOOP-FOR
-            TOP-LEVEL LISP-IMPLEMENTATION-VERSION GET-TEMP-DIR)) 
\ No newline at end of file
+(COMMON-LISP::IN-PACKAGE "SYSTEM") 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T)
+         ANSI-LOOP::LOOP-EMIT-FINAL-VALUE SYSTEM::INSPECT-CHARACTER
+         SYSTEM::INSPECT-STRUCTURE SYSTEM::PRINT-IHS
+         SYSTEM::RESTART-FUNCTION COMMON-LISP::TANH COMMON-LISP::FIFTH
+         SLOOP::PARSE-LOOP-INITIALLY SYSTEM::NEXT-STACK-FRAME
+         SYSTEM::IDESCRIBE SYSTEM::PROCESS-ARGS SYSTEM::LEAP-YEAR-P
+         SLOOP::AVERAGING-SLOOP-MACRO SYSTEM::FIX-LOAD-PATH
+         SLOOP::SUBSTITUTE-SLOOP-BODY SYSTEM::RESTART-REPORT-FUNCTION
+         COMMON-LISP::NINTH SLOOP::SLOOP-SLOOP-MACRO
+         SYSTEM::S-DATA-CONSTRUCTORS SYSTEM::FREEZE-DEFSTRUCT
+         COMMON-LISP::EIGHTH SYSTEM::FIND-DOCUMENTATION
+         ANSI-LOOP::LOOP-PSEUDO-BODY COMMON-LISP::RATIONAL
+         ANSI-LOOP::LOOP-EMIT-BODY COMMON-LISP::ASIN
+         COMMON-LISP::COMPILE-FILE-PATHNAME SYSTEM::S-DATA-P
+         SYSTEM::BKPT-FUNCTION SYSTEM::TRACE-ONE-PREPROCESS
+         COMMON-LISP::LOGNOT SYSTEM::SIMPLE-ARRAY-P SYSTEM::BKPT-FILE
+         SYSTEM::S-DATA-STATICP COMMON-LISP::ISQRT SYSTEM::INSTREAM-P
+         COMMON-LISP::SEVENTH SYSTEM::S-DATA-NAMED
+         ANSI-LOOP::LOOP-PATH-PREPOSITION-GROUPS SYSTEM::INSPECT-NUMBER
+         COMMON-LISP::ATANH SYSTEM::RESTART-TEST-FUNCTION
+         SYSTEM::S-DATA-INCLUDES SYSTEM::S-DATA-HAS-HOLES
+         SYSTEM::CONTEXT-VEC FPE::XMM-LOOKUP SYSTEM::S-DATA-RAW
+         ANSI-LOOP::LOOP-UNIVERSE-KEYWORDS
+         SYSTEM::RESTART-INTERACTIVE-FUNCTION
+         ANSI-LOOP::LOOP-UNIVERSE-ITERATION-KEYWORDS
+         ANSI-LOOP::LOOP-COLLECTOR-NAME ANSI-LOOP::LOOP-PATH-NAMES
+         ANSI-LOOP::LOOP-MINIMAX-ANSWER-VARIABLE
+         SYSTEM::S-DATA-INCLUDED SYSTEM::S-DATA-SLOT-DESCRIPTIONS
+         SYSTEM::S-DATA-OFFSET SLOOP::REPEAT-SLOOP-MACRO
+         SYSTEM::S-DATA-PRINT-FUNCTION ANSI-LOOP::LOOP-PATH-USER-DATA
+         COMMON-LISP::FIND-ALL-SYMBOLS COMMON-LISP::FIRST
+         SYSTEM::GET-BYTE-STREAM-NCHARS SYSTEM::BKPT-FORM
+         SYSTEM::NODES-FROM-INDEX SYSTEM::INSPECT-SYMBOL
+         SYSTEM::KNOWN-TYPE-P ANSI-LOOP::LOOP-MINIMAX-TEMP-VARIABLE
+         SYSTEM::MAKE-DEFPACKAGE-FORM COMMON-LISP::ARRAY-DIMENSIONS
+         SYSTEM::INSERT-BREAK-POINT SLOOP::PARSE-LOOP
+         ANSI-LOOP::LOOP-PATH-INCLUSIVE-PERMITTED
+         ANSI-LOOP::LOOP-UNIVERSE-PATH-KEYWORDS SYSTEM::SHORT-NAME
+         SYSTEM::CHECK-TRACE-SPEC ANSI-LOOP::DESTRUCTURING-SIZE
+         SYSTEM::BEST-ARRAY-ELEMENT-TYPE SYSTEM::CONTEXT-HASH
+         COMMON-LISP::SIXTH SYSTEM::IHS-VISIBLE SYSTEM::INSPECT-ARRAY
+         COMMON-LISP::BYTE-SIZE ANSI-LOOP::LOOP-COLLECTOR-CLASS
+         ANSI-LOOP::LOOP-HACK-ITERATION
+         ANSI-LOOP::LOOP-CONSTRUCT-RETURN SYSTEM::S-DATA-SLOT-POSITION
+         ANSI-LOOP::LOOP-MINIMAX-FLAG-VARIABLE SYSTEM::INSPECT-STRING
+         COMMON-LISP::PROVIDE COMMON-LISP::CIS
+         ANSI-LOOP::LOOP-MINIMAX-OPERATIONS
+         SYSTEM::BREAK-BACKWARD-SEARCH-STACK
+         ANSI-LOOP::LOOP-COLLECTOR-DTYPE
+         SYSTEM::IHS-NOT-INTERPRETED-ENV SYSTEM::SEARCH-STACK
+         COMMON-LISP::TENTH ANSI-LOOP::LOOP-DO-THEREIS
+         ANSI-LOOP::LOOP-MAXMIN-COLLECTION
+         ANSI-LOOP::LOOP-MINIMAX-INFINITY-DATA
+         ANSI-LOOP::LOOP-MAKE-PSETQ SYSTEM::ADD-TO-HOTLIST
+         SYSTEM::INSPECT-CONS ANSI-LOOP::LOOP-UNIVERSE-TYPE-SYMBOLS
+         SYSTEM::INSPECT-VECTOR COMMON-LISP::CONSTANTLY
+         SYSTEM::REWRITE-RESTART-CASE-CLAUSE SYSTEM::DM-BAD-KEY
+         SYSTEM::PRINT-SYMBOL-APROPOS SYSTEM::FRS-KIND FPE::ST-LOOKUP
+         COMMON-LISP::FOURTH SYSTEM::TERMINAL-INTERRUPT
+         SYSTEM::DM-KEY-NOT-ALLOWED SYSTEM::UNIQUE-ID
+         SYSTEM::S-DATA-FROZEN SLOOP::POINTER-FOR-COLLECT
+         SYSTEM::INSPECT-PACKAGE SYSTEM::DBL-EVAL
+         ANSI-LOOP::LOOP-MINIMAX-TYPE ANSI-LOOP::LOOP-UNIVERSE-ANSI
+         ANSI-LOOP::LOOP-UNIVERSE-TYPE-KEYWORDS SYSTEM::DWIM
+         SYSTEM::INSTREAM-STREAM-NAME SLOOP::RETURN-SLOOP-MACRO
+         SYSTEM::PATCH-SHARP SYSTEM::CONTEXT-P SYSTEM::INFO-GET-FILE
+         SYSTEM::RESTART-P COMMON-LISP::COSH COMMON-LISP::SINH
+         SYSTEM::GET-NEXT-VISIBLE-FUN SYSTEM::CHECK-DECLARATIONS
+         SYSTEM::GET-INSTREAM
+         ANSI-LOOP::LOOP-CODE-DUPLICATION-THRESHOLD SYSTEM::S-DATA-NAME
+         ANSI-LOOP::LOOP-UNIVERSE-FOR-KEYWORDS
+         SYSTEM::S-DATA-DOCUMENTATION SYSTEM::SHOW-BREAK-POINT
+         COMMON-LISP::ACOS COMMON-LISP::INVOKE-DEBUGGER
+         SYSTEM::BKPT-FILE-LINE ANSI-LOOP::LOOP-COLLECTOR-DATA
+         COMMON-LISP::THIRD SYSTEM::S-DATA-CONC-NAME
+         COMMON-LISP::SIGNUM
+         ANSI-LOOP::LOOP-UNIVERSE-IMPLICIT-FOR-REQUIRED
+         SYSTEM::NORMALIZE-TYPE ANSI-LOOP::LOOP-TYPED-INIT
+         ANSI-LOOP::LOOP-PATH-FUNCTION SYSTEM::INFO-NODE-FROM-POSITION
+         COMMON-LISP::ASINH SYSTEM::RE-QUOTE-STRING
+         SLOOP::LOOP-COLLECT-KEYWORD-P SYSTEM::PRINT-FRS
+         SYSTEM::EVAL-FEATURE ANSI-LOOP::LOOP-COLLECTOR-P
+         ANSI-LOOP::LOOP-COLLECTOR-HISTORY
+         ANSI-LOOP::LOOP-LIST-COLLECTION
+         SYSTEM::BREAK-FORWARD-SEARCH-STACK COMMON-LISP::RESTART-NAME
+         SLOOP::PARSE-NO-BODY ANSI-LOOP::LOOP-UNIVERSE-P
+         SYSTEM::NUMBER-OF-DAYS-FROM-1900 SYSTEM::NODE-OFFSET
+         ANSI-LOOP::LOOP-MINIMAX-P SYSTEM::IHS-FNAME FPE::LOOKUP
+         SLOOP::LOOP-LET-BINDINGS FPE::GREF COMMON-LISP::PHASE
+         COMMON-LISP::BYTE-POSITION SYSTEM::INSTREAM-STREAM
+         ANSI-LOOP::LOOP-PATH-P SYSTEM::SEQTYPE COMMON-LISP::ACOSH
+         COMMON-LISP::ABS COMMON-LISP::COMPLEMENT
+         ANSI-LOOP::LOOP-CONSTANTP SYSTEM::WALK-THROUGH
+         SYSTEM::SETUP-INFO SYSTEM::COMPUTING-ARGS-P
+         SYSTEM::CONTEXT-SPICE SYSTEM::MAKE-KCL-TOP-RESTART
+         COMMON-LISP::COMPILER-MACRO-FUNCTION
+         ANSI-LOOP::LOOP-MAKE-DESETQ SYSTEM::SHOW-ENVIRONMENT
+         SLOOP::TRANSLATE-NAME SYSTEM::INFO-GET-TAGS
+         COMMON-LISP::SECOND SYSTEM::RESET-TRACE-DECLARATIONS
+         SYSTEM::S-DATA-TYPE SYSTEM::FIND-KCL-TOP-RESTART
+         ANSI-LOOP::MAKE-ANSI-LOOP-UNIVERSE SYSTEM::DO-F
+         ANSI-LOOP::LOOP-COLLECTOR-TEMPVARS COMMON-LISP::VECTOR-POP)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*)
+         SYSTEM::IHS-BACKTRACE SYSTEM::BREAK-NEXT SYSTEM::BREAK-QUIT
+         SYSTEM::SHOW-BREAK-VARIABLES SYSTEM::BREAK-BDS
+         COMMON-LISP::MUFFLE-WARNING SYSTEM::BREAK-PREVIOUS
+         SYSTEM::INFO-ERROR ANSI-LOOP::LOOP-OPTIONAL-TYPE
+         SYSTEM::DBL-BACKTRACE SYSTEM::BREAK-LOCAL SYSTEM::BREAK-VS
+         COMMON-LISP::CONTINUE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM)
+             COMMON-LISP::FIXNUM)
+         SYSTEM::DBL-WHAT-FRAME FPE::FE-ENABLE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::*)
+         COMMON-LISP::SUBTYPEP COMMON-LISP::REDUCE SYSTEM::PARSE-BODY
+         COMMON-LISP::STABLE-SORT COMMON-LISP::SORT
+         SLOOP::FIND-IN-ORDERED-LIST)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::*)
+         SYSTEM::VERIFY-KEYWORDS SYSTEM::RESTART-PRINT
+         ANSI-LOOP::LOOP-GET-COLLECTION-INFO SYSTEM::LIST-MERGE-SORT
+         SYSTEM::READ-INSPECT-COMMAND SYSTEM::SHARP---READER
+         SYSTEM::SHARP-+-READER SYSTEM::SHARP-S-READER)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::*)
+         SYSTEM::PUSH-OPTIONAL-BINDING)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::*)
+         SYSTEM::PARSE-DEFMACRO-LAMBDA-LIST SYSTEM::PARSE-DEFMACRO)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T)
+             COMMON-LISP::*)
+         SYSTEM::TRACE-CALL)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::*)
+             COMMON-LISP::*)
+         SYSTEM::MASET)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM)
+         FPE::REG-LOOKUP SYSTEM::INSTREAM-LINE SYSTEM::THE-START
+         SYSTEM::S-DATA-LENGTH SYSTEM::S-DATA-SIZE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T)
+         SYSTEM::PUSH-CONTEXT SYSTEM::GET-CONTEXT)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*)
+         SYSTEM::BREAK-CURRENT SYSTEM::GCL-TOP-LEVEL
+         SYSTEM::BREAK-MESSAGE SYSTEM::BREAK-RESUME
+         ANSI-LOOP::LOOP-DO-FOR SYSTEM::SIMPLE-BACKTRACE
+         SYSTEM::BREAK-HELP)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::STRING) COMMON-LISP::T)
+         SYSTEM::COERCE-SLASH-TERMINATED SYSTEM::RESET-SYS-PATHS)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::T)
+         COMMON-LISP::BIT COMMON-LISP::READ-BYTE
+         COMMON-LISP::CONCATENATE SYSTEM::INFO-SEARCH
+         COMMON-LISP::ARRAY-IN-BOUNDS-P ANSI-LOOP::LOOP-ERROR
+         ANSI-LOOP::LOOP-WARN COMMON-LISP::REMOVE-DUPLICATES
+         SYSTEM::BAD-SEQ-LIMIT SYSTEM::PROCESS-SOME-ARGS
+         ANSI-LOOP::LOOP-COLLECT-PREPOSITIONAL-PHRASES
+         SLOOP::LOOP-ADD-TEMPS COMMON-LISP::BIT-NOT COMMON-LISP::SIGNAL
+         SYSTEM::NTH-STACK-FRAME COMMON-LISP::ARRAY-ROW-MAJOR-INDEX
+         COMMON-LISP::MAKE-ARRAY SYSTEM::FILE-SEARCH
+         SYSTEM::LIST-MATCHES COMMON-LISP::FIND-RESTART
+         SYSTEM::BREAK-LEVEL COMMON-LISP::DELETE-DUPLICATES
+         SLOOP::ADD-FROM-DATA COMMON-LISP::ERROR COMMON-LISP::WARN
+         SYSTEM::FILE-TO-STRING
+         COMMON-LISP::UPGRADED-ARRAY-ELEMENT-TYPE COMMON-LISP::SBIT)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::*)
+         SYSTEM::FIND-DOC SYSTEM::RESTART-REPORT
+         ANSI-LOOP::ESTIMATE-CODE-SIZE-1 SYSTEM::NEWLINE
+         ANSI-LOOP::ESTIMATE-CODE-SIZE SYSTEM::NEW-SEMI-COLON-READER)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T)
+             (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T))
+         SYSTEM::MAKE-KEYWORD)) 
+(COMMON-LISP::MAPC
+    (COMMON-LISP::LAMBDA (COMPILER::X)
+      (COMMON-LISP::SETF
+          (COMMON-LISP::GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE)
+          COMMON-LISP::T))
+    '(SYSTEM::SI-CLASS-PRECEDENCE-LIST SYSTEM::SI-CLASSP
+         SYSTEM::SIMPLE-CONDITION-CLASS-P SYSTEM::UNTRACE-ONE
+         SYSTEM::CONDITIONP SYSTEM::CONDITION-CLASS-P
+         SYSTEM::MAKE-ACCESS-FUNCTION SYSTEM::SI-CLASS-NAME
+         SYSTEM::AUTOLOAD-MACRO SYSTEM::AUTOLOAD SYSTEM::SI-CLASS-OF
+         SYSTEM::WARNINGP SYSTEM::DEFINE-STRUCTURE
+         FPE::BREAK-ON-FLOATING-POINT-EXCEPTIONS SYSTEM::SI-FIND-CLASS
+         SYSTEM::TRACE-ONE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM
+                 COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::T)
+         SYSTEM::QUICK-SORT)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::T
+                 COMMON-LISP::T)
+             COMMON-LISP::T)
+         SYSTEM::BIGNTHCDR)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::T)
+         ANSI-LOOP::LOOP-MAKE-ITERATION-VARIABLE ANSI-LOOP::LOOP-FOR-IN
+         SYSTEM::DEFMACRO* SYSTEM::APPLY-DISPLAY-FUN
+         SYSTEM::WARN-VERSION ANSI-LOOP::HIDE-VARIABLE-REFERENCE
+         SYSTEM::SHARP-U-READER ANSI-LOOP::LOOP-FOR-ACROSS
+         SYSTEM::DM-VL SYSTEM::GET-SLOT-POS
+         SYSTEM::RESTART-CASE-EXPRESSION-CONDITION
+         SYSTEM::CHECK-TRACE-ARGS ANSI-LOOP::LOOP-FOR-ON FPE::REF
+         ANSI-LOOP::PRINT-LOOP-UNIVERSE ANSI-LOOP::LOOP-ANSI-FOR-EQUALS
+         SYSTEM::SETF-EXPAND-1 ANSI-LOOP::LOOP-SUM-COLLECTION
+         ANSI-LOOP::LOOP-STANDARD-EXPANSION SYSTEM::MAKE-T-TYPE
+         COMMON-LISP::DEPOSIT-FIELD SYSTEM::MAKE-BREAK-POINT
+         ANSI-LOOP::LOOP-FOR-BEING ANSI-LOOP::LOOP-TRANSLATE
+         SYSTEM::SHARP-A-READER COMMON-LISP::DPB
+         SYSTEM::FLOATING-POINT-ERROR SYSTEM::CHECK-S-DATA
+         SLOOP::LOOP-PARSE-ADDITIONAL-COLLECTIONS)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T)
+             COMMON-LISP::T)
+         SLOOP::FIRST-USE-SLOOP-FOR SYSTEM::COERCE-TO-CONDITION
+         SLOOP::FIRST-SLOOP-FOR ANSI-LOOP::LOOP-FOR-ARITHMETIC
+         SYSTEM::MAYBE-BREAK SYSTEM::SETF-STRUCTURE-ACCESS
+         SYSTEM::CALL-TEST SYSTEM::FIND-LINE-IN-FUN)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::T)
+         COMMON-LISP::COUNT-IF COMMON-LISP::BIT-ANDC2
+         COMMON-LISP::REMOVE SYSTEM::INTERNAL-COUNT-IF
+         SLOOP::LOOP-ADD-BINDING COMMON-LISP::MAP-INTO
+         COMMON-LISP::FIND-IF COMMON-LISP::NSET-DIFFERENCE
+         COMMON-LISP::UNION COMMON-LISP::NUNION
+         COMMON-LISP::MAKE-SEQUENCE COMMON-LISP::NOTANY
+         COMMON-LISP::POSITION COMMON-LISP::DELETE-IF
+         COMMON-LISP::BIT-ORC2 COMMON-LISP::REPLACE COMMON-LISP::DELETE
+         SYSTEM::BREAK-CALL COMMON-LISP::NINTERSECTION
+         COMMON-LISP::POSITION-IF SYSTEM::FIND-IHS COMMON-LISP::BIT-AND
+         COMMON-LISP::DELETE-IF-NOT ANSI-LOOP::LOOP-CHECK-DATA-TYPE
+         COMMON-LISP::REMOVE-IF COMMON-LISP::READ-SEQUENCE
+         SLOOP::PARSE-LOOP-MACRO COMMON-LISP::BIT-NAND
+         SYSTEM::INTERNAL-COUNT-IF-NOT COMMON-LISP::SUBSETP
+         COMMON-LISP::VECTOR-PUSH-EXTEND COMMON-LISP::EVERY
+         COMMON-LISP::SOME COMMON-LISP::WRITE-SEQUENCE
+         COMMON-LISP::MISMATCH COMMON-LISP::SET-EXCLUSIVE-OR
+         COMMON-LISP::REMOVE-IF-NOT COMMON-LISP::BIT-NOR
+         COMMON-LISP::BIT-XOR COMMON-LISP::BIT-EQV COMMON-LISP::SEARCH
+         COMMON-LISP::SET-DIFFERENCE COMMON-LISP::FILL
+         COMMON-LISP::CERROR COMMON-LISP::ADJUST-ARRAY
+         COMMON-LISP::BIT-ORC1 SYSTEM::INTERNAL-COUNT
+         COMMON-LISP::TYPEP SYSTEM::PROCESS-ERROR
+         COMMON-LISP::COUNT-IF-NOT COMMON-LISP::INTERSECTION
+         SLOOP::IN-ARRAY-SLOOP-FOR COMMON-LISP::FIND-IF-NOT
+         COMMON-LISP::BIT-ANDC1 COMMON-LISP::POSITION-IF-NOT
+         COMMON-LISP::NOTEVERY COMMON-LISP::NSET-EXCLUSIVE-OR
+         COMMON-LISP::FIND COMMON-LISP::COUNT COMMON-LISP::BIT-IOR)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::T)
+         SYSTEM::PUSH-SUB-LIST-BINDING SYSTEM::DO-ARG-COUNT-ERROR)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::*)
+             COMMON-LISP::T)
+         ANSI-LOOP::ADD-LOOP-PATH COMMON-LISP::MAP
+         ANSI-LOOP::LOOP-HASH-TABLE-ITERATION-PATH
+         ANSI-LOOP::LOOP-PACKAGE-SYMBOLS-ITERATION-PATH
+         COMMON-LISP::SUBSTITUTE COMMON-LISP::NSUBSTITUTE
+         COMMON-LISP::NSUBSTITUTE-IF-NOT ANSI-LOOP::LOOP-MAKE-VARIABLE
+         COMMON-LISP::SUBSTITUTE-IF-NOT
+         ANSI-LOOP::LOOP-SEQUENCE-ELEMENTS-PATH
+         SYSTEM::PUSH-LET-BINDING COMMON-LISP::SUBSTITUTE-IF
+         SYSTEM::CHECK-TYPE-SYMBOL SLOOP::LOOP-DECLARE-BINDING
+         SYSTEM::COMPLETE-PROP COMMON-LISP::NSUBSTITUTE-IF)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::T)
+         SYSTEM::MAKE-PREDICATE SYSTEM::DO-BREAK-LEVEL
+         SYSTEM::MAKE-CONSTRUCTOR)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::T)
+         SYSTEM::UNIVERSAL-ERROR-HANDLER)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::FIXNUM)
+             COMMON-LISP::T)
+         SYSTEM::SHARP-SHARP-READER SYSTEM::SHARP-EQ-READER)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::T)
+         SLOOP::DEF-LOOP-INTERNAL SYSTEM::PRINT-STACK-FRAME
+         COMMON-LISP::MERGE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::*)
+             COMMON-LISP::T)
+         COMMON-LISP::ENCODE-UNIVERSAL-TIME)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T)
+             COMMON-LISP::T)
+         ANSI-LOOP::LOOP-SEQUENCER)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::STRING COMMON-LISP::FIXNUM)
+             COMMON-LISP::FIXNUM)
+         SYSTEM::ATOI)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T)
+         SYSTEM::DESCRIBE-ENVIRONMENT SYSTEM::STEP-NEXT
+         COMMON-LISP::BREAK COMMON-LISP::ABORT SYSTEM::MAKE-S-DATA
+         ANSI-LOOP::MAKE-LOOP-COLLECTOR SLOOP::PARSE-LOOP-DECLARE
+         ANSI-LOOP::LOOP-GENTEMP SYSTEM::MAKE-INSTREAM
+         SYSTEM::MAYBE-CLEAR-INPUT
+         ANSI-LOOP::MAKE-LOOP-MINIMAX-INTERNAL COMMON-LISP::Y-OR-N-P
+         SYSTEM::CURRENT-STEP-FUN ANSI-LOOP::LOOP-DISALLOW-CONDITIONAL
+         COMMON-LISP::DRIBBLE SYSTEM::MAKE-RESTART
+         SLOOP::PARSE-LOOP-WITH SYSTEM::LOC COMMON-LISP::YES-OR-NO-P
+         SYSTEM::TRANSFORM-KEYWORDS SYSTEM::MAKE-CONTEXT
+         COMMON-LISP::COMPUTE-RESTARTS SYSTEM::DBL-READ
+         SYSTEM::STEP-INTO ANSI-LOOP::MAKE-LOOP-UNIVERSE
+         SYSTEM::BREAK-LOCALS ANSI-LOOP::MAKE-STANDARD-LOOP-UNIVERSE
+         COMMON-LISP::VECTOR ANSI-LOOP::MAKE-LOOP-PATH)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*)
+         ANSI-LOOP::LOOP-LIST-STEP SYSTEM::INSPECT-OBJECT
+         COMMON-LISP::DESCRIBE ANSI-LOOP::LOOP-OPTIMIZATION-QUANTITIES
+         SYSTEM::BREAK-GO SYSTEM::GET-&ENVIRONMENT
+         COMMON-LISP::PRINC-TO-STRING SYSTEM::WAITING
+         SYSTEM::INSTREAM-NAME ANSI-LOOP::NAMED-VARIABLE
+         COMMON-LISP::PRIN1-TO-STRING SYSTEM::INFO-SUBFILE
+         COMMON-LISP::INSPECT SYSTEM::END-WAITING
+         SYSTEM::FIND-DECLARATIONS
+         COMMON-LISP::INVOKE-RESTART-INTERACTIVELY
+         SYSTEM::BREAK-LEVEL-INVOKE-RESTART SYSTEM::ALOAD)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::T)
+         ANSI-LOOP::MAKE-LOOP-MINIMAX COMMON-LISP::LDB
+         SYSTEM::LIST-DELQ FPE::RF SLOOP::L-EQUAL
+         ANSI-LOOP::LOOP-DECLARE-VARIABLE SYSTEM::DISPLAY-COMPILED-ENV
+         SYSTEM::SET-BACK ANSI-LOOP::HIDE-VARIABLE-REFERENCES
+         SYSTEM::GET-LINE-OF-FORM SYSTEM::BREAK-STEP-INTO
+         SLOOP::THE-TYPE SLOOP::COUNT-SLOOP-COLLECT
+         SYSTEM::KEYWORD-SUPPLIED-P COMMON-LISP::LOGANDC2
+         ANSI-LOOP::LOOP-MAYBE-BIND-FORM SYSTEM::SET-DIR
+         SYSTEM::COERCE-TO-STRING COMMON-LISP::VECTOR-PUSH
+         SYSTEM::DM-NTH-CDR SLOOP::IN-FRINGE-SLOOP-MAP
+         SLOOP::MAXIMIZE-SLOOP-COLLECT SYSTEM::ADD-FILE
+         SYSTEM::ALL-MATCHES SYSTEM::DM-NTH
+         SLOOP::IN-CAREFULLY-SLOOP-FOR SYSTEM::PARSE-SLOT-DESCRIPTION
+         ANSI-LOOP::LOOP-LOOKUP-KEYWORD FPE::0-READER
+         ANSI-LOOP::LOOP-TMEMBER COMPILER::COMPILER-DEF-HOOK
+         SYSTEM::INFO-AUX COMMON-LISP::NTH SYSTEM::QUOTATION-READER
+         SYSTEM::CHECK-SEQ-START-END COMMON-LISP::LOGNAND
+         SYSTEM::SUBSTRINGP COMMON-LISP::LOGORC2
+         ANSI-LOOP::LOOP-NOTE-MINIMAX-OPERATION SYSTEM::SAFE-EVAL
+         ANSI-LOOP::LOOP-DO-IF SLOOP::THEREIS-SLOOP-COLLECT
+         SYSTEM::MATCH-DIMENSIONS SYSTEM::GET-MATCH
+         SYSTEM::SUB-INTERVAL-P FPE::PAREN-READER
+         SLOOP::IN-TABLE-SLOOP-MAP COMMON-LISP::LOGTEST
+         SLOOP::LOGXOR-SLOOP-COLLECT SYSTEM::DM-V
+         SYSTEM::GET-INFO-CHOICES SLOOP::COLLATE-SLOOP-COLLECT
+         SYSTEM::BREAK-STEP-NEXT ANSI-LOOP::LOOP-TEQUAL
+         COMMON-LISP::WRITE-BYTE COMMON-LISP::NTHCDR
+         SYSTEM::SETF-HELPER SLOOP::NEVER-SLOOP-COLLECT SLOOP::DESETQ1
+         ANSI-LOOP::LOOP-DO-WHILE COMMON-LISP::DOCUMENTATION
+         FPE::%-READER SYSTEM::IN-INTERVAL-P SLOOP::SUM-SLOOP-COLLECT
+         SYSTEM::OBJLT COMMON-LISP::LDB-TEST SLOOP::PARSE-LOOP-MAP
+         SYSTEM::GET-NODES SLOOP::MAKE-VALUE SYSTEM::CONDITION-PASS
+         SLOOP::IN-PACKAGE-SLOOP-MAP SYSTEM::INCREMENT-CURSOR
+         ANSI-LOOP::LOOP-DO-ALWAYS SYSTEM::DISPLAY-ENV SYSTEM::SUPER-GO
+         SLOOP::MINIMIZE-SLOOP-COLLECT COMMON-LISP::LOGNOR
+         COMMON-LISP::LOGANDC1 COMMON-LISP::BYTE SYSTEM::DBL-UP
+         SYSTEM::ITERATE-OVER-BKPTS COMMON-LISP::LOGORC1
+         FPE::READ-OPERANDS SLOOP::ALWAYS-SLOOP-COLLECT
+         SYSTEM::SETF-EXPAND SYSTEM::OVERWRITE-SLOT-DESCRIPTIONS
+         SYSTEM::*BREAK-POINTS* SYSTEM::LOOKUP-KEYWORD
+         ANSI-LOOP::LOOP-TASSOC SYSTEM::LEFT-PARENTHESIS-READER
+         SLOOP::=-SLOOP-FOR FPE::READ-INSTRUCTION COMMON-LISP::COERCE
+         SYSTEM::SEQUENCE-CURSOR)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::*)
+         COMMON-LISP::FFLOOR SYSTEM::BREAK-FUNCTION
+         COMMON-LISP::APROPOS-LIST COMMON-LISP::DECODE-UNIVERSAL-TIME
+         SYSTEM::STEPPER COMMON-LISP::REQUIRE SYSTEM::APROPOS-DOC
+         SYSTEM::PRINT-DOC SYSTEM::INFO COMMON-LISP::USE-VALUE
+         COMMON-LISP::WRITE-TO-STRING COMMON-LISP::FCEILING
+         SYSTEM::GET-SETF-METHOD
+         ANSI-LOOP::LOOP-CONSTANT-FOLD-IF-POSSIBLE SYSTEM::NLOAD
+         COMMON-LISP::ENSURE-DIRECTORIES-EXIST
+         COMMON-LISP::WILD-PATHNAME-P COMMON-LISP::FTRUNCATE
+         COMMON-LISP::FROUND SYSTEM::PARSE-BODY-HEADER
+         COMMON-LISP::INVOKE-RESTART SYSTEM::SHOW-INFO
+         COMMON-LISP::READ-FROM-STRING
+         SYSTEM::GET-SETF-METHOD-MULTIPLE-VALUE COMMON-LISP::APROPOS
+         COMMON-LISP::STORE-VALUE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T)
+         ANSI-LOOP::LOOP-DO-WITH SYSTEM::WINE-TMP-REDIRECT
+         SLOOP::PARSE-ONE-WHEN-CLAUSE COMMON-LISP::TYPE-ERROR
+         SYSTEM::INSPECT-INDENT SYSTEM::SET-CURRENT SYSTEM::TEST-ERROR
+         SLOOP::LOOP-POP ANSI-LOOP::LOOP-DO-REPEAT
+         ANSI-LOOP::LOOP-GET-PROGN SYSTEM::DM-TOO-FEW-ARGUMENTS
+         ANSI-LOOP::LOOP-CONTEXT SYSTEM::READ-EVALUATED-FORM
+         SYSTEM::ALL-TRACE-DECLARATIONS
+         COMMON-LISP::LISP-IMPLEMENTATION-VERSION
+         SYSTEM::DEFAULT-SYSTEM-BANNER ANSI-LOOP::LOOP-DO-RETURN
+         SYSTEM::INSPECT-INDENT-1 SYSTEM::STEP-READ-LINE
+         SYSTEM::SET-ENV SYSTEM::DM-TOO-MANY-ARGUMENTS
+         ANSI-LOOP::LOOP-BIND-BLOCK SLOOP::PARSE-LOOP1
+         ANSI-LOOP::LOOP-DO-NAMED SLOOP::PARSE-LOOP-COLLECT
+         SYSTEM::KCL-TOP-RESTARTS SYSTEM::INSPECT-READ-LINE
+         SYSTEM::SET-UP-TOP-LEVEL SYSTEM::SHOW-RESTARTS SYSTEM::DBL
+         SLOOP::PARSE-LOOP-FOR ANSI-LOOP::LOOP-ITERATION-DRIVER
+         ANSI-LOOP::LOOP-WHEN-IT-VARIABLE ANSI-LOOP::LOOP-DO-DO
+         SYSTEM::DEFAULT-INFO-HOTLIST SYSTEM::GET-TEMP-DIR
+         ANSI-LOOP::LOOP-POP-SOURCE SLOOP::LOOP-UN-POP
+         SYSTEM::TOP-LEVEL ANSI-LOOP::LOOP-DO-FINALLY
+         ANSI-LOOP::LOOP-DO-INITIALLY SYSTEM::GET-INDEX-NODE
+         SYSTEM::SETUP-LINEINFO SLOOP::PARSE-LOOP-WHEN SYSTEM::CLEANUP
+         ANSI-LOOP::LOOP-GET-FORM SLOOP::PARSE-LOOP-DO
+         SYSTEM::INIT-BREAK-POINTS SLOOP::LOOP-PEEK
+         SYSTEM::GET-SIG-FN-NAME SYSTEM::ILLEGAL-BOA)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T)
+             COMMON-LISP::T)
+         SYSTEM::SMALLNTHCDR)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::FIXNUM)
+         SYSTEM::THE-END ANSI-LOOP::DUPLICATABLE-CODE-P
+         SYSTEM::RELATIVE-LINE SYSTEM::GET-NODE-INDEX)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM)
+             COMMON-LISP::FIXNUM)
+         SYSTEM::ROUND-UP)) 
\ No newline at end of file
index 996718f8acb051fb8f71004c0f38e18349af88cb..155a47626c733a26d6d2b55f3e1ade7c79cd461f 100644 (file)
--- a/o/alloc.c
+++ b/o/alloc.c
@@ -68,7 +68,7 @@ sbrk1(n)
 long starting_hole_div=10;
 long starting_relb_heap_mult=2;
 long new_holepage;
-long resv_pages=40;
+long resv_pages=0;
 
 #ifdef BSD
 #include <sys/time.h>
@@ -186,14 +186,45 @@ int reserve_pages_for_signal_handler=30;
    If not in_signal_handler then try to keep a minimum of
    reserve_pages_for_signal_handler pages on hand in the hole
  */
+
+inline void
+empty_relblock(void) {
+
+  object o=sSAleaf_collection_thresholdA->s.s_dbind;
+  
+  sSAleaf_collection_thresholdA->s.s_dbind=make_fixnum(0);
+  for (;rb_pointer!=rb_start&&rb_pointer!=rb_end;)
+    GBC(t_relocatable);
+  sSAleaf_collection_thresholdA->s.s_dbind=o;
+
+}
+
+inline void
+resize_hole(ufixnum hp,enum type tp) {
+  
+  char *new_start=heap_end+hp*PAGESIZE;
+  char *start=rb_pointer<rb_end ? rb_start : rb_end;
+  ufixnum size=rb_pointer-start;
+
+  if ((new_start<start && new_start+size>=start) || (new_start<start+size && new_start+size>=start+size)) {
+    fprintf(stderr,"Toggling relblock when resizing hole to %lu\n",hp);
+    fflush(stderr);
+    tm_table[t_relocatable].tm_adjgbccnt--;
+    GBC(t_relocatable);
+    return resize_hole(hp,tp);
+  }
+
+  holepage=hp;
+  tm_of(tp)->tm_adjgbccnt--;
+  GBC(tp);
+  
+}
+
 inline void *
 alloc_page(long n) {
 
-  void *e=heap_end;
   fixnum d,m;
-#ifdef SGC
-  int in_sgc=sgc_enabled;
-#endif
+
   if (n>=0) {
 
     if (n>(holepage - (in_signal_handler? 0 :
@@ -215,25 +246,8 @@ eg to add 20 more do (si::set-hole-size %ld %d)\n...start over ",
       d=d<0 ? 0 : d;
       d=new_holepage<d ? new_holepage : d;
       
-      holepage = d + n;
-
-#ifdef SGC
-      if (in_sgc) sgc_quit();
-#endif
-
-      GBC(t_relocatable);
-      tm_table[t_relocatable].tm_adjgbccnt--;/* hole overrun is not a call for more relocatable */
-
+      resize_hole(d+n,t_relocatable);
 
-#ifdef SGC
-      /* starting sgc can use up some pages
-        and may move heap end, so start over
-      */
-      if (in_sgc) {
-       sgc_start();
-       return alloc_page(n);
-      }
-#endif
     }
 
     holepage -= n;
@@ -244,9 +258,12 @@ eg to add 20 more do (si::set-hole-size %ld %d)\n...start over ",
       core_end+=PAGESIZE*n;
     }
 
-    heap_end+=PAGESIZE*n;
+    {
+      void *e=heap_end;
+      heap_end+=PAGESIZE*n;
 
-    return(e);
+      return(e);
+    }
 
   }
 
@@ -256,13 +273,13 @@ eg to add 20 more do (si::set-hole-size %ld %d)\n...start over ",
   m=(core_end-heap_end)/PAGESIZE;
 
   if (n<=m)
-    return(e);
+    return(heap_end);
 
   IF_ALLOCATE_ERR error("Can't allocate.  Good-bye!");
 
   core_end+=PAGESIZE*(n-m);
 
-  return(e);
+  return(heap_end);
 
 }
 
@@ -272,16 +289,37 @@ eg to add 20 more do (si::set-hole-size %ld %d)\n...start over ",
 
 struct pageinfo *cell_list_head=NULL,*cell_list_tail=NULL;;
 
+inline ufixnum
+sum_maxpages(void) {
+
+  ufixnum i,j;
+
+  for (i=t_start,j=0;i<t_other;i++)
+    j+=tm_table[i].tm_maxpage;
+
+  return j+tm_table[t_relocatable].tm_maxpage;
+
+}
+
+fixnum
+check_avail_pages(void) {
+  
+  return real_maxpage-page(data_start ? data_start : sbrk(0))-available_pages-resv_pages-sum_maxpages();
+
+}
+
+
 inline fixnum
 set_tm_maxpage(struct typemanager *tm,fixnum n) {
   
   fixnum r=tm->tm_type==t_relocatable,j=tm->tm_maxpage,z=(n-j)*(r ? 2 : 1);
   if (z>available_pages) return 0;
-  if (r && 2*n+page(REAL_RB_START)>real_maxpage) return 0;
+  if (r && 2*n+page(rb_start)>real_maxpage) return 0;
   available_pages-=z;
-  tm->tm_adjgbccnt*=((double)j)/n;
+  tm->tm_adjgbccnt*=((double)j+1)/(n+1);
   tm->tm_maxpage=n;
-  return n;
+  /* massert(!check_avail_pages()); */
+  return 1;
 }
   
 
@@ -317,8 +355,11 @@ add_page_to_freelist(char *p, struct typemanager *tm) {
 
  if (sgc_enabled && tm->tm_sgc)
    pp->sgc_flags=SGC_PAGE_FLAG;
+
+#ifndef SGC_WHOLE_PAGE
  if (TYPEWORD_TYPE_P(pp->type))
    x->d.s=(sgc_enabled && tm->tm_sgc) ? SGC_RECENT : SGC_NORMAL;
+#endif
 
  /* array headers must be always writable, since a write to the
     body does not touch the header.   It may be desirable if there
@@ -410,17 +451,61 @@ grow_linear(fixnum old, fixnum fract, fixnum grow_min, fixnum grow_max,fixnum ma
 DEFVAR("*OPTIMIZE-MAXIMUM-PAGES*",sSAoptimize_maximum_pagesA,SI,sLnil,"");
 #define OPTIMIZE_MAX_PAGES (sSAoptimize_maximum_pagesA ==0 || sSAoptimize_maximum_pagesA->s.s_dbind !=sLnil) 
 DEFVAR("*NOTIFY-OPTIMIZE-MAXIMUM-PAGES*",sSAnotify_optimize_maximum_pagesA,SI,sLnil,"");
-#define MMAX_PG(a_) (a_)->tm_maxpage
+#define MMAX_PG(a_) (a_)->tm_maxpage-(a_)->tm_alt_npage
+
+static int
+rebalance_maxpages(struct typemanager *my_tm,fixnum z) {
+
+  fixnum d;
+  ufixnum i,j;
+  
+  
+  d=(z-my_tm->tm_maxpage)*(my_tm->tm_type==t_relocatable ? 2 : 1);
+  j=sum_maxpages();
+
+  if (j+d>phys_pages) {
+
+    ufixnum k=0;
+
+    for (i=t_start;i<t_other;i++)
+      if (tm_table+i!=my_tm)
+       k+=(tm_table[i].tm_maxpage-tm_table[i].tm_npage)*(i==t_relocatable ? 2 : 1);
+
+    d=d>k+phys_pages-j ? k+phys_pages-j : d;
+    if (d<=0)
+      return 0;
+
+    for (i=t_start;i<t_other;i++)
+      if (tm_table[i].tm_npage) {
+       if (tm_table+i==my_tm) {
+         massert(set_tm_maxpage(tm_table+i,z));
+       } else {
+         massert(set_tm_maxpage(tm_table+i,tm_table[i].tm_npage+(1.0-(double)(j+d-phys_pages)/k)*(tm_table[i].tm_maxpage-tm_table[i].tm_npage)));
+       }
+      }
+    
+    /* for (i=t_start;i<t_other;i++) */
+    /*   if (tm_table[i].tm_npage && tm_table[i].tm_npage>((double)phys_pages/(j+d))*(tm_table+i==my_tm ? z : tm_table[i].tm_maxpage)) */
+    /*         return 0; */
+    /* for (i=t_start;i<t_other;i++) */
+    /*   if (tm_table[i].tm_npage) */
+    /*         massert(set_tm_maxpage(tm_table+i,((double)phys_pages/(j+d))*(tm_table+i==my_tm ? z : tm_table[i].tm_maxpage))); */
+
+    return 1;
+    
+  } else
+
+    return set_tm_maxpage(my_tm,z);
+
+}
+
 inline long
 opt_maxpage(struct typemanager *my_tm) {
 
   double x=0.0,y=0.0,z,r;
   long mmax_page;
   struct typemanager *tm,*tme;
-  long mro=0,tro=0;
-
-  if (phys_pages>0 && page(heap_end)-first_data_page+nrbpage>=phys_pages)
-    return 0;
+  long mro=0,tro=0,j;
 
   if (page(core_end)>0.8*real_maxpage)
     return 0;
@@ -437,22 +522,27 @@ opt_maxpage(struct typemanager *my_tm) {
   }
 #endif
 
-  z=my_tm->tm_adjgbccnt-1;
+  z=my_tm->tm_adjgbccnt/* -1 */;
   z/=(1+x-0.9*my_tm->tm_adjgbccnt);
   z*=(y-mmax_page)*mmax_page;
   z=sqrt(z);
   z=z-mmax_page>available_pages ? mmax_page+available_pages : z;
-  my_tm->tm_opt_maxpage=(long)z>my_tm->tm_opt_maxpage ? (long)z : my_tm->tm_opt_maxpage;
+  my_tm->tm_opt_maxpage=(long)(z+my_tm->tm_alt_npage)>my_tm->tm_opt_maxpage ? (long)(z+my_tm->tm_alt_npage) : my_tm->tm_opt_maxpage;
 
   if (z<=mmax_page)
     return 0;
 
   r=((x-my_tm->tm_adjgbccnt)+ my_tm->tm_adjgbccnt*mmax_page/z)*(y-mmax_page+z);
   r/=x*y;
+
+  j=r<=0.95 && rebalance_maxpages(my_tm,z+mro+my_tm->tm_alt_npage);
+
   if (sSAnotify_optimize_maximum_pagesA->s.s_dbind!=sLnil)
-    printf("[type %u max %lu(%lu) opt %lu   y %lu(%lu) gbcrat %f sav %f]\n",
-          my_tm->tm_type,mmax_page,mro,(long)z,(long)y,tro,(my_tm->tm_adjgbccnt-1)/(1+x-0.9*my_tm->tm_adjgbccnt),r);
-  return r<=0.95 && set_tm_maxpage(my_tm,z+mro) ? 1 : 0;
+    printf("[type %u max %lu(%lu) opt %lu   y %lu(%lu) gbcrat %f sav %f  new %lu sum %lu phys %lu]\n",
+          my_tm->tm_type,mmax_page,mro,(long)z,(long)y,tro,(my_tm->tm_adjgbccnt/* -1 */)/(1+x-0.9*my_tm->tm_adjgbccnt),r,
+          my_tm->tm_maxpage,sum_maxpages(),phys_pages);
+
+  return j ? 1 : 0;
 
 }
 
@@ -483,41 +573,200 @@ Use ALLOCATE to expand the space.",
 #else
 #define TOTAL_THIS_TYPE(tm) (tm->tm_nppage * tm->tm_npage)
 #endif
-bool prefer_low_mem_contblock=FALSE;
+
+static object cbv=Cnil;
+#define cbsrch1 ((struct contblock ***)cbv->v.v_self)
+#define cbsrche (cbsrch1+cbv->v.v_fillp)
+
+static inline void
+expand_contblock_index_space(void) {
+
+  if (cbv==Cnil) {
+    cbv=(VFUN_NARGS=4,fSmake_vector1(make_fixnum(16),make_fixnum(aet_fix),Cnil,make_fixnum(0)));
+    cbv->v.v_self[0]=(object)&cb_pointer;
+    enter_mark_origin(&cbv);
+  }
+
+  if (cbv->v.v_fillp+1==cbv->v.v_dim) {
+
+    void *v=alloc_relblock(2*cbv->v.v_dim*sizeof(fixnum));
+
+    memcpy(v,cbv->v.v_self,cbv->v.v_dim*sizeof(fixnum));
+    cbv->v.v_self=v;
+    cbv->v.v_dim*=2;
+
+  }
+
+}
+
+static inline void *
+expand_contblock_index(struct contblock ***cbppp) {
+
+  ufixnum i=cbppp-cbsrch1;
+
+  expand_contblock_index_space();
+
+  cbppp=cbsrch1+i;
+  memmove(cbppp+1,cbppp,(cbsrche-cbppp+1)*sizeof(*cbppp));
+  cbv->v.v_fillp++;
+
+  return cbppp;
+
+}
+
+static inline void
+contract_contblock_index(struct contblock ***cbppp) {
+
+  memmove(cbppp+1,cbppp+2,(cbsrche-cbppp-1)*sizeof(*cbppp));
+  cbv->v.v_fillp--;
+
+}
+
+static inline int
+cbcomp(const void *v1,const void *v2) {
+
+  ufixnum u1=(**(struct contblock ** const *)v1)->cb_size;
+  ufixnum u2=(**(struct contblock ** const *)v2)->cb_size;
+
+  return u1<u2 ? -1 : (u1==u2 ? 0 : 1);
+
+}
+
+static inline void *
+bsearchleq(void *i,void *v1,size_t n,size_t s,int (*c)(const void *,const void *)) {
+
+  ufixnum nn=n>>1;
+  void *v=v1+nn*s;
+  int j=c(i,v);
+
+  if (nn)
+    return !j ? v : (j>0 ? bsearchleq(i,v,n-nn,s,c) : bsearchleq(i,v1,nn,s,c));
+  else
+    return j<=0 ? v : v+s;
+
+}
+                    
+
+static inline struct contblock ***
+find_cbppp(struct contblock *cbp) {
+
+  struct contblock **cbpp=&cbp;
+
+  return cbsrche==cbsrch1 ? cbsrch1 : bsearchleq(&cbpp,cbsrch1,cbsrche-cbsrch1,sizeof(*cbsrch1),cbcomp);
+
+}
+
+static inline struct contblock ***
+find_cbppp_by_n(ufixnum n) {
+
+  struct contblock cb={n,NULL};
+
+  return find_cbppp(&cb);
+
+}
+
+static inline struct contblock **
+find_cbpp(struct contblock ***cbppp,ufixnum n) {
+
+  return *cbppp;
+
+}
+
+
+static inline struct contblock **
+find_contblock(ufixnum n,void **p) {
+
+  *p=find_cbppp_by_n(n);
+  return find_cbpp(*p,n);
+}
+
+inline void
+print_cb(int print) {
+
+  struct contblock *cbp,***cbppp,**cbpp=&cb_pointer;
+  ufixnum k;
+  
+  for (cbp=cb_pointer,cbppp=cbsrch1;cbp;cbppp++) {
+    massert(cbppp<cbsrche);
+    massert(*cbppp);
+    massert(**cbppp==cbp);
+    for (k=0;cbp && cbp->cb_size==(**cbppp)->cb_size;cbpp=&cbp->cb_link,cbp=cbp->cb_link,k++);
+    if (print)
+      fprintf(stderr,"%lu %p %p %lu %lu\n",cbppp-cbsrch1,*cbppp,**cbppp,(**cbppp)->cb_size,k);
+  }
+  massert(cbppp==cbsrche);
+  massert(*cbppp==cbpp);
+  massert(!**cbppp);
+
+  fflush(stderr);
+
+}
+  
+inline void
+insert_contblock(void *p,ufixnum s) {
+
+  struct contblock *cbp=p,**cbpp,***cbppp;
+
+  cbpp=find_contblock(s,(void **)&cbppp);
+
+  cbp->cb_size=s;
+  cbp->cb_link=*cbpp;
+  *cbpp=cbp;
+  
+  if ((!cbp->cb_link || cbp->cb_link->cb_size!=s)) {
+    cbppp=expand_contblock_index(cbppp);
+    cbppp[1]=&cbp->cb_link;
+  }
+
+}
+
+static inline void
+delete_contblock(void *p,struct contblock **cbpp) {
+
+  struct contblock ***cbppp=p;
+  ufixnum s=(*cbpp)->cb_size;
+
+  (*cbpp)=(*cbpp)->cb_link;
+
+  if ((!(*cbpp) || (*cbpp)->cb_size!=s))
+    contract_contblock_index(cbppp);
+
+}
+
+inline void
+reset_contblock_freelist(void) {
+
+  cb_pointer=NULL;
+  cbv->v.v_fillp=0;
+  
+}
 
 inline void *
 alloc_from_freelist(struct typemanager *tm,fixnum n) {
 
-  void *p,*v,*vp;
-  struct contblock **cbpp;
-  fixnum i;
+  void *p;
 
   switch (tm->tm_type) {
 
   case t_contiguous:
-    for (cbpp= &cb_pointer,v=(void *)-1,vp=NULL; (*cbpp)!=NULL; cbpp= &(*cbpp)->cb_link)
-      if ((*cbpp)->cb_size >= n) {
-       if (!prefer_low_mem_contblock) {
-         vp=cbpp;
-         break;
-       } else if ((void *)(*cbpp)<v) {
-         v=*cbpp;
-         vp=cbpp;
-       }
+    {
+      void *pp;
+      struct contblock **cbpp=find_contblock(n,&pp);
+      
+      if ((p=*cbpp)) {
+       ufixnum s=(*cbpp)->cb_size;
+       delete_contblock(pp,cbpp);
+       if (n<s)
+         insert_contblock(p+n,s-n);
       }
-    if (vp) {
-      cbpp=vp;
-      p=(void *)(*cbpp);
-      i=(*cbpp)->cb_size-n;
-      *cbpp=(*cbpp)->cb_link;
-      --ncb;
-      insert_contblock(p+n,i);
-      return(p);
+      return p;
     }
     break;
 
   case t_relocatable:
-    if (rb_limit-rb_pointer>=n)
+    if (rb_pointer>rb_end && rb_pointer+n>rb_limit && rb_pointer+n<rb_end+nrbpage*PAGESIZE)
+      rb_limit=rb_pointer+n;
+    if (rb_limit-rb_pointer>n)
       return ((rb_pointer+=n)-n);
     break;
 
@@ -554,7 +803,7 @@ too_full_p(struct typemanager *tm) {
 
   switch (tm->tm_type) {
   case t_relocatable:
-    return 100*(rb_limit-rb_pointer)<pf*(rb_limit-rb_start);
+    return 100*(rb_limit-rb_pointer)<pf*(rb_end-rb_start);
     break;
   case t_contiguous:
     for (cbp=cb_pointer,k=0;cbp;cbp=cbp->cb_link) k+=cbp->cb_size;
@@ -575,7 +824,7 @@ too_full_p(struct typemanager *tm) {
 inline void *
 alloc_after_gc(struct typemanager *tm,fixnum n) {
 
-  if (tm->tm_npage+tpage(tm,n)>=tm->tm_maxpage && GBC_enable) {
+  if (tm->tm_npage+tpage(tm,n)>tm->tm_maxpage && GBC_enable) {
 
     switch (jmp_gmp) {
     case 0: /* not in gmp call*/
@@ -618,11 +867,16 @@ add_pages(struct typemanager *tm,fixnum m) {
 
   case t_relocatable:
 
+    if (rb_pointer>rb_end) {
+      fprintf(stderr,"Moving relblock low before expanding relblock pages\n");
+      fflush(stderr);
+      GBC(t_relocatable);
+    }
     nrbpage+=m;
-    rb_end=heap_end+(holepage+nrbpage)*PAGESIZE;
-    rb_limit=rb_end-2*RB_GETA;
+    rb_end+=m*PAGESIZE;
+    rb_limit+=m*PAGESIZE;
 
-    alloc_page(-(nrbpage+holepage));
+    alloc_page(-(2*nrbpage+holepage));
 
     break;
 
@@ -656,7 +910,7 @@ alloc_after_adding_pages(struct typemanager *tm,fixnum n) {
 
   }
 
-  m=tm->tm_maxpage-tm->tm_npage;
+  /* m=tm->tm_maxpage-tm->tm_npage; */
   add_pages(tm,m);
 
   return alloc_from_freelist(tm,n);
@@ -670,15 +924,15 @@ alloc_after_reclaiming_pages(struct typemanager *tm,fixnum n) {
 
   if (tm->tm_type>=t_end) return NULL;
 
-  reloc_min=npage(rb_pointer-REAL_RB_START);
+  reloc_min=npage(rb_pointer-rb_start);
 
   if (m<2*(nrbpage-reloc_min)) {
 
     set_tm_maxpage(tm_table+t_relocatable,reloc_min);
     nrbpage=reloc_min;
 
-    GBC(t_relocatable);
     tm_table[t_relocatable].tm_adjgbccnt--;
+    GBC(t_relocatable);
 
     return alloc_after_adding_pages(tm,n);
 
@@ -742,13 +996,31 @@ alloc_object(enum type t)  {
 
 inline void *
 alloc_contblock(size_t n) {
-  return alloc_mem(tm_of(t_contiguous),ROUND_UP_PTR_CONT(n));
+  return alloc_mem(tm_of(t_contiguous),CEI(n,CPTR_SIZE));
+}
+
+inline void *
+alloc_contblock_no_gc(size_t n) {
+
+  struct typemanager *tm=tm_of(t_contiguous);
+  void *p;
+  
+  n=CEI(n,CPTR_SIZE);
+  
+  if ((p=alloc_from_freelist(tm,n)))
+    return p;
+
+  if (tpage(tm,n)<(rb_start-heap_end)>>PAGEWIDTH && (p=alloc_after_adding_pages(tm,n)))
+    return p;
+
+  return NULL;
+
 }
 
 inline void *
 alloc_relblock(size_t n) {
 
-  return alloc_mem(tm_of(t_relocatable),ROUND_UP_PTR(n));
+  return alloc_mem(tm_of(t_relocatable),CEI(n,PTR_ALIGN));
 
 }
 
@@ -789,7 +1061,7 @@ DEFUNM_NEW("ALLOCATED",object,fSallocated,SI,1,1,NONE,OO,OO,OO,OO,(object typ),"
   tm = & tm_table[tm->tm_type];
   if (tm->tm_type == t_relocatable)
     { tm->tm_npage = (rb_end-rb_start)/PAGESIZE;
-      tm->tm_nfree = rb_end -rb_pointer;
+      tm->tm_nfree = rb_limit -rb_pointer;
     }
   else if (tm->tm_type == t_contiguous)
     { int cbfree =0;
@@ -808,45 +1080,6 @@ DEFUNM_NEW("ALLOCATED",object,fSallocated,SI,1,1,NONE,OO,OO,OO,OO,(object typ),"
             ));
 }
  
-/* DEFUN_NEW("RESET-NUMBER-USED",object,fSreset_number_used,SI,0,1,NONE,OO,OO,OO,OO,(object typ),"") */
-/* {int i; */
-/*  if (VFUN_NARGS == 1) */
-/*    { tm_table[t_from_type(typ)].tm_nused = 0;} */
-/*  else */
-/*  for (i=0; i <= t_relocatable ; i++) */
-/*    { tm_table[i].tm_nused = 0;} */
-/*   RETURN1(sLnil); */
-/* } */
-
-#define IN_CONTBLOCK_P(p,pi) ((void *)p>=(void *)pi && (void *)p<(void *)pi+pi->in_use*PAGESIZE)
-
-/* SGC cont pages: explicit free calls can come at any time, and we
-   must make sure to add the newly deallocated block to the right
-   list.  CM 20030827*/
-#ifdef SGC
-void
-insert_maybe_sgc_contblock(char *p,int s) {
-
-  struct contblock *tmp_cb_pointer;
-  struct pageinfo *pi;
-
-  for (pi=contblock_list_head;pi && !IN_CONTBLOCK_P(p,pi);pi=pi->next);
-  massert(pi);
-
-  if (sgc_enabled && ! (pi->sgc_flags&SGC_PAGE_FLAG)) {
-    tmp_cb_pointer=cb_pointer;
-    cb_pointer=old_cb_pointer;
-    sgc_enabled=0;
-    insert_contblock(p,s);
-    sgc_enabled=1;
-    old_cb_pointer=cb_pointer;
-    cb_pointer=tmp_cb_pointer;
-  } else
-    insert_contblock(p,s);
-
-}
-#endif
-
 #ifdef SGC_CONT_DEBUG
 extern void overlap_check(struct contblock *,struct contblock *);
 #endif
@@ -856,78 +1089,17 @@ DEFUN_NEW("PRINT-FREE-CONTBLOCK-LIST",object,fSprint_free_contblock_list,SI,0,0,
   struct contblock *cbp,*cbp1;
 
   for (cbp=cb_pointer;cbp;cbp=cbp->cb_link) {
-    printf("%p %d\n",cbp,cbp->cb_size);
+    printf("%p %lu\n",cbp,cbp->cb_size);
     for (cbp1=cbp;cbp1;cbp1=cbp1->cb_link) 
       if ((void *)cbp+cbp->cb_size==(void *)cbp1 ||
          (void *)cbp1+cbp1->cb_size==(void *)cbp)
-       printf("  adjacent to %p %d\n",cbp1,cbp1->cb_size);
+       printf("  adjacent to %p %lu\n",cbp1,cbp1->cb_size);
   }
 
   return Cnil;
 
 }
 
-void
-insert_contblock(char *p, int s) {
-
-  struct contblock **cbpp, *cbp;
-  
-  /* SGC cont pages: This used to return when s<CBMINSIZE, but we need
-     to be able to sweep small (e.g. bignum) contblocks.  FIXME:
-     should never be called with s<=0 to begin with.  CM 20030827*/
-  if (s<=0)
-    return;
-  ncb++;
-  cbp = (struct contblock *)p;
-  /* SGC cont pages: allocated sizes may not be zero mod CPTR_SIZE,
-     e.g. string fillp, but alloc_contblock rounded up the allocation
-     like this, which we follow here.  CM 20030827 */
-  cbp->cb_size = ROUND_UP_PTR_CONT(s);
-
-  for (cbpp=&cb_pointer;*cbpp;) {
-    if ((void *)(*cbpp)+(*cbpp)->cb_size==(void *)cbp) {
-      /* printf("Merge contblock %p %d %p %d\n",cbp,cbp->cb_size,*cbpp,(*cbpp)->cb_size); */
-      /* fflush(stdout); */
-      (*cbpp)->cb_size+=cbp->cb_size;
-      cbp=*cbpp;
-      *cbpp=(*cbpp)->cb_link;
-    } else if ((void *)(*cbpp)==(void *)cbp+cbp->cb_size) {
-      /* printf("Merge contblock %p %d %p %d\n",cbp,cbp->cb_size,*cbpp,(*cbpp)->cb_size); */
-      /* fflush(stdout); */
-      cbp->cb_size+=(*cbpp)->cb_size;
-      *cbpp=(*cbpp)->cb_link;
-    } else
-      cbpp=&(*cbpp)->cb_link;
-  }
-  s=cbp->cb_size;
-  
-  for (cbpp = &cb_pointer;  *cbpp;  cbpp = &((*cbpp)->cb_link))
-    if ((*cbpp)->cb_size >= s) {
-#ifdef SGC_CONT_DEBUG
-      if (*cbpp==cbp) {
-       fprintf(stderr,"Trying to install a circle at %p\n",cbp);
-       exit(1);
-      }
-      if (sgc_enabled) 
-       overlap_check(old_cb_pointer,cb_pointer);
-#endif
-      cbp->cb_link = *cbpp;
-      *cbpp = cbp;
-#ifdef SGC_CONT_DEBUG
-      if (sgc_enabled) 
-       overlap_check(old_cb_pointer,cb_pointer);
-#endif
-      return;
-    }
-  cbp->cb_link = NULL;
-  *cbpp = cbp;
-#ifdef SGC_CONT_DEBUG
-  if (sgc_enabled) 
-    overlap_check(old_cb_pointer,cb_pointer);
-#endif
-
-}
-
 /* Add a tm_distinct field to prevent page type sharing if desired.
    Not used now, as its never desirable from an efficiency point of
    view, and as the only known place one must separate is cons and
@@ -961,7 +1133,7 @@ init_tm(enum type t, char *name, int elsize, int nelts, int sgc,int distinct) {
     return;
   }
   tm_table[(int)t].tm_type = t;
-  tm_table[(int)t].tm_size = elsize ? ROUND_UP_PTR(elsize) : 1;
+  tm_table[(int)t].tm_size = elsize ? CEI(elsize,PTR_ALIGN) : 1;
   tm_table[(int)t].tm_nppage = (PAGESIZE-sizeof(struct pageinfo))/tm_table[(int)t].tm_size;
   tm_table[(int)t].tm_free = OBJNULL;
   tm_table[(int)t].tm_nfree = 0;
@@ -1096,13 +1268,19 @@ gcl_init_alloc(void *cs_start) {
 
   update_real_maxpage();
 
-  if (gcl_alloc_initialized) return;
+  if (gcl_alloc_initialized) {
+    massert(rb_start==heap_end &&rb_end==heap_end && rb_limit==heap_end && rb_pointer==heap_end);
+    holepage=new_holepage;
+    alloc_page(-holepage);
+    rb_start=rb_end=rb_limit=rb_pointer=heap_end+(holepage<<PAGEWIDTH);
+    return;
+  }
   
 #ifdef INIT_ALLOC  
   INIT_ALLOC;
 #endif  
 
-  data_start=heap_end;
+  initial_sbrk=data_start=heap_end;
   first_data_page=page(data_start);
   
   holepage=new_holepage;
@@ -1118,40 +1296,39 @@ gcl_init_alloc(void *cs_start) {
      Gave each page type at least some sgc pages by default.  Of
      course changeable by allocate-sgc.  CM 20030827 */
 
-  init_tm(t_cons, ".CONS", sizeof(struct cons), 65536 ,50,0 );
-  init_tm(t_fixnum, "NFIXNUM",sizeof(struct fixnum_struct), 8192,20,0);
-  init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure), 5461,1,0 );
-  init_tm(t_cfun, "fCFUN", sizeof(struct cfun), 4096,1,0  );
-  init_tm(t_sfun, "gSFUN", sizeof(struct sfun),409,1,0 );
-  init_tm(t_string, "\"STRING", sizeof(struct string), 5461,1,0  );
-  init_tm(t_array, "aARRAY", sizeof(struct array), 4681,1,0 );
-  init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol), 3640,1,0 );
-  init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum), 2730,1,0 );
-  init_tm(t_ratio, "RRATIONAL", sizeof(struct ratio), 170,1,0 );
-  init_tm(t_shortfloat, "FSHORT-FLOAT",sizeof(struct shortfloat_struct), 256 ,1,0);
-  init_tm(t_longfloat, "LLONG-FLOAT",sizeof(struct longfloat_struct), 170 ,1,0);
-  init_tm(t_complex, "CCOMPLEX", sizeof(struct ocomplex), 170 ,1,0);
-  init_tm(t_character,"#CHARACTER",sizeof(struct character), 256 ,1,0);
-  init_tm(t_package, ":PACKAGE", sizeof(struct package), 2*PAGESIZE / sizeof(struct package),1,0);
-  init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct hashtable), 78,1,0 );
-  init_tm(t_vector, "vVECTOR", sizeof(struct vector), 146 ,1,0);
-  init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct bitvector), 73 ,1,0);
-  init_tm(t_stream, "sSTREAM", sizeof(struct stream), 78 ,1,0);
-  init_tm(t_random, "$RANDOM-STATE", sizeof(struct random), 256 ,1,0);
-  init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable), 256 ,1,0);
-  init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname), 73 ,1,0);
-  init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure), 85 ,1,0);
-  init_tm(t_closure, "cCLOSURE", sizeof(struct cclosure), 85 ,1,0);
-  init_tm(t_vfun, "VVFUN", sizeof(struct vfun), 102 ,1,0);
+  init_tm(t_cons, ".CONS", sizeof(struct cons), 0 ,50,0 );
+  init_tm(t_fixnum, "NFIXNUM",sizeof(struct fixnum_struct), 0,20,0);
+  init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure),0,1,0 );
+  init_tm(t_cfun, "fCFUN", sizeof(struct cfun),0,1,0  );
+  init_tm(t_sfun, "gSFUN", sizeof(struct sfun),0,1,0 );
+  init_tm(t_string, "\"STRING", sizeof(struct string),0,1,0  );
+  init_tm(t_array, "aARRAY", sizeof(struct array),0,1,0 );
+  init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol),0,1,0 );
+  init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum),0,1,0 );
+  init_tm(t_ratio, "RRATIONAL", sizeof(struct ratio),0,1,0 );
+  init_tm(t_shortfloat, "FSHORT-FLOAT",sizeof(struct shortfloat_struct),0 ,1,0);
+  init_tm(t_longfloat, "LLONG-FLOAT",sizeof(struct longfloat_struct),0 ,1,0);
+  init_tm(t_complex, "CCOMPLEX", sizeof(struct ocomplex),0 ,1,0);
+  init_tm(t_character,"#CHARACTER",sizeof(struct character),0 ,1,0);
+  init_tm(t_package, ":PACKAGE", sizeof(struct package),0,1,0);
+  init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct hashtable),0,1,0 );
+  init_tm(t_vector, "vVECTOR", sizeof(struct vector),0 ,1,0);
+  init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct bitvector),0 ,1,0);
+  init_tm(t_stream, "sSTREAM", sizeof(struct stream),0 ,1,0);
+  init_tm(t_random, "$RANDOM-STATE", sizeof(struct random),0 ,1,0);
+  init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable),0 ,1,0);
+  init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname),0 ,1,0);
+  init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure),0 ,1,0);
+  init_tm(t_closure, "cCLOSURE", sizeof(struct closure),0 ,1,0);
+  init_tm(t_vfun, "VVFUN", sizeof(struct vfun),0 ,1,0);
   init_tm(t_gfun, "gGFUN", sizeof(struct sfun), 0 ,1,0);
   init_tm(t_afun, "AAFUN", sizeof(struct sfun), 0 ,1,0);
-  init_tm(t_cfdata, "cCFDATA", sizeof(struct cfdata), 102 ,1,0);
-  init_tm(t_spice, "!SPICE", sizeof(struct spice), 4096 ,1,0);
+  init_tm(t_cfdata, "cCFDATA", sizeof(struct cfdata),0 ,1,0);
+  init_tm(t_spice, "!SPICE", sizeof(struct spice),0 ,1,0);
   init_tm(t_relocatable, "%RELOCATABLE-BLOCKS", 0,0,20,1);
   init_tm(t_contiguous, "_CONTIGUOUS-BLOCKS", 0,0,20,1);
   
   
-  ncb = 0;
   ncbpage = 0;
   set_tm_maxpage(tm_table+t_contiguous,1);
 #ifdef GCL_GPROF
@@ -1162,7 +1339,7 @@ gcl_init_alloc(void *cs_start) {
   set_tm_maxpage(tm_table+t_relocatable,1);
   nrbpage=0;
 
-  alloc_page(-(holepage + nrbpage));
+  alloc_page(-(holepage + 2*nrbpage));
   
   rb_start = rb_pointer = heap_end + PAGESIZE*holepage;
   rb_end = rb_start + PAGESIZE*nrbpage;
@@ -1171,6 +1348,8 @@ gcl_init_alloc(void *cs_start) {
   tm_table[(int)t_relocatable].tm_sgc = 50;
 #endif
   
+  expand_contblock_index_space();
+
   gcl_alloc_initialized=1;
   
 }
@@ -1554,7 +1733,7 @@ static char *baby_malloc(n)
 {
   char *res= last_baby;
   int m;
-  n = ROUND_UP_PTR(n);
+  n = CEI(n,PTR_ALIGN);
    m = n+ sizeof(int);
   if ((res +m-baby_malloc_data) > sizeof(baby_malloc_data))
     {
@@ -1642,11 +1821,11 @@ free(void *ptr) {
   for (p = &malloc_list,pp=*p; pp && !endp(pp);  p = &((pp)->c.c_cdr),pp=pp->c.c_cdr)
     if ((pp)->c.c_car->st.st_self == ptr) {
       /* SGC contblock pages: Its possible this is on an old page CM 20030827 */
-#ifdef SGC
-      insert_maybe_sgc_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim);
-#else
-      insert_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim);
-#endif
+/* #ifdef SGC */
+/*       insert_maybe_sgc_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim); */
+/* #else */
+/*       insert_contblock((pp)->c.c_car->st.st_self,(pp)->c.c_car->st.st_dim); */
+/* #endif */
       (pp)->c.c_car->st.st_self = NULL;
       *p = pp->c.c_cdr;
 #ifdef GCL_GPROF
@@ -1707,11 +1886,11 @@ realloc(void *ptr, size_t size) {
        for (i = 0;  i < size;  i++)
          x->st.st_self[i] = ((char *)ptr)[i];
 /* SGC contblock pages: Its possible this is on an old page CM 20030827 */
-#ifdef SGC
-       insert_maybe_sgc_contblock(ptr, j);
-#else
-       insert_contblock(ptr, j);
-#endif
+/* #ifdef SGC */
+/*     insert_maybe_sgc_contblock(ptr, j); */
+/* #else */
+/*     insert_contblock(ptr, j); */
+/* #endif */
        return(x->st.st_self);
       }
     }
index 70362a1e730d5b8086d17c32cf08dc2cc89c5bf7..bc44f9d7ca5e177a813a5b68b8b37fe3c1c8a9fc 100755 (executable)
--- a/o/array.c
+++ b/o/array.c
@@ -457,15 +457,15 @@ static longfloat DFLT_aet_lf = 0.0;
 static object Iname_t = sLt;
 static struct { char * dflt; object *namep;} aet_types[] =
 {   {(char *)  &DFLT_aet_object,       &Iname_t,},     /*  t  */
-    {(char *)  &DFLT_aet_ch, &sLstring_char,},/*  string-char  */
+    {(char *)  &DFLT_aet_ch, &sLcharacter,},/*  character  */
     {(char *)  &DFLT_aet_fix, &sLbit,},                /*  bit  */
     {(char *)  &DFLT_aet_fix,  &sLfixnum,},    /*  fixnum  */
     {(char *)  &DFLT_aet_sf, &sLshort_float,},                 /*  short-float  */
     {(char *)  &DFLT_aet_lf, &sLlong_float,},  /*  long-float  */
-    {(char *)  &DFLT_aet_char,&sLsigned_char,},               /* signed char */
-    {(char *)    &DFLT_aet_char,&sLunsigned_char,},               /* unsigned char */
-    {(char *)  &DFLT_aet_short,&sLsigned_short,},              /* signed short */
-    {(char *)  &DFLT_aet_short, &sLunsigned_short},    /*  unsigned short   */
+    {(char *)  &DFLT_aet_char,&sSsigned_char,},               /* signed char */
+    {(char *)   &DFLT_aet_char,&sSunsigned_char,},               /* unsigned char */
+    {(char *)  &DFLT_aet_short,&sSsigned_short,},              /* signed short */
+    {(char *)  &DFLT_aet_short, &sSunsigned_short},    /*  unsigned short   */
        };
 
 DEFUN_NEW("GET-AELTTYPE",object,fSget_aelttype,SI,1,1,NONE,OO,OO,OO,OO,(object x),"")
index c592259ceddda2fa2cd5aab2b04639e3c68616a3..f4d04836b98f1f88e6f598632e4163dc978cfab6 100755 (executable)
@@ -172,7 +172,7 @@ DEFUNO_NEW("FSET",object,fSfset,SI
                sym->s.s_mflag = FALSE;
        } else if (car(function) == sLspecial)
                FEerror("Cannot define a special form.", 0);
-       else if (function->c.c_car == sLmacro) {
+       else if (function->c.c_car == sSmacro) {
                sym->s.s_gfdef = function->c.c_cdr;
                sym->s.s_mflag = TRUE;
        } else {
index 50c0fa8b1f8e0282088affd690253c43b5913e33..fd5f2b030dd29ce7ce0f1c0c5a3febc50ccc577b 100755 (executable)
--- a/o/bind.c
+++ b/o/bind.c
@@ -918,8 +918,8 @@ parse_key_new_new(int n, object *base, struct key *keys, object first, va_list a
  /* from here down identical to parse_key_rest */
  new = new + n ;
   {int j=keys->n;
-   object *p= (object *)(keys->defaults);
-   while (--j >=0) base[j]=p[j];
+   object **p= (object **)(keys->defaults);
+   while (--j >=0) base[j]=*(p[j]);
  }
  {if (n==0){ return 0;}
  {int allow = keys->allow_other_keys;
@@ -939,7 +939,7 @@ parse_key_new_new(int n, object *base, struct key *keys, object first, va_list a
      new = new -2;
      k = *new;
      while(--i >= 0)
-       {if ((*(ke++)).o == k)
+       {if (*(*(ke++)).o == k)
          {base[i]= new[1];
           n=n-2;
           goto top;
@@ -1026,8 +1026,7 @@ parse_key_rest_new(object rest, int n, object *base, struct key *keys, object fi
     
  new = new + n ;
   {int j=keys->n;
-   object *p= (object *)(keys->defaults);
-   while (--j >=0) base[j]=p[j];
+   while (--j >=0) base[j]=*keys->defaults[j].o;
  }
  {if (n==0){ return 0;}
  {int allow = keys->allow_other_keys;
@@ -1047,7 +1046,7 @@ parse_key_rest_new(object rest, int n, object *base, struct key *keys, object fi
      new = new -2;
      k = *new;
      while(--i >= 0)
-       {if ((*(ke++)).o == k)
+       {if (*(*(ke++)).o == k)
          {base[i]= new[1];
           n=n-2;
           goto top;
@@ -1066,18 +1065,19 @@ parse_key_rest_new(object rest, int n, object *base, struct key *keys, object fi
   return -1;
 }}}
 
+static object foo[2]={Cnil,OBJNULL};
   
 void
 set_key_struct(struct key *ks, object data)
 {int i=ks->n;
  while (--i >=0)
-   {ks->keys[i].o =   data->cfd.cfd_self[ ks->keys[i].i ];
+   {ks->keys[i].o =   data->cfd.cfd_self+ks->keys[i].i;
     if (ks->defaults != (void *)Cstd_key_defaults)
       {fixnum m=ks->defaults[i].i;
         ks->defaults[i].o=
-         (m==-2 ? Cnil :
-          m==-1 ? OBJNULL :
-          data->cfd.cfd_self[m]);}
+         (m==-2 ? foo :
+          m==-1 ? foo+1 :
+          data->cfd.cfd_self+m);}
 }}
 
 #undef AUX
index 2639d34c1c4538ddbe9c96481b9ca6269a3fe9e5..0b199265540f47386d45851631ad029d783621a8 100755 (executable)
--- a/o/cfun.c
+++ b/o/cfun.c
@@ -306,6 +306,15 @@ make_special_form_internal(char *s, void (*f)())
        return(x);
 }
 
+object
+make_si_special_form_internal(char *s, void (*f)())
+{
+       object x;
+       x = make_si_ordinary(s);
+       x->s.s_sfdef = f;
+       return(x);
+}
+
 DEFUN_NEW("COMPILED-FUNCTION-NAME",object,fScompiled_function_name,SI
    ,1,1,NONE,OO,OO,OO,OO,(object fun),"")
 
index 6d5f1b5b06d3ff16d63a59f3e814d5f33b6f46cf..27156d406cc402c364f5c148d7657d0ec7a5a42a 100755 (executable)
@@ -50,14 +50,6 @@ Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
        @(return Cnil)
 @)
 
-@(defun string_char_p (c)
-@
-       check_type_character(&c);
-       if (char_font(c) != 0 || char_bits(c) != 0)
-               @(return Cnil)
-       @(return Ct)
-@)
-
 @(defun alpha_char_p (c)
        int i;
 @
@@ -358,18 +350,6 @@ BEGIN:
        @(return `make_fixnum(char_code(c))`)
 @)
 
-@(defun char_bits (c)
-@
-       check_type_character(&c);
-       @(return `small_fixnum(char_bits(c))`)
-@)
-
-@(defun char_font (c)
-@
-       check_type_character(&c);
-       @(return `small_fixnum(char_font(c))`)
-@)
-
 @(defun code_char (c &o (b `make_fixnum(0)`) (f `make_fixnum(0)`))
        object x;
 @
@@ -393,29 +373,6 @@ BEGIN:
        @(return x)
 @)
 
-@(defun make_char (c &o (b `make_fixnum(0)`) (f `make_fixnum(0)`))
-       object x;
-       int code;
-@
-       check_type_character(&c);
-       code = char_code(c);
-       check_type_non_negative_integer(&b);
-       check_type_non_negative_integer(&f);
-       if (type_of(b) == t_bignum)
-               @(return Cnil)
-       if (type_of(f) == t_bignum)
-               @(return Cnil)
-       if (fix(b)>=CHBITSLIM || fix(f)>=CHFONTLIM)
-               @(return Cnil)
-       if (fix(b) == 0 && fix(f) == 0)
-               @(return `code_char(code)`)
-       x = alloc_object(t_character);
-       char_code(x) = code;
-       char_bits(x) = fix(b);
-       char_font(x) = fix(f);
-       @(return x)
-@)
-
 @(defun char_upcase (c)
 @
        check_type_character(&c);
@@ -489,30 +446,6 @@ int w, r;
        @(return `make_fixnum(i)`)
 @)
 
-@(defun int_char (x)
-       int i, c, b, f;
-@
-       check_type_non_negative_integer(&x);
-       if (type_of(x) == t_bignum)
-               @(return Cnil)
-       i = fix(x);
-       c = i % CHCODELIM;
-       i /= CHCODELIM;
-       b = i % CHBITSLIM;
-       i /= CHBITSLIM;
-       f = i % CHFONTLIM;
-       i /= CHFONTLIM;
-       if (i > 0)
-               @(return Cnil)
-       if (b == 0 && f == 0)
-               @(return `code_char(c)`)
-       x = alloc_object(t_character);
-       char_code(x) = c;
-       char_bits(x) = b;
-       char_font(x) = f;
-       @(return x)
-@)
-
 @(defun char_name (c)
 @
        check_type_character(&c);
@@ -563,18 +496,6 @@ int w, r;
        @(return Cnil)
 @)
 
-@(defun char_bit (c n)
-@
-       check_type_character(&c);
-       FEerror("Cannot get char-bit of ~S.", 1, c);
-@)
-
-@(defun set_char_bit (c n v)
-@
-       check_type_character(&c);
-       FEerror("Cannot set char-bit of ~S.", 1, c);
-@)
-
 void
 gcl_init_character()
 {
@@ -599,8 +520,8 @@ gcl_init_character()
 #endif
 
        make_constant("CHAR-CODE-LIMIT", make_fixnum(CHCODELIM));
-       make_constant("CHAR-FONT-LIMIT", make_fixnum(CHFONTLIM));
-       make_constant("CHAR-BITS-LIMIT", make_fixnum(CHBITSLIM));
+       make_si_constant("CHAR-FONT-LIMIT", make_fixnum(CHFONTLIM));
+       make_si_constant("CHAR-BITS-LIMIT", make_fixnum(CHBITSLIM));
 
        STreturn = make_simple_string("Return");
        enter_mark_origin(&STreturn);
@@ -620,18 +541,97 @@ gcl_init_character()
        STnewline = make_simple_string("Newline");
        enter_mark_origin(&STnewline);
 
-       make_constant("CHAR-CONTROL-BIT", make_fixnum(0));
-       make_constant("CHAR-META-BIT", make_fixnum(0));
-       make_constant("CHAR-SUPER-BIT", make_fixnum(0));
-       make_constant("CHAR-HYPER-BIT", make_fixnum(0));
+       make_si_constant("CHAR-CONTROL-BIT", make_fixnum(0));
+       make_si_constant("CHAR-META-BIT", make_fixnum(0));
+       make_si_constant("CHAR-SUPER-BIT", make_fixnum(0));
+       make_si_constant("CHAR-HYPER-BIT", make_fixnum(0));
+
 }
 
+@(defun make_char (c &o (b `make_fixnum(0)`) (f `make_fixnum(0)`))
+       object x;
+       int code;
+@
+       check_type_character(&c);
+       code = char_code(c);
+       check_type_non_negative_integer(&b);
+       check_type_non_negative_integer(&f);
+       if (type_of(b) == t_bignum)
+               @(return Cnil)
+       if (type_of(f) == t_bignum)
+               @(return Cnil)
+       if (fix(b)>=CHBITSLIM || fix(f)>=CHFONTLIM)
+               @(return Cnil)
+       if (fix(b) == 0 && fix(f) == 0)
+               @(return `code_char(code)`)
+       x = alloc_object(t_character);
+       char_code(x) = code;
+       char_bits(x) = fix(b);
+       char_font(x) = fix(f);
+       @(return x)
+@)
+
+@(defun char_bits (c)
+@
+       check_type_character(&c);
+       @(return `small_fixnum(char_bits(c))`)
+@)
+
+@(defun char_font (c)
+@
+       check_type_character(&c);
+       @(return `small_fixnum(char_font(c))`)
+@)
+
+@(defun char_bit (c n)
+@
+       check_type_character(&c);
+       FEerror("Cannot get char-bit of ~S.", 1, c);
+@)
+
+@(defun set_char_bit (c n v)
+@
+       check_type_character(&c);
+       FEerror("Cannot set char-bit of ~S.", 1, c);
+@)
+
+@(defun string_char_p (c)
+@
+       check_type_character(&c);
+       if (char_font(c) != 0 || char_bits(c) != 0)
+               @(return Cnil)
+       @(return Ct)
+@)
+
+@(defun int_char (x)
+       int i, c, b, f;
+@
+       check_type_non_negative_integer(&x);
+       if (type_of(x) == t_bignum)
+               @(return Cnil)
+       i = fix(x);
+       c = i % CHCODELIM;
+       i /= CHCODELIM;
+       b = i % CHBITSLIM;
+       i /= CHBITSLIM;
+       f = i % CHFONTLIM;
+       i /= CHFONTLIM;
+       if (i > 0)
+               @(return Cnil)
+       if (b == 0 && f == 0)
+               @(return `code_char(c)`)
+       x = alloc_object(t_character);
+       char_code(x) = c;
+       char_bits(x) = b;
+       char_font(x) = f;
+       @(return x)
+@)
+
 void
 gcl_init_character_function()
 {
        make_function("STANDARD-CHAR-P", Lstandard_char_p);
        make_function("GRAPHIC-CHAR-P", Lgraphic_char_p);
-       make_function("STRING-CHAR-P", Lstring_char_p);
        make_function("ALPHA-CHAR-P", Lalpha_char_p);
        make_function("UPPER-CASE-P", Lupper_case_p);
        make_function("LOWER-CASE-P", Llower_case_p);
@@ -652,17 +652,18 @@ gcl_init_character_function()
        make_function("CHAR-NOT-LESSP", Lchar_not_lessp);
        make_function("CHARACTER", Lcharacter);
        make_function("CHAR-CODE", Lchar_code);
-       make_function("CHAR-BITS", Lchar_bits);
-       make_function("CHAR-FONT", Lchar_font);
        make_function("CODE-CHAR", Lcode_char);
-       make_function("MAKE-CHAR", Lmake_char);
        make_function("CHAR-UPCASE", Lchar_upcase);
        make_function("CHAR-DOWNCASE", Lchar_downcase);
        make_function("DIGIT-CHAR", Ldigit_char);
        make_function("CHAR-INT", Lchar_int);
-       make_function("INT-CHAR", Lint_char);
        make_function("CHAR-NAME", Lchar_name);
        make_function("NAME-CHAR", Lname_char);
-       make_function("CHAR-BIT", Lchar_bit);
-       make_function("SET-CHAR-BIT", Lset_char_bit);
+       make_si_function("INT-CHAR", Lint_char);
+       make_si_function("MAKE-CHAR", Lmake_char);
+       make_si_function("CHAR-BITS", Lchar_bits);
+       make_si_function("CHAR-FONT", Lchar_font);
+       make_si_function("CHAR-BIT", Lchar_bit);
+       make_si_function("SET-CHAR-BIT", Lset_char_bit);
+       make_si_function("STRING-CHAR-P", Lstring_char_p);
 }
index d2d75ed0d1e37814427495a0a07c0e5fb74b508c..5d555d03842652b42b5f8228b91e43e19507489b 100755 (executable)
@@ -48,7 +48,7 @@ DEFUNO_NEW("SPECIALP",object,fSspecialp,SI
        RETURN1(sym);
 }
 
-DEF_ORDINARY("DEBUG",sSdebug,SI,"");
+DEF_ORDINARY("DEBUGGER",sSdebugger,SI,"");
 
 DEFUN_NEW("DEFVAR1",object,fSdefvar1,SI
        ,2,3,NONE,OO,OO,OO,OO,(object sym,object val,...),"")
@@ -71,10 +71,10 @@ DEFUN_NEW("DEFVAR1",object,fSdefvar1,SI
       }
 
 
-DEFUN_NEW("DEBUG",object,fSdebug,SI
+DEFUN_NEW("DEBUG",object,fLdebug,LISP
        ,2,2,NONE,OO,OO,OO,OO,(object sym,object val),"")
 { /* 2 args */
-  putprop(sym,val,sSdebug);
+  putprop(sym,val,sSdebugger);
   RETURN1(sym);
 }
 
index 70bb8e4924a13e9a8d8d16f43a3e05b6cbfcbbcb..8417ff202b2ed1432d2c23375020db97172b4a5e 100755 (executable)
--- a/o/error.c
+++ b/o/error.c
@@ -67,27 +67,27 @@ ihs_function_name(object x)
                y = x->c.c_car;
                if (y == sLlambda)
                        return(sLlambda);
-               if (y == sLlambda_closure)
-                       return(sLlambda_closure);
-               if (y == sLlambda_block || y == sSlambda_block_expanded) {
+               if (y == sSlambda_closure)
+                       return(sSlambda_closure);
+               if (y == sSlambda_block || y == sSlambda_block_expanded) {
                        x = x->c.c_cdr;
                        if (type_of(x) != t_cons)
-                               return(sLlambda_block);
+                               return(sSlambda_block);
                        return(x->c.c_car);
                }
-               if (y == sLlambda_block_closure) {
+               if (y == sSlambda_block_closure) {
                        x = x->c.c_cdr;
                        if (type_of(x) != t_cons)
-                               return(sLlambda_block_closure);
+                               return(sSlambda_block_closure);
                        x = x->c.c_cdr;
                        if (type_of(x) != t_cons)
-                               return(sLlambda_block_closure);
+                               return(sSlambda_block_closure);
                        x = x->c.c_cdr;
                        if (type_of(x) != t_cons)
-                               return(sLlambda_block_closure);
+                               return(sSlambda_block_closure);
                        x = x->c.c_cdr;
                        if (type_of(x) != t_cons)
-                               return(sLlambda_block_closure);
+                               return(sSlambda_block_closure);
                        return(x->c.c_car);
                }
                /* a general special form */
index 0422721c9458c200983aefc2115f46013580705a..9439c4a0037a6b46a552c81b334b8adfbba92422 100755 (executable)
--- a/o/eval.c
+++ b/o/eval.c
@@ -227,7 +227,7 @@ funcall(object fun)
          c = FALSE;
          fun = fun->c.c_cdr;
 
-       }else if (x == sLlambda_block) {
+       }else if (x == sSlambda_block) {
          b = TRUE;
          c = FALSE;
          if(sSlambda_block_expanded->s.s_dbind!=OBJNULL)
@@ -237,14 +237,14 @@ funcall(object fun)
 
 
        
-       } else if (x == sLlambda_closure) {
+       } else if (x == sSlambda_closure) {
                b = FALSE;
                c = TRUE;
                fun = fun->c.c_cdr;
        } else if (x == sLlambda) {
                b = c = FALSE;
                fun = fun->c.c_cdr;
-       } else if (x == sLlambda_block_closure) {
+       } else if (x == sSlambda_block_closure) {
                b = c = TRUE;
                fun = fun->c.c_cdr;
        } else
@@ -644,13 +644,13 @@ EVAL:
 
        vs_check;
 
-       if (Vevalhook->s.s_dbind != Cnil && eval1 == 0)
+       if (siVevalhook->s.s_dbind != Cnil && eval1 == 0)
        {
                bds_ptr old_bds_top = bds_top;
-               object hookfun = symbol_value(Vevalhook);
+               object hookfun = symbol_value(siVevalhook);
                /*  check if Vevalhook is unbound  */
 
-               bds_bind(Vevalhook, Cnil);
+               bds_bind(siVevalhook, Cnil);
                form = Ifuncall_n(hookfun,2,form,list(3,lex_env[0],lex_env[1],lex_env[2]));
                bds_unwind(old_bds_top);
                return form;
@@ -721,7 +721,7 @@ APPLICATION:
        for (x = lex_env[1];  type_of(x) == t_cons;  x = x->c.c_cdr)
                if (x->c.c_car->c.c_car == fun) {
                        x = x->c.c_car;
-                       if (MMcadr(x) == sLmacro) {
+                       if (MMcadr(x) == sSmacro) {
                                x = MMcaddr(x);
                                goto EVAL_MACRO;
                        }
@@ -755,10 +755,10 @@ EVAL_ARGS:
          vs_top = ++top;
          form = MMcdr(form);}
          n =top - base; /* number of args */
-       if (Vapplyhook->s.s_dbind != Cnil) {
+       if (siVapplyhook->s.s_dbind != Cnil) {
          base[0]= (object)n;
          base[0] = c_apply_n(list,n+1,base);
-         x = Ifuncall_n(Vapplyhook->s.s_dbind,3,
+         x = Ifuncall_n(siVapplyhook->s.s_dbind,3,
                         x, /* the function */
                         base[0], /* the arg list */
                         list(3,lex_env[0],lex_env[1],lex_env[2]));
@@ -775,7 +775,7 @@ EVAL_ARGS:
 
 LAMBDA:
        if (type_of(fun) == t_cons && MMcar(fun) == sLlambda) {
-         x = listA(4,sLlambda_closure,lex_env[0],lex_env[1],lex_env[2],Mcdr(fun));
+         x = listA(4,sSlambda_closure,lex_env[0],lex_env[1],lex_env[2],Mcdr(fun));
          goto EVAL_ARGS;
        }
        FEinvalid_function(fun);
@@ -805,13 +805,13 @@ EVAL:
 
        vs_check;
 
-       if (Vevalhook->s.s_dbind != Cnil && eval1 == 0)
+       if (siVevalhook->s.s_dbind != Cnil && eval1 == 0)
        {
                bds_ptr old_bds_top = bds_top;
-               object hookfun = symbol_value(Vevalhook);
-               /*  check if Vevalhook is unbound  */
+               object hookfun = symbol_value(siVevalhook);
+               /*  check if siVevalhook is unbound  */
 
-               bds_bind(Vevalhook, Cnil);
+               bds_bind(siVevalhook, Cnil);
                vs_base = vs_top;
                vs_push(form);
                vs_push(lex_env[0]);
@@ -903,7 +903,7 @@ APPLICATION:
        for (x = lex_env[1];  type_of(x) == t_cons;  x = x->c.c_cdr)
                if (x->c.c_car->c.c_car == fun) {
                        x = x->c.c_car;
-                       if (MMcadr(x) == sLmacro) {
+                       if (MMcadr(x) == sSmacro) {
                                x = MMcaddr(x);
                                goto EVAL_MACRO;
                        }
@@ -940,7 +940,7 @@ EVAL_ARGS:
                form = MMcdr(form);
        }
        vs_base = base;
-       if (Vapplyhook->s.s_dbind != Cnil) {
+       if (siVapplyhook->s.s_dbind != Cnil) {
                call_applyhook(fun);
                return;
        }
@@ -959,7 +959,7 @@ LAMBDA:
                temporary = make_cons(lex_env[2], fun->c.c_cdr);
                temporary = make_cons(lex_env[1], temporary);
                temporary = make_cons(lex_env[0], temporary);
-               x = make_cons(sLlambda_closure, temporary);
+               x = make_cons(sSlambda_closure, temporary);
                vs_push(x);
                goto EVAL_ARGS;
        }
@@ -972,7 +972,7 @@ call_applyhook(object fun)
        object ah;
        object *v;
 
-       ah = symbol_value(Vapplyhook);
+       ah = symbol_value(siVapplyhook);
        v = vs_base + 1;
        vs_push(Cnil);
        while (vs_top > v)
@@ -1040,7 +1040,7 @@ DEFUNOM_NEW("EVAL",object,fLeval,LISP
        return Ivs_values();
 }
 
-LFD(Levalhook)(void)
+LFD(siLevalhook)(void)
 {
        object env;
        bds_ptr old_bds_top = bds_top;
@@ -1062,15 +1062,15 @@ LFD(Levalhook)(void)
                vs_push(car(env));
        } else
                too_many_arguments();
-       bds_bind(Vevalhook, vs_base[1]);
-       bds_bind(Vapplyhook, vs_base[2]);
+       bds_bind(siVevalhook, vs_base[1]);
+       bds_bind(siVapplyhook, vs_base[2]);
        eval1 = 1;
        eval(vs_base[0]);
        lex_env = lex;
        bds_unwind(old_bds_top);
 }
 
-LFD(Lapplyhook)(void)
+LFD(siLapplyhook)(void)
 {
 
        object env;
@@ -1094,8 +1094,8 @@ LFD(Lapplyhook)(void)
                vs_push(car(env));
        } else
                too_many_arguments();
-       bds_bind(Vevalhook, vs_base[2]);
-       bds_bind(Vapplyhook, vs_base[3]);
+       bds_bind(siVevalhook, vs_base[2]);
+       bds_bind(siVapplyhook, vs_base[3]);
        z = vs_top;
        for (l = vs_base[1];  !endp(l);  l = l->c.c_cdr)
                vs_push(l->c.c_car);
@@ -1392,15 +1392,15 @@ gcl_init_eval(void)
         make_constant("CALL-ARGUMENTS-LIMIT", make_fixnum(64));
 
 
-       Vevalhook = make_special("*EVALHOOK*", Cnil);
-       Vapplyhook = make_special("*APPLYHOOK*", Cnil);
+       siVevalhook = make_si_special("*EVALHOOK*", Cnil);
+       siVapplyhook = make_si_special("*APPLYHOOK*", Cnil);
 
 
        three_nils.nil3_self[0] = Cnil;
        three_nils.nil3_self[1] = Cnil;
        three_nils.nil3_self[2] = Cnil;
 
-       make_function("EVALHOOK", Levalhook);
-       make_function("APPLYHOOK", Lapplyhook);
+       make_si_function("EVALHOOK", siLevalhook);
+       make_si_function("APPLYHOOK", siLapplyhook);
 
 }
index b7821dda4aa9bd443d4b7e05cbb08e37e32c7708..c03be3d1ce5b070e44367a208ca444bf5dacab94 100755 (executable)
@@ -345,14 +345,14 @@ getd(str)
 #define READ_BYTE1() getc(fas_stream)
 
 #define GET8(varx ) \
- do{unsigned long var=(unsigned long)READ_BYTE1();  \
-   var |=  ((unsigned long)READ_BYTE1() << SIZE_BYTE); \
-   var |=  ((unsigned long)READ_BYTE1() << (2*SIZE_BYTE)); \
-   var |=  ((unsigned long)READ_BYTE1() << (3*SIZE_BYTE)); \
-   var |=  ((unsigned long)READ_BYTE1() << (4*SIZE_BYTE)); \
-   var |=  ((unsigned long)READ_BYTE1() << (5*SIZE_BYTE)); \
-   var |=  ((unsigned long)READ_BYTE1() << (6*SIZE_BYTE)); \
-   var |=  ((unsigned long)READ_BYTE1() << (7*SIZE_BYTE)); \
+ do{unsigned long long var=READ_BYTE1();  \
+   var |=  ((unsigned long long)READ_BYTE1() << SIZE_BYTE); \
+   var |=  ((unsigned long long)READ_BYTE1() << (2*SIZE_BYTE)); \
+   var |=  ((unsigned long long)READ_BYTE1() << (3*SIZE_BYTE)); \
+   var |=  ((unsigned long long)READ_BYTE1() << (4*SIZE_BYTE)); \
+   var |=  ((unsigned long long)READ_BYTE1() << (5*SIZE_BYTE)); \
+   var |=  ((unsigned long long)READ_BYTE1() << (6*SIZE_BYTE)); \
+   var |=  ((unsigned long long)READ_BYTE1() << (7*SIZE_BYTE)); \
    DPRINTF("{8byte:varx= %ld}", var); \
      varx=var;} while (0)
 
@@ -386,7 +386,7 @@ getd(str)
 #define GETFIX(v_) Join(GET,SIZEOF_LONG)(v_)
 
 #define PUT8(varx ) \
- do{unsigned long var= varx ; \
+ do{unsigned long long var= varx ; \
      DPRINTF("{8byte:varx= %ld}", var); \
        WRITE_BYTEI(var,0); \
      WRITE_BYTEI(var,1); \
@@ -808,7 +808,7 @@ write_fasd(object obj)
      {int l = MP(obj)->_mp_size;
      int m = (l >= 0 ? l : -l);
       
-     unsigned long *u = (unsigned long *) MP(obj)->_mp_d;
+     mp_limb_t *u = MP(obj)->_mp_d;
      /* fix this */
      /* if (sizeof(mp_limb_t) != 4) { FEerror("fix for gmp",0);} */
      PUT4(l);
@@ -1279,7 +1279,7 @@ read_fasd1(int i, object *loc)
       case DP( d_bignum:)
        {int j,m;
         object tem;
-        unsigned long *u;
+        mp_limb_t *u;
         GET4(j);
 #ifdef GMP
         tem = new_bignum();
@@ -1287,7 +1287,7 @@ read_fasd1(int i, object *loc)
         _mpz_realloc(MP(tem),m);
         MP(tem)->_mp_size = j;
         j = m;
-        u = (unsigned long *) MP(tem)->_mp_d;
+        u = MP(tem)->_mp_d;
 #else   
         { BEGIN_NO_INTERRUPT;
         tem = alloc_object(t_bignum);
index 9885e67bd2e1dabc3bf11285ba9934639a5500c0..165796722079d698a10a9300044a78d5390993ef 100755 (executable)
--- a/o/file.d
+++ b/o/file.d
@@ -268,7 +268,7 @@ BEGIN:
                return(strm->sm.sm_object0);
 
        case smm_socket:
-           return (sLstring_char);
+           return (sLcharacter);
            
        case smm_synonym:
                strm = symbol_value(strm->sm.sm_object0);
@@ -295,10 +295,10 @@ BEGIN:
                return(stream_element_type(STREAM_INPUT_STREAM(strm)));
 
        case smm_string_input:
-               return(sLstring_char);
+               return(sLcharacter);
 
        case smm_string_output:
-               return(sLstring_char);
+               return(sLcharacter);
 
        default:
                error("illegal stream mode");
@@ -512,7 +512,7 @@ object if_exists, if_does_not_exist;
        x->sm.sm_fp = fp;
 
        x->sm.sm_buffer = 0;
-       x->sm.sm_object0 = (unzipped ? make_cons(sSAallow_gzipped_fileA,unzipped) : sLstring_char);
+       x->sm.sm_object0 = (unzipped ? make_cons(sSAallow_gzipped_fileA,unzipped) : sLcharacter);
        x->sm.sm_object1 = fn;
        x->sm.sm_int0 = x->sm.sm_int1 = 0;
        vs_push(x);
@@ -1715,7 +1715,7 @@ LFD(Lstream_element_type)()
 
 @(static defun open (filename
              &key (direction sKinput)
-                  (element_type sLstring_char)
+                  (element_type sLcharacter)
                   (if_exists Cnil iesp)
                   (if_does_not_exist Cnil idnesp)
              &aux strm)
@@ -1800,7 +1800,7 @@ LFD(Lfile_length)()
                vs_base[0] = make_fixnum(i);
 }
 
-object sSAload_pathnameA;
+object sLAload_pathnameA;
 DEFVAR("*COLLECT-BINARY-MODULES*",sSAcollect_binary_modulesA,SI,sLnil,"");
 DEFVAR("*BINARY-MODULES*",sSAbinary_modulesA,SI,Cnil,"");
 
@@ -1861,7 +1861,7 @@ DEFVAR("*BINARY-MODULES*",sSAbinary_modulesA,SI,Cnil,"");
                }
                package = symbol_value(sLApackageA);
                bds_bind(sLApackageA, package);
-               bds_bind(sSAload_pathnameA,fasl_filename);
+               bds_bind(sLAload_pathnameA,fasl_filename);
                if (sSAcollect_binary_modulesA->s.s_dbind==Ct) {
                  object _x=sSAbinary_modulesA->s.s_dbind;
                  object _y=Cnil;
@@ -1920,7 +1920,7 @@ DEFVAR("*BINARY-MODULES*",sSAbinary_modulesA,SI,Cnil,"");
                flush_stream(PRINTstream);
        }
        package = symbol_value(sLApackageA);
-       bds_bind(sSAload_pathnameA,pathname);
+       bds_bind(sLAload_pathnameA,pathname);
        bds_bind(sLApackageA, package);
        bds_bind(sLAstandard_inputA, strm);
        frs_push(FRS_PROTECT, Cnil);
@@ -2534,7 +2534,7 @@ gcl_init_file(void)
        standard_input->sm.sm_mode = (short)smm_input;
        standard_input->sm.sm_fp = stdin;
        standard_input->sm.sm_buffer = 0;
-       standard_input->sm.sm_object0 = sLstring_char;
+       standard_input->sm.sm_object0 = sLcharacter;
        standard_input->sm.sm_object1
 #ifdef UNIX
        = make_simple_string("stdin");
@@ -2546,7 +2546,7 @@ gcl_init_file(void)
        standard_output->sm.sm_mode = (short)smm_output;
        standard_output->sm.sm_fp = stdout;
        standard_output->sm.sm_buffer = 0;
-       standard_output->sm.sm_object0 = sLstring_char;
+       standard_output->sm.sm_object0 = sLcharacter;
        standard_output->sm.sm_object1
 #ifdef UNIX
        = make_simple_string("stdout");
@@ -2571,7 +2571,7 @@ gcl_init_file(void)
 }
 
 DEFVAR("*IGNORE-EOF-ON-TERMINAL-IO*",sSAignore_eof_on_terminal_ioA,SI,Cnil,"");
-DEFVAR("*LOAD-PATHNAME*",sSAload_pathnameA,SI,Cnil,"");
+DEFVAR("*LOAD-PATHNAME*",sLAload_pathnameA,LISP,Cnil,"");
 DEFVAR("*LOAD-VERBOSE*",sLAload_verboseA,LISP,Ct,"");
 
 DEF_ORDINARY("ABORT",sKabort,KEYWORD,"");
index 5a09d4763615c23fbed36e8b1dbed9c24b6217e5..d97d637e5cb6a403b5a662da7587d965bbd9b860 100755 (executable)
@@ -19,7 +19,7 @@ typedef object (*object_func)();
 static int     
 vpush_extend(void *,object);
 
-object sLAlink_arrayA;
+object sSAlink_arrayA;
 int Rset = 0;
 
 DEFVAR("*LINK-LIST*",sSAlink_listA,SI,0,"");
@@ -67,8 +67,8 @@ call_or_link(object sym, void **link) {
   if (Rset==0)
     funcall(fun);
   else if (type_of(fun) == t_cfun) {
-    (void) vpush_extend( link,sLAlink_arrayA->s.s_dbind);
-    (void) vpush_extend( *link,sLAlink_arrayA->s.s_dbind);      
+    (void) vpush_extend( link,sSAlink_arrayA->s.s_dbind);
+    (void) vpush_extend( *link,sSAlink_arrayA->s.s_dbind);      
     *link = (void *) (fun->cf.cf_self);
     (*(void (*)())(fun->cf.cf_self))();
   } else {
@@ -89,8 +89,8 @@ call_or_link_closure(object sym, void **link, void **ptr) {
  }
  if (type_of(fun) == t_cclosure && (fun->cc.cc_turbo)) {
    if (Rset) {
-     (void) vpush_extend( link,sLAlink_arrayA->s.s_dbind);
-     (void) vpush_extend( *link,sLAlink_arrayA->s.s_dbind);
+     (void) vpush_extend( link,sSAlink_arrayA->s.s_dbind);
+     (void) vpush_extend( *link,sSAlink_arrayA->s.s_dbind);
      *ptr = (void *)fun;
      *link = (void *) (fun->cf.cf_self);
      MMccall(fun);
@@ -105,8 +105,8 @@ call_or_link_closure(object sym, void **link, void **ptr) {
  /* can't do this if invoking foo(a) is illegal when foo is not defined
     to take any arguments.   In the majority of C's this is legal */
  else if (type_of(fun) == t_cfun) {
-   (void) vpush_extend(link,sLAlink_arrayA->s.s_dbind);
-   (void) vpush_extend(*link,sLAlink_arrayA->s.s_dbind);        
+   (void) vpush_extend(link,sSAlink_arrayA->s.s_dbind);
+   (void) vpush_extend(*link,sSAlink_arrayA->s.s_dbind);        
    *link = (void *)fun->cf.cf_self;
    (*(void (*)())fun->cf.cf_self)();
  } else {
@@ -129,7 +129,7 @@ vpush_extend(void *item, object ar)
     return(ar->v.v_fillp = ind);}
        else
     { 
-      int newdim= ROUND_UP_PTR((2 + (int) (1.3 * ind)));
+      int newdim= CEI((2 + (int) (1.3 * ind)),PTR_ALIGN);
       unsigned char *newself;
       newself = (void *)alloc_relblock(newdim);
       bcopy(ar->ust.ust_self,newself,ind);
@@ -180,8 +180,8 @@ is supplied and FLAG is nil, then this function is deleted from the fast links")
  LDEFAULT2: sym = Cnil ;
  LEND_VARARG: va_end(ap);}
 
-  if (sLAlink_arrayA ==0)    RETURN1(Cnil);
-  link_ar = sLAlink_arrayA->s.s_dbind;
+  if (sSAlink_arrayA ==0)    RETURN1(Cnil);
+  link_ar = sSAlink_arrayA->s.s_dbind;
   if (link_ar==Cnil && flag==Cnil) RETURN1(Cnil);
   check_type_array(&link_ar);
   if (type_of(link_ar) != t_string)
@@ -339,8 +339,8 @@ call_proc(object sym, void **link, int argd, va_list ll) {
 
     }
    
-    (void) vpush_extend(link,sLAlink_arrayA->s.s_dbind);
-    (void) vpush_extend(*link,sLAlink_arrayA->s.s_dbind);       
+    (void) vpush_extend(link,sSAlink_arrayA->s.s_dbind);
+    (void) vpush_extend(*link,sSAlink_arrayA->s.s_dbind);       
     *link = (void *)fn;
 
   AFTER_LINK:  
@@ -443,8 +443,8 @@ call_proc_new(object sym, void **link, int argd, object first, va_list ll) {
 
     }
    
-    (void) vpush_extend(link,sLAlink_arrayA->s.s_dbind);
-    (void) vpush_extend(*link,sLAlink_arrayA->s.s_dbind);       
+    (void) vpush_extend(link,sSAlink_arrayA->s.s_dbind);
+    (void) vpush_extend(*link,sSAlink_arrayA->s.s_dbind);       
     *link = (void *)fn;
 
   AFTER_LINK:  
@@ -607,7 +607,7 @@ FFN(mv_ref)(unsigned int i)
 #include "xdrfuns.c"
 
 DEF_ORDINARY("CDEFN",sScdefn,SI,"");
-DEFVAR("*LINK-ARRAY*",sLAlink_arrayA,LISP,Cnil,"");
+DEFVAR("*LINK-ARRAY*",sSAlink_arrayA,SI,Cnil,"");
 
 void
 gcl_init_links(void)
diff --git a/o/gbc.c b/o/gbc.c
index 6be9f5fef0025aa9031d2685518e9c8e940aa999..134fab461b9b3179c6fe95e152fe2a5bc4e57f3c 100755 (executable)
--- a/o/gbc.c
+++ b/o/gbc.c
@@ -24,7 +24,7 @@
   IMPLEMENTATION-DEPENDENT
 */
 
-#define        DEBUG
+/* #define     DEBUG */
 
 #define IN_GBC
 #define NEED_MP_H
@@ -45,7 +45,7 @@ static void
 sgc_mark_phase(void);
 
 static fixnum
-sgc_count_writable(void);
+sgc_count_read_only(void);
 
 #endif
 
@@ -55,10 +55,6 @@ mark_c_stack(jmp_buf, int, void (*)(void *,void *,int));
 static void
 mark_contblock(void *, int);
 
-static void
-mark_object(object);
-
-
 /* the following in line definitions seem to be twice as fast (at
    least on mc68020) as going to the assembly function calls in bitop.c so
    since this is more portable and faster lets use them --W. Schelter
@@ -75,6 +71,31 @@ mark_object(object);
 #error Do not recognize CPTR_SIZE
 #endif
 
+void *
+cb_in(void *p) {
+  struct contblock **cbpp;
+  int i;
+  
+  for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) {
+    if ((void *)*cbpp<=p && ((void *)(*cbpp)+(*cbpp)->cb_size) >p)
+      return *cbpp;
+  }
+  return NULL;
+}
+
+int
+cb_print(void) {
+  struct contblock **cbpp;
+  int i;
+  
+  for (cbpp=&cb_pointer,i=0;*cbpp;cbpp=&((*cbpp)->cb_link),i++) {
+    fprintf(stderr,"%lu at %p\n",(*cbpp)->cb_size,*cbpp);
+    fflush(stderr);
+  }
+  fprintf(stderr,"%u blocks\n",i);
+  return 0;
+}
+
 #ifdef CONTBLOCK_MARK_DEBUG
 int
 cb_check(void) {
@@ -121,13 +142,48 @@ off_check(void *v,void *ve,fixnum i,struct pageinfo *pi) {
 }
 #endif
 
+void **contblock_stack_list=NULL;
+
+static inline bool
+pageinfo_p(void *v) {
+
+  struct pageinfo *pi=v;
+
+  return pi->magic==PAGE_MAGIC && pi->type<=t_contiguous &&
+    (!pi->next || (void *)pi->next>=v+(pi->type==t_contiguous ? pi->in_use : 1)*PAGESIZE);
+
+}
+    
+static inline bool
+in_contblock_stack_list(void *p,void ***ap) {
+  void **a;
+  for (a=*ap;a && a[0]>p;a=a[1]);
+  *ap=a;
+  /* if (a && a[0]==p) fprintf(stderr,"Skipping %p\n",p); */
+  return a && a[0]==p;
+}
 
 inline struct pageinfo *
 get_pageinfo(void *x) {
-  struct pageinfo *v=contblock_list_head;void *vv;
-  for (;(vv=v) && (vv>=x || vv+v->in_use*PAGESIZE<=x);v=v->next);
-  return v;
+
+  void *p=pageinfo(x),**a=contblock_stack_list;
+  struct pageinfo *v;
+
+  for (;!pageinfo_p(p) || in_contblock_stack_list(p,&a);p-=PAGESIZE);
+
+  v=p;
+  massert(v->type==t_contiguous && p+v->in_use*PAGESIZE>x);
+
+  return p;
+
 }
+  
+/* inline struct pageinfo * */
+/* get_pageinfo(void *x) { */
+/*   struct pageinfo *v=contblock_list_head;void *vv; */
+/*   for (;(vv=v) && (vv>=x || vv+v->in_use*PAGESIZE<=x);v=v->next); */
+/*   return v; */
+/* } */
 
 inline char
 get_bit(char *v,struct pageinfo *pi,void *x) {
@@ -300,21 +356,6 @@ enter_mark_origin(object *p) {
 
 }
 
-inline void
-mark_cons(object x) {
-  
-  do {
-    object d=x->c.c_cdr;
-    mark(x);
-    mark_object(x->c.c_car);
-    x=d;
-    if (NULL_OR_ON_C_STACK(x) || is_marked_or_free(x))/*catches Cnil*/
-      return;
-  } while (cdr_listp(x));
-  mark_object(x);
-
-}
-
 /* Whenever two arrays are linked together by displacement,
    if one is live, the other will be made live */
 #define mark_displaced_field(ar) mark_object(ar->a.a_displaced)
@@ -336,27 +377,17 @@ mark_link_array(void *v,void *ve) {
   if (NULL_OR_ON_C_STACK(v))
     return;
 
-  if (sLAlink_arrayA->s.s_dbind==Cnil)
+  if (sSAlink_arrayA->s.s_dbind==Cnil)
     return;
 
-  p=(void *)sLAlink_arrayA->s.s_dbind->v.v_self;
-  pe=(void *)p+sLAlink_arrayA->s.s_dbind->v.v_fillp;
-
-  if (is_marked(sLAlink_arrayA->s.s_dbind) && COLLECT_RELBLOCK_P
-#ifdef SGC
-      && (!sgc_enabled || SGC_RELBLOCK_P(sLAlink_arrayA->s.s_dbind->v.v_self))
-#endif
-      ) {
-    fixnum j=rb_pointer1-rb_pointer;
-    p=(void *)p+j;
-    pe=(void *)pe+j;
-  }
+  p=(void *)sSAlink_arrayA->s.s_dbind->v.v_self;
+  pe=(void *)p+sSAlink_arrayA->s.s_dbind->v.v_fillp;
 
   for (;p<pe;p+=2)
     if (*p>=v && *p<ve) {
       massert(!LINK_ARRAY_MARKED(p));
 #ifdef SGC
-      if(!sgc_enabled || IS_WRITABLE(page(p)))
+      if(!sgc_enabled || WRITABLE_PAGE_P(page(p)))
 #endif
        MARK_LINK_ARRAY(p);
     }
@@ -368,11 +399,11 @@ prune_link_array(void) {
 
   void **p,**pe,**n,**ne;
 
-  if (sLAlink_arrayA->s.s_dbind==Cnil)
+  if (sSAlink_arrayA->s.s_dbind==Cnil)
     return;
 
-  ne=n=p=(void *)sLAlink_arrayA->s.s_dbind->v.v_self;
-  pe=(void *)p+sLAlink_arrayA->s.s_dbind->v.v_fillp;
+  ne=n=p=(void *)sSAlink_arrayA->s.s_dbind->v.v_self;
+  pe=(void *)p+sSAlink_arrayA->s.s_dbind->v.v_fillp;
 
   while (p<pe) {
     if (*p) {
@@ -382,7 +413,7 @@ prune_link_array(void) {
       p+=2;
   }
 
-  sLAlink_arrayA->s.s_dbind->v.v_fillp=(ne-n)*sizeof(*n);
+  sSAlink_arrayA->s.s_dbind->v.v_fillp=(ne-n)*sizeof(*n);
 
 }
 
@@ -392,11 +423,11 @@ sweep_link_array(void) {
 
   void ***p,***pe;
 
-  if (sLAlink_arrayA->s.s_dbind==Cnil)
+  if (sSAlink_arrayA->s.s_dbind==Cnil)
     return;
 
-  p=(void *)sLAlink_arrayA->s.s_dbind->v.v_self;
-  pe=(void *)p+sLAlink_arrayA->s.s_dbind->v.v_fillp;
+  p=(void *)sSAlink_arrayA->s.s_dbind->v.v_self;
+  pe=(void *)p+sSAlink_arrayA->s.s_dbind->v.v_fillp;
   for (;p<pe;p+=2)
     if (*p) {
       if (LINK_ARRAY_MARKED(p))
@@ -411,42 +442,120 @@ sweep_link_array(void) {
 
 }
 
-static void
-mark_object(object x) {
-  
-  fixnum i,j;
-  object *p;
-  char *cp;
-  enum type tp;
-  
- BEGIN:
-  /* if the body of x is in the c stack, its elements
-     are marked anyway by the c stack mark carefully, and
-     if this x is somehow hanging around in a cons that
-     should be dead, we dont want to mark it. -wfs
-  */
+DEFVAR("*LEAF-COLLECTION-THRESHOLD*",sSAleaf_collection_thresholdA,SI,make_fixnum(0),"");
+
+#define MARK_LEAF_DATA_ALIGNED(a_,b_,c_,d_) mark_leaf_data(a_,(void **)&b_,c_,d_)
+#define MARK_LEAF_DATA(a_,b_,c_) MARK_LEAF_DATA_ALIGNED(a_,b_,c_,1)
+
+static inline bool
+marking(void *p) {
+  return (sgc_enabled ? ON_WRITABLE_PAGE_CACHED(p) : !NULL_OR_ON_C_STACK(p));
+}
+
+static inline bool
+collecting(void *p) {
+  return (p<(void *)heap_end ? what_to_collect==t_contiguous : COLLECT_RELBLOCK_P);
+}
+
+static ufixnum ngc_thresh;
+static union {struct dummy d;ufixnum f;} rst={.f=-1};
+/* static object lcv=Cnil; */
+
+static inline void
+mark_leaf_data(object x,void **pp,ufixnum s,ufixnum r) {
+
+  void *p=*pp,*dp/* ,*dpe */;
   
-  if (NULL_OR_ON_C_STACK(x) || is_marked_or_free(x))
+  if (!marking(p)||!collecting(p))
     return;
 
-  tp=type_of(x);
+  /* if (lcv!=Cnil && !collecting(lcv->st.st_self) && */
+  /*     (dp=PCEI(lcv->st.st_self,r)) && dp+s<=(dpe=lcv->st.st_self+lcv->st.st_dim) */
+  /*     && x && x->d.st>=ngc_thresh) { */
+
+  if (what_to_collect!=t_contiguous && 
+      x && x->d.st>=ngc_thresh &&
+      (dp=alloc_contblock_no_gc(s))) {
+    
+    /* fprintf(stderr,"Promoting %p,%lu to %p\n",p,s,dp); */
+    /* fflush(stderr); */
+
+    *pp=memcpy(dp,p,s);
+    /* lcv->st.st_fillp=lcv->st.st_dim=(dpe-(void *)(lcv->st.st_self=dp+s)); */
+    x->d.st=0;
 
-  if (tp==t_cons) {
-    mark_cons(x);
     return;
+
+  } 
+
+  if (x && x->d.st<rst.d.st) x->d.st++;
+
+  if (p>=(void *)heap_end)
+    *pp=(void *)copy_relblock(p,s);
+  else
+    mark_contblock(p,s);
+
+}
+
+static void mark_object1(object);
+#define mark_object(x) if (marking(x)) mark_object1(x)
+    
+static inline void
+mark_object_address(object *o,int f) {
+
+  static ufixnum lp;
+  static ufixnum lr;
+
+  ufixnum p=page(o);
+  
+  if (lp!=p || !f) {
+    lp=p;
+    lr=sgc_enabled ? WRITABLE_PAGE_P(lp) : 1;
   }
 
+  if (lr)
+    mark_object(*o);
+
+}
+
+static inline void
+mark_object_array(object *o,object *oe) {
+  int f=0;
+
+  if (o)
+    for (;o<oe;o++,f=1)
+      mark_object_address(o,f);
+
+}
+
+
+static void
+mark_object1(object x) {
+  
+  fixnum i,j=0;/*FIXME*/
+
+  if (is_marked_or_free(x))
+    return;
+
   mark(x);
 
-  switch (tp) {
+  switch (type_of(x)) {
+
+  case t_cons:
+    mark_object(x->c.c_car);
+    mark_object(Scdr(x));/*FIXME*/
+    break;
 
   case t_fixnum:
     break;
     
+  case t_bignum:
+    MARK_LEAF_DATA(x,MP_SELF(x),MP_ALLOCATED(x)*MP_LIMB_SIZE);
+    break;
+
   case t_ratio:
     mark_object(x->rat.rat_num);
-    x = x->rat.rat_den;
-    goto BEGIN;
+    mark_object(x->rat.rat_den);
     
   case t_shortfloat:
     break;
@@ -456,8 +565,7 @@ mark_object(object x) {
     
   case t_complex:
     mark_object(x->cmp.cmp_imag);
-    x = x->cmp.cmp_real;
-    goto BEGIN;
+    mark_object(x->cmp.cmp_real);
     
   case t_character:
     break;
@@ -466,13 +574,7 @@ mark_object(object x) {
     mark_object(x->s.s_plist);
     mark_object(x->s.s_gfdef);
     mark_object(x->s.s_dbind);
-    if (x->s.s_self == NULL)
-      break;
-    if (inheap(x->s.s_self)) {
-      if (what_to_collect == t_contiguous)
-       mark_contblock(x->s.s_self,x->s.s_fillp);
-    } else if (COLLECT_RELBLOCK_P)
-       x->s.s_self = copy_relblock(x->s.s_self, x->s.s_fillp);
+    MARK_LEAF_DATA(x,x->s.s_self,x->s.s_fillp);
     break;
     
   case t_package:
@@ -481,197 +583,88 @@ mark_object(object x) {
     mark_object(x->p.p_shadowings);
     mark_object(x->p.p_uselist);
     mark_object(x->p.p_usedbylist);
-    if (what_to_collect != t_contiguous)
-      break;
-    if (x->p.p_internal != NULL)
-      mark_contblock((char *)(x->p.p_internal),
-                    x->p.p_internal_size*sizeof(object));
-    if (x->p.p_external != NULL)
-      mark_contblock((char *)(x->p.p_external),
-                    x->p.p_external_size*sizeof(object));
+    mark_object_array(x->p.p_internal,x->p.p_internal+x->p.p_internal_size);
+    MARK_LEAF_DATA(x,x->p.p_internal,x->p.p_internal_size*sizeof(object));
+    mark_object_array(x->p.p_external,x->p.p_external+x->p.p_external_size);
+    MARK_LEAF_DATA(x,x->p.p_external,x->p.p_external_size*sizeof(object));
     break;
     
   case t_hashtable:
     mark_object(x->ht.ht_rhsize);
     mark_object(x->ht.ht_rhthresh);
-    if (x->ht.ht_self == NULL)
-      break;
-    for (i = 0, j = x->ht.ht_size;  i < j;  i++) {
-      mark_object(x->ht.ht_self[i].hte_key);
-      mark_object(x->ht.ht_self[i].hte_value);
-    }
-    if (inheap(x->ht.ht_self)) {
-      if (what_to_collect == t_contiguous)
-       mark_contblock((char *)x->ht.ht_self,j*sizeof(struct htent));
-    } else if (COLLECT_RELBLOCK_P)
-      x->ht.ht_self=(void *)copy_relblock((char *)x->ht.ht_self,j*sizeof(struct htent));;
+    if (x->ht.ht_self)
+      for (i=0;i<x->ht.ht_size;i++)
+       if (x->ht.ht_self[i].hte_key!=OBJNULL) {
+         mark_object_address(&x->ht.ht_self[i].hte_key,i);
+         mark_object_address(&x->ht.ht_self[i].hte_value,i+1);
+       }
+    MARK_LEAF_DATA(x,x->ht.ht_self,x->ht.ht_size*sizeof(*x->ht.ht_self));
     break;
     
   case t_array:
-    if ((x->a.a_displaced) != Cnil)
-      mark_displaced_field(x);
-    if (x->a.a_dims != NULL) {
-      if (inheap(x->a.a_dims)) {
-       if (what_to_collect == t_contiguous)
-         mark_contblock((char *)(x->a.a_dims),sizeof(int)*x->a.a_rank);
-      } else if (COLLECT_RELBLOCK_P)
-       x->a.a_dims = (int *) copy_relblock((char *)(x->a.a_dims),sizeof(int)*x->a.a_rank);
-    }
-    if ((enum aelttype)x->a.a_elttype == aet_ch)
-      goto CASE_STRING;
-    if ((enum aelttype)x->a.a_elttype == aet_bit)
-      goto CASE_BITVECTOR;
-    if ((enum aelttype)x->a.a_elttype == aet_object)
-      goto CASE_GENERAL;
-    
-  CASE_SPECIAL:
-    cp = (char *)(x->fixa.fixa_self);
-    if (cp == NULL)
-      break;
-    /* set j to the size in char of the body of the array */
-    
-    switch((enum aelttype)x->a.a_elttype){
-#define  ROUND_RB_POINTERS_DOUBLE \
-{int tem =  ((long)rb_pointer1) & (sizeof(double)-1); \
-   if (tem) \
-     { rb_pointer +=  (sizeof(double) - tem); \
-       rb_pointer1 +=  (sizeof(double) - tem); \
-     }}
+    MARK_LEAF_DATA(x,x->a.a_dims,sizeof(int)*x->a.a_rank);
+
+  case t_vector:
+  case t_bitvector:
+
+    switch(j ? j : (enum aelttype)x->v.v_elttype) {
+
     case aet_lf:
-      j= sizeof(longfloat)*x->lfa.lfa_dim;
-      if ((COLLECT_RELBLOCK_P) &&  !(inheap(cp)))
-       ROUND_RB_POINTERS_DOUBLE;/*FIXME gc space violation*/
+      j= sizeof(longfloat)*x->v.v_dim;
+      if ((COLLECT_RELBLOCK_P) &&  (void *)x->v.v_self>=(void *)heap_end)
+       rb_pointer=PCEI(rb_pointer,sizeof(double));             /*FIXME GC space violation*/
+      break;
+
+    case aet_bit:
+#define W_SIZE (8*sizeof(fixnum))
+      j= sizeof(fixnum)*((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE);
       break;
+
     case aet_char:
     case aet_uchar:
-      j=sizeof(char)*x->a.a_dim;
+      j=sizeof(char)*x->v.v_dim;
       break;
+
     case aet_short:
     case aet_ushort:
-      j=sizeof(short)*x->a.a_dim;
+      j=sizeof(short)*x->v.v_dim;
       break;
+
+    case aet_object:
+      if (x->v.v_displaced->c.c_car==Cnil)
+       mark_object_array(x->v.v_self,x->v.v_self+x->v.v_dim);
+
     default:
-      j=sizeof(fixnum)*x->fixa.fixa_dim;}
-    
-    goto COPY;
-    
-  CASE_GENERAL:
-    p = x->a.a_self;
-    if (p == NULL
-#ifdef HAVE_ALLOCA
-       || (char *)p >= core_end
-#endif  
-       )
-      break;
-    j=0;
-    if (x->a.a_displaced->c.c_car == Cnil)
-      for (i = 0, j = x->a.a_dim;  i < j;  i++)
-       mark_object(p[i]);
-    cp = (char *)p;
-    j *= sizeof(object);
-  COPY:
-    if (inheap(cp)) {
-      if (what_to_collect == t_contiguous)
-       mark_contblock(cp, j);
-    } else if (COLLECT_RELBLOCK_P) {
-      if (x->a.a_displaced == Cnil) {
-#ifdef HAVE_ALLOCA
-       if (!NULL_OR_ON_C_STACK(cp))  /* only if body of array not on C stack */
-#endif                   
-         x->a.a_self = (object *)copy_relblock(cp, j);
-      } else if (x->a.a_displaced->c.c_car == Cnil) {
-       i = (long)(object *)copy_relblock(cp, j)  - (long)(x->a.a_self);
-       adjust_displaced(x, i);
-      }
+      j=sizeof(fixnum)*x->v.v_dim;
+
     }
-    break;
-    
-  case t_vector:
-    if ((x->v.v_displaced) != Cnil)
-      mark_displaced_field(x);
-    if ((enum aelttype)x->v.v_elttype == aet_object)
-      goto CASE_GENERAL;
-    else
-      goto CASE_SPECIAL;
-    
-  case t_bignum:
-#ifndef GMP_USE_MALLOC
-    if ((int)what_to_collect >= (int)t_contiguous) {
-      j = MP_ALLOCATED(x);
-      cp = (char *)MP_SELF(x);
-      if (cp == 0)
-       break;
-#ifdef PARI
-      if (j != lg(MP(x))  &&
-         /* we don't bother to zero this register,
-            and its contents may get over written */
-         ! (x == big_register_1 &&
-            (int)(cp) <= top &&
-            (int) cp >= bot))
-       printf("bad length 0x%x ",x);
-#endif
-      j = j * MP_LIMB_SIZE;
-      if (inheap(cp)) {
-       if (what_to_collect == t_contiguous)
-         mark_contblock(cp, j);
-      } else if (COLLECT_RELBLOCK_P) {
-       MP_SELF(x) = (void *) copy_relblock(cp, j);}}
-#endif /* not GMP_USE_MALLOC */
-    break;
-    
-  CASE_STRING:
-  case t_string:
-    if ((x->st.st_displaced) != Cnil)
-      mark_displaced_field(x);
-    j = x->st.st_dim;
-    cp = x->st.st_self;
-    if (cp == NULL)
-      break;
-  COPY_STRING:
-    if (inheap(cp)) {
-      if (what_to_collect == t_contiguous)
-       mark_contblock(cp, j);
-    } else if (COLLECT_RELBLOCK_P) {
-      if (x->st.st_displaced == Cnil)
-       x->st.st_self = copy_relblock(cp, j);
-      else if (x->st.st_displaced->c.c_car == Cnil) {
-       i = copy_relblock(cp, j) - cp;
-       adjust_displaced(x, i);
+
+  case t_string:/*FIXME*/
+    j=j ? j : x->st.st_dim;
+
+    if (x->v.v_displaced->c.c_car==Cnil) {
+      void *p=x->v.v_self;
+      MARK_LEAF_DATA(x,x->v.v_self,j);
+      if (x->v.v_displaced!=Cnil) {
+       j=(void *)x->v.v_self-p;
+       x->v.v_self=p;
+       adjust_displaced(x,j);
       }
-    }
+    } 
+    mark_object(x->v.v_displaced);
     break;
     
-  CASE_BITVECTOR:
-  case t_bitvector:
-    if ((x->bv.bv_displaced) != Cnil)
-      mark_displaced_field(x);
-    /* We make bitvectors multiple of sizeof(int) in size allocated
-       Assume 8 = number of bits in char */
-    
-#define W_SIZE (8*sizeof(fixnum))
-    j= sizeof(fixnum) *
-      ((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE);
-    cp = x->bv.bv_self;
-    if (cp == NULL)
-      break;
-    goto COPY_STRING;
-    
   case t_structure:
-    mark_object(x->str.str_def);
-    p = x->str.str_self;
-    if (p == NULL)
-      break;
     {
       object def=x->str.str_def;
-      unsigned char * s_type = &SLOT_TYPE(def,0);
-      unsigned short *s_pos= & SLOT_POS(def,0);
-      for (i = 0, j = S_DATA(def)->length;  i < j;  i++)
-       if (s_type[i]==0) mark_object(STREF(object,x,s_pos[i]));
-      if (inheap(x->str.str_self)) {
-       if (what_to_collect == t_contiguous)
-         mark_contblock((char *)p,S_DATA(def)->size);
-      } else if (COLLECT_RELBLOCK_P)
-       x->str.str_self = (object *)copy_relblock((char *)p, S_DATA(def)->size);
+      unsigned char *s_type= &SLOT_TYPE(def,0);
+      unsigned short *s_pos= &SLOT_POS(def,0);
+      mark_object(x->str.str_def);
+      if (x->str.str_self)
+       for (i=0,j=S_DATA(def)->length;i<j;i++)
+         if (s_type[i]==0)
+           mark_object_address(&STREF(object,x,s_pos[i]),i);
+      MARK_LEAF_DATA(x,x->str.str_self,S_DATA(def)->size);
     }
     break;
     
@@ -684,12 +677,11 @@ mark_object(object x) {
     case smm_probe:
       mark_object(x->sm.sm_object0);
       mark_object(x->sm.sm_object1);
-      if (what_to_collect == t_contiguous &&
-         x->sm.sm_fp &&
-         x->sm.sm_buffer)
-       mark_contblock(x->sm.sm_buffer, BUFSIZ);
+      if (x->sm.sm_fp) {
+       MARK_LEAF_DATA(x,x->sm.sm_buffer,BUFSIZ);
+      }
       break;
-      
+    
     case smm_synonym:
       mark_object(x->sm.sm_object0);
       break;
@@ -720,44 +712,20 @@ mark_object(object x) {
     }
     break;
     
-#define MARK_CP(a_,b_) {fixnum _t=(b_);if (inheap(a_)) {\
-       if (what_to_collect == t_contiguous) mark_contblock((void *)(a_),_t); \
-      } else if (COLLECT_RELBLOCK_P) (a_)=(void *)copy_relblock((void *)(a_),_t);}
-
-#define MARK_MP(a_) {if ((a_)->_mp_d) \
-                        MARK_CP((a_)->_mp_d,(a_)->_mp_alloc*MP_LIMB_SIZE);}
-
   case t_random:
-    if ((int)what_to_collect >= (int)t_contiguous) {
-      MARK_MP(x->rnd.rnd_state._mp_seed);
-#if __GNU_MP_VERSION < 4 || (__GNU_MP_VERSION  == 4 && __GNU_MP_VERSION_MINOR < 2)
-      if (x->rnd.rnd_state._mp_algdata._mp_lc) {
-       MARK_MP(x->rnd.rnd_state._mp_algdata._mp_lc->_mp_a);
-       if (!x->rnd.rnd_state._mp_algdata._mp_lc->_mp_m2exp) MARK_MP(x->rnd.rnd_state._mp_algdata._mp_lc->_mp_m);
-       MARK_CP(x->rnd.rnd_state._mp_algdata._mp_lc,sizeof(*x->rnd.rnd_state._mp_algdata._mp_lc));
-      }
-#endif
-    }
+    MARK_LEAF_DATA_ALIGNED(x,x->rnd.rnd_state._mp_seed->_mp_d,x->rnd.rnd_state._mp_seed->_mp_alloc*MP_LIMB_SIZE,MP_LIMB_SIZE);
     break;
     
   case t_readtable:
-    if (x->rt.rt_self == NULL)
-      break;
-    if (what_to_collect == t_contiguous)
-      mark_contblock((char *)(x->rt.rt_self),
-                    RTABSIZE*sizeof(struct rtent));
-    for (i = 0;  i < RTABSIZE;  i++) {
-      mark_object(x->rt.rt_self[i].rte_macro);
-      if (x->rt.rt_self[i].rte_dtab != NULL) {
-       /**/
-       if (what_to_collect == t_contiguous)
-         mark_contblock((char *)(x->rt.rt_self[i].rte_dtab),
-                        RTABSIZE*sizeof(object));
-       for (j = 0;  j < RTABSIZE;  j++)
-         mark_object(x->rt.rt_self[i].rte_dtab[j]);
-       /**/
+    if (x->rt.rt_self) {
+      for (i=0;i<RTABSIZE;i++)
+       mark_object_address(&x->rt.rt_self[i].rte_macro,i);
+      for (i=0;i<RTABSIZE;i++) {
+       mark_object_array(x->rt.rt_self[i].rte_dtab,x->rt.rt_self[i].rte_dtab+RTABSIZE);
+       MARK_LEAF_DATA(x,x->rt.rt_self[i].rte_dtab,RTABSIZE*sizeof(object));
       }
     }
+    MARK_LEAF_DATA(x,x->rt.rt_self,RTABSIZE*sizeof(struct rtent));
     break;
     
   case t_pathname:
@@ -770,13 +738,8 @@ mark_object(object x) {
     break;
     
   case t_closure:
-    { 
-      int i ;
-      for (i= 0 ; i < x->cl.cl_envdim ; i++)
-       mark_object(x->cl.cl_env[i]);
-      if (COLLECT_RELBLOCK_P)
-       x->cl.cl_env=(void *)copy_relblock((void *)x->cl.cl_env,x->cl.cl_envdim*sizeof(object));
-    }
+    mark_object_array(x->cl.cl_env,x->cl.cl_env+x->cl.cl_envdim);
+    MARK_LEAF_DATA(x,x->cl.cl_env,x->cl.cl_envdim*sizeof(object));
     
   case t_cfun:
   case t_sfun:
@@ -789,48 +752,40 @@ mark_object(object x) {
     
   case t_cfdata:
     
-    if (x->cfd.cfd_self != NULL)
-      {int i=x->cfd.cfd_fillp;
-      while(i-- > 0)
-       mark_object(x->cfd.cfd_self[i]);}
-    if (what_to_collect == t_contiguous) {
-      mark_contblock(x->cfd.cfd_start, x->cfd.cfd_size);
+    mark_object_array(x->cfd.cfd_self,x->cfd.cfd_self+x->cfd.cfd_fillp);
+    if (what_to_collect == t_contiguous)
       mark_link_array(x->cfd.cfd_start,x->cfd.cfd_start+x->cfd.cfd_size);
-    }
+    MARK_LEAF_DATA(NULL,x->cfd.cfd_start,x->cfd.cfd_size);/*Code cannot move*/
     break;
-  case t_cclosure:
+
+ case t_cclosure:
     mark_object(x->cc.cc_name);
     mark_object(x->cc.cc_env);
     mark_object(x->cc.cc_data);
-    if (x->cc.cc_turbo!=NULL) {
-      mark_object(*(x->cc.cc_turbo-1));
-      if (COLLECT_RELBLOCK_P)
-       x->cc.cc_turbo=(void *)copy_relblock((char *)(x->cc.cc_turbo-1),(1+fix(*(x->cc.cc_turbo-1)))*sizeof(object))+sizeof(object);
+    if (x->cc.cc_turbo) {
+      x->cc.cc_turbo--;
+      mark_object_array(x->cc.cc_turbo,x->cc.cc_turbo+fix(x->cc.cc_turbo[0]));
+      MARK_LEAF_DATA(x,x->cc.cc_turbo,(1+fix(x->cc.cc_turbo[0]))*sizeof(*x->cc.cc_turbo));
+      x->cc.cc_turbo++;
     }
     break;
     
   case t_spice:
     break;
-  default:
+
+ default:
 #ifdef DEBUG
     if (debug)
       printf("\ttype = %d\n", type_of(x));
 #endif
     error("mark botch");
+
   }
+
 }
 
 static long *c_stack_where;
 
-void **contblock_stack_list=NULL;
-
-#define PAGEINFO_P(pi) (pi->magic==PAGE_MAGIC && pi->type<=t_contiguous)
-
-#ifdef SGC
-static void
-sgc_mark_object1(object);
-#endif
-
 static void
 mark_stack_carefully(void *topv, void *bottomv, int offset) {
 
@@ -865,10 +820,9 @@ mark_stack_carefully(void *topv, void *bottomv, int offset) {
     
     pageoffset=v-(void *)pagetochar(p);
     pi=pagetoinfo(p);
-    if (!PAGEINFO_P(pi)) continue;
+    if (!pageinfo_p(pi)) continue;
     
-    for (a=contblock_stack_list;a && a[0]!=pi;a=a[1]);
-    if (a) continue;
+    if ((a=contblock_stack_list) && in_contblock_stack_list(pi,&a)) continue;
 
     tm=tm_of(pi->type);
     if (tm->tm_type>=t_end) continue;
@@ -879,13 +833,10 @@ mark_stack_carefully(void *topv, void *bottomv, int offset) {
 
     if (is_marked_or_free(x)) continue;
 
-#ifdef SGC
-    if (sgc_enabled)
-      sgc_mark_object(x);
-    else
-#endif
-      mark_object(x);
+    mark_object(x);
+
   }
+
 }
 
 
@@ -930,10 +881,6 @@ mark_phase(void) {
   
   for (pp = pack_pointer;  pp != NULL;  pp = pp->p_link)
     mark_object((object)pp);
-#ifdef KCLOVM
-  if (ovm_process_created)
-    mark_all_stacks();
-#endif
   
 #ifdef DEBUG
   if (debug) {
@@ -947,18 +894,18 @@ mark_phase(void) {
     (int)what_to_collect < (int)t_contiguous) {
   */
   
-  {int size;
+  /* {int size; */
   
-  for (pp = pack_pointer;  pp != NULL;  pp = pp->p_link) {
-    size = pp->p_internal_size;
-    if (pp->p_internal != NULL)
-      for (i = 0;  i < size;  i++)
-       mark_object(pp->p_internal[i]);
-    size = pp->p_external_size;
-    if (pp->p_external != NULL)
-      for (i = 0;  i < size;  i++)
-       mark_object(pp->p_external[i]);
-  }}
+  /* for (pp = pack_pointer;  pp != NULL;  pp = pp->p_link) { */
+  /*   size = pp->p_internal_size; */
+  /*   if (pp->p_internal != NULL) */
+  /*     for (i = 0;  i < size;  i++) */
+  /*   mark_object(pp->p_internal[i]); */
+  /*   size = pp->p_external_size; */
+  /*   if (pp->p_external != NULL) */
+  /*     for (i = 0;  i < size;  i++) */
+  /*   mark_object(pp->p_external[i]); */
+  /* }} */
   
   /* mark the c stack */
 #ifndef N_RECURSION_REQD
@@ -1055,42 +1002,27 @@ mark_c_stack(jmp_buf env1, int n, void (*fn)(void *,void *,int)) {
 #ifndef C_GC_OFFSET
 #define C_GC_OFFSET 0
 #endif
-    {
-      struct pageinfo *v,*tv;void **a;
-      fixnum i;
-      for (v=contblock_list_head,contblock_stack_list=NULL;v;v=v->next)
-       for (i=1;i<v->in_use;i++) {
-         tv=pagetoinfo(page(v)+i);
-         if (PAGEINFO_P(tv)) {
-           a=contblock_stack_list;
-           /* printf("%p\n",tv); */
-           contblock_stack_list=alloca(2*sizeof(a));
-           contblock_stack_list[0]=tv;
-           contblock_stack_list[1]=a;
-         }}
-
-      if (&where > cs_org)
-       (*fn)(0,cs_org,C_GC_OFFSET);
-      else
-       (*fn)(cs_org,0,C_GC_OFFSET);
-
-      contblock_stack_list=NULL;
-    }}
+    if (&where > cs_org)
+      (*fn)(0,cs_org,C_GC_OFFSET);
+    else
+      (*fn)(cs_org,0,C_GC_OFFSET);
+
+  }
   
 #if defined(__ia64__)
-    {
-       extern void * __libc_ia64_register_backing_store_base;
-       void * bst=GC_save_regs_in_stack();
-       void * bsb=__libc_ia64_register_backing_store_base;
-
-       if (bsb>bst)
-          (*fn)(bsb,bst,C_GC_OFFSET);
-       else
-          (*fn)(bst,bsb,C_GC_OFFSET);
-       
-    }
+  {
+    extern void * __libc_ia64_register_backing_store_base;
+    void * bst=GC_save_regs_in_stack();
+    void * bsb=__libc_ia64_register_backing_store_base;
+    
+    if (bsb>bst)
+      (*fn)(bsb,bst,C_GC_OFFSET);
+    else
+      (*fn)(bst,bsb,C_GC_OFFSET);
+    
+  }
 #endif
-
+  
 }
 
 static void
@@ -1136,12 +1068,10 @@ static void
 contblock_sweep_phase(void) {
 
   STATIC char *s, *e, *p, *q;
-  STATIC struct contblock *cbp;
   STATIC struct pageinfo *v;
+    
+  reset_contblock_freelist();
   
-  cb_pointer = NULL;
-  ncb = 0;
-
   for (v=contblock_list_head;v;v=v->next) {
     bool z;
 
@@ -1163,7 +1093,7 @@ contblock_sweep_phase(void) {
 #ifdef DEBUG
   if (debug) {
     for (cbp = cb_pointer; cbp != NULL; cbp = cbp->cb_link)
-      printf("%d-byte contblock\n", cbp->cb_size);
+      printf("%lud-byte contblock\n", cbp->cb_size);
     fflush(stdout);
   }
 #endif
@@ -1175,7 +1105,6 @@ contblock_sweep_phase(void) {
 
 int (*GBC_enter_hook)() = NULL;
 int (*GBC_exit_hook)() = NULL;
-char *old_rb_start;
 
 /* void */
 /* ttss(void) { */
@@ -1201,10 +1130,6 @@ fixnum fault_pages=0;
 void
 GBC(enum type t) {
 
-  long i,j;
-#ifdef SGC
-  int in_sgc = sgc_enabled;
-#endif
 #ifdef DEBUG
   int tm=0;
 #endif
@@ -1216,6 +1141,26 @@ GBC(enum type t) {
     t=t_contiguous;
   }
 
+  ngc_thresh=fix(sSAleaf_collection_thresholdA->s.s_dbind);
+
+  { /*FIXME try to get this below the setjmp in mark_c_stack*/
+    struct pageinfo *v,*tv;
+    ufixnum i;
+    void *a;
+    
+    for (v=contblock_list_head,contblock_stack_list=NULL;v;v=v->next)
+      for (i=1;i<v->in_use;i++) {
+       tv=pagetoinfo(page(v)+i);
+       if (pageinfo_p(tv)) {
+         a=contblock_stack_list;
+         /* fprintf(stderr,"pushing %p\n",tv); */
+         contblock_stack_list=alloca(2*sizeof(a));
+         contblock_stack_list[0]=tv;
+         contblock_stack_list[1]=a;
+       }
+      }
+  }
+  
   if (in_signal_handler && t == t_relocatable)
     error("cant gc relocatable in signal handler");
   
@@ -1241,10 +1186,8 @@ GBC(enum type t) {
            close_stream(o);
        }
 
-    t = t_relocatable; gc_time = -1;
-#ifdef SGC
-    if(sgc_enabled) sgc_quit();
-#endif    
+    /* t = t_relocatable; */
+    gc_time = -1;
     }
 
 
@@ -1257,10 +1200,15 @@ GBC(enum type t) {
   tm_table[(int)t].tm_gbccount++;
   tm_table[(int)t].tm_adjgbccnt++;
   
+  if (sSAnotify_gbcA->s.s_dbind != Cnil
 #ifdef DEBUG
-  if (debug || (sSAnotify_gbcA->s.s_dbind != Cnil)) {
-    
-    if (gc_time < 0) gc_time=0;
+      || debug
+#endif
+      ) {
+
+    if (gc_time < 0)
+      gc_time=0;
+
 #ifdef SGC
     printf("[%s for %ld %s pages..",
           (sgc_enabled ? "SGC" : "GC"),
@@ -1272,48 +1220,33 @@ GBC(enum type t) {
           (tm_of(t)->tm_npage),
           (tm_table[(int)t].tm_name)+1);
 #endif
+
 #ifdef SGC
     if(sgc_enabled)
-      printf("(%ld faulted pages, %ld writable, %ld read only)..",fault_pages,sgc_count_writable(),
-            (page(core_end)-first_data_page)-(page(old_rb_start)-page(heap_end))-sgc_count_writable());
+      printf("(%ld faulted pages, %ld writable, %ld read only)..",
+            fault_pages,(page(core_end)-first_data_page)-(page(rb_start)-page(heap_end))-sgc_count_read_only(),
+            sgc_count_read_only());
 #endif   
+
     fflush(stdout);
+
   }
-#endif
+
   if (gc_time >=0 && !gc_recursive++) {gc_start=runtime();}
   
-  /* maxpage = page(heap_end); */
-  
   if (COLLECT_RELBLOCK_P) {
 
-    i=rb_pointer-REAL_RB_START+PAGESIZE;/*FIXME*/
-
-#ifdef SGC
-    if (sgc_enabled==0)
-#endif
-      rb_start = heap_end + PAGESIZE*holepage;
-    
-    rb_end = heap_end + (holepage + nrbpage) *PAGESIZE;
+    char *new_start=heap_end+holepage*PAGESIZE,*new_end=new_start+nrbpage*PAGESIZE;
     
-    if (rb_start < rb_pointer)
-      rb_start1 = (char *)
-       ((long)(rb_pointer + PAGESIZE-1) & -(unsigned long)PAGESIZE);
-    else
-      rb_start1 = rb_start;
-    
-    /* as we walk through marking data, we replace the
-       relocatable pointers
-       in objects by the rb_pointer, advance that
-       by the size, and copy the actual
-       data there to rb_pointer1, and advance it by the size
-       at the end [rb_start1,rb_pointer1] is copied
-       to [rb_start,rb_pointer]
-    */
-    rb_pointer = rb_start;  /* where the new relblock will start */
-    rb_pointer1 = rb_start1;/* where we will copy it to during gc*/
-    
-    i = (rb_end < (rb_start1 + i) ? (rb_start1 + i) : rb_end) - heap_end;
-    alloc_page(-(i + PAGESIZE - 1)/PAGESIZE);
+    if (new_start!=rb_start) {
+      rb_pointer=new_start;
+      rb_limit=new_end;
+    } else {
+      rb_pointer=(rb_pointer<rb_end) ? rb_end : rb_start;
+      rb_limit=rb_pointer+(new_end-new_start);
+    }
+
+    alloc_page(-(holepage+2*nrbpage));
     
   }
   
@@ -1326,14 +1259,7 @@ GBC(enum type t) {
 #endif
 #ifdef SGC
   if(sgc_enabled)
-    { if (t < t_end && tm_of(t)->tm_sgc == 0)
-      {sgc_quit();
-      if (sSAnotify_gbcA->s.s_dbind != Cnil)
-       {fprintf(stdout, " (doing full gc)");
-       fflush(stdout);}
-      mark_phase();}
-    else
-      sgc_mark_phase();}
+    sgc_mark_phase();
   else
 #endif 
     mark_phase();
@@ -1365,27 +1291,16 @@ GBC(enum type t) {
 #endif
   
   if (COLLECT_RELBLOCK_P) {
+
+    rb_start = heap_end + PAGESIZE*holepage;
+    rb_end = heap_end + (holepage + nrbpage) *PAGESIZE;
     
-    if (rb_start < rb_start1) {
-      j = (rb_pointer-rb_start + PAGESIZE - 1)/PAGESIZE;
-      memmove(rb_start,rb_start1,j*PAGESIZE);
-    }
-    
+
 #ifdef SGC
     if (sgc_enabled)
       wrimap=(void *)sSAwritableA->s.s_dbind->v.v_self;
 #endif
 
-#ifdef SGC
-    /* we don't know which pages have relblock on them */
-    if(sgc_enabled) {
-      fixnum i;
-      for (i=page(rb_start);i<page(rb_pointer+PAGESIZE-1);i++)
-       massert(IS_WRITABLE(i));
-    }    
-#endif         
-    rb_limit = rb_end - 2*RB_GETA;
-    
   }
 
   if (t == t_contiguous) {
@@ -1410,6 +1325,54 @@ GBC(enum type t) {
 #endif
   }
   
+
+/*   { */
+/*     static int promoting; */
+/*     if (!promoting && promotion_pointer>promotion_pointer1) { */
+/*       object *p,st; */
+/*       promoting=1; */
+/*       st=alloc_simple_string(""); */
+/*       for (p=promotion_pointer1;p<promotion_pointer;p++) { */
+/*     fixnum j; */
+/*     object x=*p; */
+       
+/*     if (type_of(x)==t_string) */
+
+/*       j=x->st.st_dim; */
+
+/*     else switch (x->v.v_elttype) { */
+
+/*       case aet_lf: */
+/*         j=sizeof(longfloat)*x->v.v_dim; */
+/*         break; */
+/*       case aet_bit: */
+/* #define W_SIZE (8*sizeof(fixnum)) */
+/*         j=sizeof(fixnum)*((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE); */
+/*         break; */
+/*       case aet_char: */
+/*       case aet_uchar: */
+/*         j=sizeof(char)*x->v.v_dim; */
+/*         break; */
+/*       case aet_short: */
+/*       case aet_ushort: */
+/*         j=sizeof(short)*x->v.v_dim; */
+/*         break; */
+/*       default: */
+/*         j=sizeof(fixnum)*x->v.v_dim; */
+/*       } */
+
+/*     st->st.st_dim=j; */
+/*     st->st.st_self=alloc_contblock(st->st.st_dim); */
+/*     fprintf(stderr,"Promoting vector leaf bytes %lu at %p, %p -> %p\n",j,x,x->v.v_self,st->st.st_self); */
+/*     fflush(stderr); */
+/*     memcpy(st->st.st_self,x->v.v_self,st->st.st_dim); */
+/*     x->v.v_self=(void *)st->st.st_self; */
+/*       } */
+/*       promoting=0; */
+/*     } */
+/*   } */
+       
+
 #ifdef DEBUG
   if (debug) {
     for (i = 0, j = 0;  i < (int)t_end;  i++) {
@@ -1437,11 +1400,6 @@ GBC(enum type t) {
   
   interrupt_enable = TRUE;
   
-#ifdef SGC
-  if (in_sgc && sgc_enabled==0)
-    sgc_start();
-#endif
-  
   if (GBC_exit_hook != NULL)
     (*GBC_exit_hook)();
   
@@ -1468,6 +1426,23 @@ GBC(enum type t) {
     
   }
 
+  /* {static int mv; */
+  /*   if (!mv  && COLLECT_RELBLOCK_P) { */
+  /*     mv=1; */
+  /*     if (relb_copied) { */
+  /*   sSAstatic_promotion_areaA->s.s_dbind=(VFUN_NARGS=4,fSmake_vector1(make_fixnum(relb_copied),make_fixnum(aet_char),Ct,make_fixnum(0))); */
+  /*   fprintf(stderr,"Making static promotion area %lu bytes\n",relb_copied); */
+  /*   fflush(stderr); */
+  /*   relb_copied=0; */
+  /*     } else { */
+  /*   fprintf(stderr,"Releasing static promotion area\n"); */
+  /*   fflush(stderr); */
+  /*   sSAstatic_promotion_areaA->s.s_dbind=Cnil; */
+  /*     } */
+  /*     mv=0; */
+  /*   } */
+  /* } */
+
   collect_both=0;
 
   END_NO_INTERRUPT;
@@ -1524,11 +1499,16 @@ FFN(siLroom_report)(void) {
   vs_push(make_fixnum(available_pages));
   vs_push(make_fixnum(ncbpage));
   vs_push(make_fixnum(maxcbpage));
-  vs_push(make_fixnum(ncb));
+  {
+    ufixnum ncb;
+    struct contblock *cbp;
+    for (ncb=0,cbp=cb_pointer;cbp;cbp=cbp->cb_link,ncb++);
+    vs_push(make_fixnum(ncb));
+  }
   vs_push(make_fixnum(cbgbccount));
   vs_push(make_fixnum(holepage));
-  vs_push(make_fixnum(rb_pointer - rb_start));
-  vs_push(make_fixnum(rb_end - rb_pointer));
+  vs_push(make_fixnum(rb_pointer - (rb_pointer<rb_end ? rb_start : rb_end)));
+  vs_push(make_fixnum((rb_pointer<rb_end ? rb_end : (rb_end+(rb_end-rb_start))) - rb_pointer));
   vs_push(make_fixnum(nrbpage));
   vs_push(make_fixnum(maxrbpage));
   vs_push(make_fixnum(rbgbccount));
@@ -1567,18 +1547,15 @@ FFN(siLreset_gbc_count)(void) {
 */
 
 static char *
-copy_relblock(char *p, int s)
-{ char *res = rb_pointer;
- char *q = rb_pointer1;
- s = ROUND_UP_PTR(s);
+copy_relblock(char *p, int s) {
+ char *q = rb_pointer;
+
+ s = CEI(s,PTR_ALIGN);
  rb_pointer += s;
- rb_pointer1 += s;
- memmove(q,p,s);
- /* while (--s >= 0) */
- /*   { *q++ = *p++;} */
- return res;
+ memmove(q,p,s);/*FIXME memcpy*/
+
+ return q;
+
 }
 
 
@@ -1595,18 +1572,124 @@ mark_contblock(void *p, int s) {
   q = p + s;
   /* SGC cont pages: contblock pages must be no smaller than
      sizeof(struct contblock).  CM 20030827 */
-  x = (char *)ROUND_DOWN_PTR_CONT(p);
-  y = (char *)ROUND_UP_PTR_CONT(q);
+  x = (char *)PFLR(p,CPTR_SIZE);
+  y = (char *)PCEI(q,CPTR_SIZE);
   v=get_pageinfo(x);
 #ifdef SGC
   if (!sgc_enabled || (v->sgc_flags&SGC_PAGE_FLAG))
 #endif
-    set_mark_bits(v,x,y);
+     set_mark_bits(v,x,y);
+ }
+DEFUN_NEW("CONTIGUOUS-REPORT",object,fScontiguous_report,SI,1,1,NONE,OO,OO,OO,OO,(void),"") {
+  
+  struct contblock **cbpp;
+  struct pageinfo *v;
+  ufixnum i,j,k,s;
+  struct typemanager *tm=tm_of(t_cfdata);
+  void *p;
+  
+  for (i=j=0,cbpp=&cb_pointer;(*cbpp);) {
+    for (k=0,s=(*cbpp)->cb_size,p=*cbpp;*cbpp && (*cbpp)->cb_size==s;i+=(*cbpp)->cb_size,j++,k++,cbpp=&(*cbpp)->cb_link);
+    fprintf(stderr,"%lu %lu starting at %p\n",k,s,p);
+  }
+  fprintf(stderr,"\nTotal free %lu in %lu pieces\n\n",i,j);
+  
+  for (i=j=0,v=contblock_list_head;v;i+=v->in_use,j++,v=v->next) 
+    fprintf(stderr,"%lu pages at %p\n",(unsigned long)v->in_use,v);
+  fprintf(stderr,"\nTotal pages %lu in %lu pieces\n\n",i,j);
+  
+  for (i=j=0,v=cell_list_head;v;v=v->next)
+    if (tm->tm_type==v->type) {
+      void *p;
+      ufixnum k;
+      for (p=pagetochar(page(v)),k=0;k<tm->tm_nppage;k++,p+=tm->tm_size) {
+       object o=p;
+       if (!is_free(o) && type_of(o)==t_cfdata && (void *)o->cfd.cfd_start>=data_start) {
+         fprintf(stderr,"%lu code bytes at %p\n",(unsigned long)o->cfd.cfd_size,o->cfd.cfd_start);
+         i+=o->cfd.cfd_size;
+         j++;
+       }
+      }
+    }
+  fprintf(stderr,"\nTotal code bytes %lu in %lu pieces\n",i,j);
+  
+  for (i=j=0,v=cell_list_head;v;v=v->next) {
+    struct typemanager *tm=tm_of(v->type);
+    void *p;
+    ufixnum k;
+    for (p=pagetochar(page(v)),k=0;k<tm->tm_nppage;k++,p+=tm->tm_size) {
+      object o=p;
+      void *d=NULL;
+      ufixnum s=0;
+      if (!is_free(o)) {
+       switch (type_of(o)) {
+       case t_array:
+       case t_vector:
+         d=o->a.a_self;
+         s=o->a.a_dim*sizeof(object);
+         break;
+       case t_hashtable:
+         d=o->ht.ht_self;
+         s=o->ht.ht_size*sizeof(object)*2;
+         break;
+       case t_symbol:
+         d=o->s.s_self;
+         s=o->s.s_fillp;
+         break;
+       case t_string:
+       case t_bitvector:
+         d=o->a.a_self;
+         s=o->a.a_dim;
+         break;
+       case t_package:
+         d=o->p.p_external;
+         s=(o->p.p_external_size+o->p.p_internal_size)*sizeof(object);
+         break;
+       case t_bignum:
+         d=o->big.big_mpz_t._mp_d;
+         s=o->big.big_mpz_t._mp_alloc*MP_LIMB_SIZE;
+         break;
+       case t_structure:
+         d=o->str.str_self;
+         s=S_DATA(o->str.str_def)->length*sizeof(object);
+         break;
+       case t_random:
+         d=o->rnd.rnd_state._mp_seed->_mp_d;
+         s=o->rnd.rnd_state._mp_seed->_mp_alloc*MP_LIMB_SIZE;
+         break;
+       case t_cclosure:
+         d=o->cc.cc_turbo;
+         s=fix(o->cc.cc_turbo[-1]);
+         break;
+       case t_cfdata:
+         d=o->cfd.cfd_start;
+         s=o->cfd.cfd_size;
+         break;
+       case t_readtable:
+         d=o->rt.rt_self;
+         s=RTABSIZE*(sizeof(struct rtent));/*FIXME*/
+         break;
+       default:
+         break;
+       }
+       if (d>=data_start && d<(void *)heap_end && s) {
+         fprintf(stderr,"%lu %s bytes at %p\n",s,tm_table[type_of(o)].tm_name,d);
+         i+=s;
+         j++;
+       }
+      }
+    }
+  }
+  fprintf(stderr,"\nTotal leaf bytes %lu in %lu pieces\n",i,j);
+  
+  return Cnil;
+
 }
 
-DEFUN_NEW("GBC",object,fLgbc,LISP,1,1,NONE,OO,OO,OO,OO,(object x0),"") {
+DEFUN_NEW("GBC",object,fSgbc,SI,1,1,NONE,OO,OO,OO,OO,(object x0),"") {
 
-  /* 1 args */
+   /* 1 args */
   
   if (x0 == Ct)
     GBC(t_other);
@@ -1650,5 +1733,5 @@ gcl_init_GBC(void) {
 #ifdef SGC
   make_si_function("SGC-ON",siLsgc_on);
 #endif
-
+  
 }
diff --git a/o/gmp.c b/o/gmp.c
index df84d71f046b36a55fdc142c7393bee9842db9f8..b86db55f14d23f9d39a1a54e6451451e38c964e9 100644 (file)
--- a/o/gmp.c
+++ b/o/gmp.c
@@ -18,12 +18,12 @@ static void *gcl_gmp_realloc(void *oldmem, size_t oldsize, size_t newsize)
   MP_SELF(big_gcprotect)=0;
   bcopy(old,new,oldsize);
 /* SGC contblock pages: Its possible this is on an old page CM 20030827 */
-  if (inheap(oldmem)) 
-#ifdef SGC
-    insert_maybe_sgc_contblock(oldmem,oldsize);
-#else
-    insert_contblock(oldmem,oldsize);
-#endif
+/*   if (inheap(oldmem))  */
+/* #ifdef SGC */
+/*     insert_maybe_sgc_contblock(oldmem,oldsize); */
+/* #else */
+/*     insert_contblock(oldmem,oldsize); */
+/* #endif */
 
   return new;
 }
index 00ebd2a966d2525e7854eb0aa4c88b1e410617d7..4b9ce35b9abd6295e9285931bfd2b09d3349c31e 100755 (executable)
--- a/o/hash.d
+++ b/o/hash.d
@@ -30,6 +30,7 @@ object sLequal;
 object sKsize;
 object sKrehash_size;
 object sKrehash_threshold;
+object sKstatic;
 
 #define MHSH(a_) ((a_) & ~(1UL<<(sizeof(a_)*CHAR_SIZE-1)))
 
@@ -295,8 +296,9 @@ object hashtable;
                hashtable->ht.ht_rhthresh =
                make_fixnum(fix(hashtable->ht.ht_rhthresh) +
                            (new_size - old->ht.ht_size));
-       hashtable->ht.ht_self =
-       (struct htent *)alloc_relblock(new_size * sizeof(struct htent));
+       hashtable->ht.ht_self = hashtable->ht.ht_static ? 
+         (struct htent *)alloc_contblock(new_size * sizeof(struct htent)) : 
+         (struct htent *)alloc_relblock(new_size * sizeof(struct htent));
        for (i = 0;  i < new_size;  i++) {
                hashtable->ht.ht_self[i].hte_key = OBJNULL;
                hashtable->ht.ht_self[i].hte_value = OBJNULL;
@@ -322,6 +324,7 @@ DEFVAR("*DEFAULT-HASH-TABLE-REHASH-THRESHOLD*",sSAdefault_hash_table_rehash_thre
                               `sSAdefault_hash_table_rehash_sizeA->s.s_dbind`)
                              (rehash_threshold
                               `sSAdefault_hash_table_rehash_thresholdA->s.s_dbind`)
+                             (static `Cnil`)
                         &aux h)
        enum httest htt=0;
        int i;
@@ -363,9 +366,11 @@ DEFVAR("*DEFAULT-HASH-TABLE-REHASH-THRESHOLD*",sSAdefault_hash_table_rehash_thre
        h->ht.ht_rhsize = rehash_size;
        h->ht.ht_rhthresh = rehash_threshold;
         h->ht.ht_nent = 0;
+        h->ht.ht_static = static!=Cnil ? 1 : 0;
        h->ht.ht_self = NULL;
-       h->ht.ht_self = (struct htent *)
-       alloc_relblock(fix(size) * sizeof(struct htent));
+       h->ht.ht_self = h->ht.ht_static ?
+         (struct htent *)alloc_contblock(fix(size) * sizeof(struct htent)) :
+         (struct htent *)alloc_relblock(fix(size) * sizeof(struct htent));
        for(i = 0;  i < fix(size);  i++) {
                h->ht.ht_self[i].hte_key = OBJNULL;
                h->ht.ht_self[i].hte_value = OBJNULL;
@@ -547,6 +552,7 @@ gcl_init_hash()
        sKtest = make_keyword("TEST");
        sKrehash_size = make_keyword("REHASH-SIZE");
        sKrehash_threshold = make_keyword("REHASH-THRESHOLD");
+       sKstatic = make_keyword("STATIC");
        
        make_function("MAKE-HASH-TABLE", Lmake_hash_table);
        make_function("HASH-TABLE-P", Lhash_table_p);
diff --git a/o/let.c b/o/let.c
index 6a656eff9fec130fc8b3cf475821edf44667cbbf..a2db64b104f98e586a57fe522cc11b93815a526f 100755 (executable)
--- a/o/let.c
+++ b/o/let.c
@@ -226,7 +226,7 @@ is an illegal function definition in FLET.",
                top[0] = MMcons(lex[2], def);
                top[0] = MMcons(lex[1], top[0]);
                top[0] = MMcons(lex[0], top[0]);
-               top[0] = MMcons(sLlambda_block_closure, top[0]);
+               top[0] = MMcons(sSlambda_block_closure, top[0]);
                lex_fun_bind(MMcar(def), top[0]);
                def_list = MMcdr(def_list);
        }
@@ -262,7 +262,7 @@ is an illegal function definition in LABELS.",
                top[0] = MMcons(Cnil, top[0]);
                top[1] = MMcons(top[0], top[1]);
                top[0] = MMcons(lex[0], top[0]);
-               top[0] = MMcons(sLlambda_block_closure, top[0]);
+               top[0] = MMcons(sSlambda_block_closure, top[0]);
                lex_fun_bind(MMcar(def), top[0]);
                def_list = MMcdr(def_list);
        }
@@ -315,8 +315,8 @@ gcl_init_let(void)
        make_special_form("LET", Flet);
        make_special_form("LET*", FletA);
        make_special_form("MULTIPLE-VALUE-BIND", Fmultiple_value_bind);
-       make_special_form("COMPILER-LET", Fcompiler_let);
        make_special_form("FLET",Fflet);
        make_special_form("LABELS",Flabels);
        make_special_form("MACROLET",Fmacrolet);
+       make_si_special_form("COMPILER-LET", Fcompiler_let);
 }
diff --git a/o/lex.c b/o/lex.c
index a0ecac852fe3baded68e00d4acc7c0ad16fdc9ae..c698506d387c4167b1b23664e8b3b5f7bd560a0e 100755 (executable)
--- a/o/lex.c
+++ b/o/lex.c
@@ -58,7 +58,7 @@ lex_macro_bind(object name, object exp_fun)
 {
        object *top = vs_top;
        vs_push(make_cons(exp_fun, Cnil));
-       top[0] = make_cons(sLmacro, top[0]);
+       top[0] = make_cons(sSmacro, top[0]);
        top[0] = make_cons(name, top[0]);
        lex_env[1]=make_cons(top[0], lex_env[1]);                         
        vs_top = top;
@@ -70,7 +70,7 @@ lex_tag_bind(object tag, object id)
        object *top = vs_top;
 
        vs_push(make_cons(id, Cnil));
-       top[0] = make_cons(sLtag, top[0]);
+       top[0] = make_cons(sStag, top[0]);
        top[0] = make_cons(tag, top[0]);
        lex_env[2] =make_cons(top[0], lex_env[2]);
        vs_top = top;
@@ -95,7 +95,7 @@ lex_tag_sch(object tag)
        object alist = lex_env[2];
 
        while (!endp(alist)) {
-               if (eql(MMcaar(alist), tag) && MMcadar(alist) == sLtag)
+               if (eql(MMcaar(alist), tag) && MMcadar(alist) == sStag)
                        return(MMcar(alist));
                alist = MMcdr(alist);
        }
@@ -120,10 +120,10 @@ gcl_init_lex(void)
 {
 /*     sLfunction = make_ordinary("FUNCTION"); */
 /*     enter_mark_origin(&sLfunction); */
-       sLmacro = make_ordinary("MACRO");
-       enter_mark_origin(&sLmacro);
-       sLtag = make_ordinary("TAG");
-       enter_mark_origin(&sLtag);
+       sSmacro = make_si_ordinary("MACRO");
+       enter_mark_origin(&sSmacro);
+       sStag = make_si_ordinary("TAG");
+       enter_mark_origin(&sStag);
        sLblock =  make_ordinary("BLOCK");
        enter_mark_origin(&sLblock);
 }
index 033c40297f2c859092db8a080c9f4e8035ee1c6a..87e53403f9117b5022a2a00cf844b53463c5e2a8 100755 (executable)
@@ -161,7 +161,7 @@ macro_def(object form)
                        return(head->s.s_gfdef);
                else
                        return(Cnil);
-       else if (MMcadr(fd) == sLmacro)
+       else if (MMcadr(fd) == sSmacro)
                return(MMcaddr(fd));
        else
                return(Cnil);
@@ -279,7 +279,7 @@ macro_expand(object form)
                        exp_fun = head->s.s_gfdef;
                else
                        return(form);
-       else if (MMcadr(fd) == sLmacro)
+       else if (MMcadr(fd) == sSmacro)
                exp_fun = MMcaddr(fd);
        else
                return(form);
@@ -316,7 +316,7 @@ LOOP:
                        exp_fun = head->s.s_gfdef;
                else
                        goto END;
-       else if (MMcadr(fd) == sLmacro)
+       else if (MMcadr(fd) == sSmacro)
                exp_fun = MMcaddr(fd);
        else
                goto END;
index 41b4ad97238152824098514cc892aedcd2f1e23f..9819147226ee14335dcab1605fcc41b8bef8d578 100755 (executable)
--- a/o/main.c
+++ b/o/main.c
@@ -182,30 +182,41 @@ get_phys_pages_no_malloc(void) {
 #else 
 
 ufixnum
-get_phys_pages_no_malloc(void) {
-  int l;
+get_proc_meminfo_value_in_pages(const char *k) {
+  int l,m;
   char b[PAGESIZE],*c;
-  const char *k="MemTotal:",*f="/proc/meminfo";
-  ufixnum res=0,n;
+  ufixnum n;
   
-  if ((l=open(f,O_RDONLY))!=-1) {
-    if ((n=read(l,b,sizeof(b)))<sizeof(b) && 
-       !(b[n]=0) && 
-       (c=strstr(b,k)) && 
-       sscanf(c+strlen(k),"%lu",&n)==1)
-      res=n;
-    close(l);
-  }
-  return res>>(PAGEWIDTH-10);
+  massert((l=open("/proc/meminfo",O_RDONLY))!=-1);
+  massert((n=read(l,b,sizeof(b)))<sizeof(b));
+  b[n]=0;
+  massert(!close(l));
+  massert((c=strstr(b,k)));
+  c+=strlen(k);
+  massert(sscanf(c,"%lu%n",&n,&m)==1);
+  massert(!strncmp(c+m," kB\n",4));
+  return n>>(PAGEWIDTH-10);
+}
+  
+ufixnum
+get_phys_pages_no_malloc(char freep) {
+  return freep ? 
+    get_proc_meminfo_value_in_pages("MemFree:")+
+    get_proc_meminfo_value_in_pages("Buffers:")+
+    get_proc_meminfo_value_in_pages("Cached:") :
+    get_proc_meminfo_value_in_pages("MemTotal:");
 }
 
 #endif
 
+void *initial_sbrk=NULL;
+
 int
 update_real_maxpage(void) {
 
   ufixnum i,j,k;
   void *end,*cur,*beg;
+  ufixnum free_phys_pages=get_phys_pages_no_malloc(1),maxpages;
 #ifdef __MINGW32__
   static fixnum n;
 
@@ -215,6 +226,8 @@ update_real_maxpage(void) {
   }
 #endif
 
+  phys_pages=get_phys_pages_no_malloc(1);
+
   massert(cur=sbrk(0));
   beg=data_start ? data_start : cur;
   for (i=0,j=(1L<<log_maxpage_bound);j>PAGESIZE;j>>=1)
@@ -225,30 +238,46 @@ update_real_maxpage(void) {
       }
   massert(!mbrk(cur));
 
-  phys_pages=get_phys_pages_no_malloc();
+/*   phys_pages=get_phys_pages_no_malloc(0); */
 
-#ifdef BRK_DOES_NOT_GUARANTEE_ALLOCATION
-  if (phys_pages>0 && real_maxpage>phys_pages+page(beg)) real_maxpage=phys_pages+page(beg);
-#endif
+/* #ifdef BRK_DOES_NOT_GUARANTEE_ALLOCATION */
+/*   if (phys_pages>0 && real_maxpage>phys_pages+page(beg)) real_maxpage=phys_pages+page(beg); */
+/* #endif */
+
+  maxpages=real_maxpage-page(beg);
 
-  available_pages=real_maxpage-page(beg);
+  free_phys_pages=free_phys_pages>maxpages ? maxpages : free_phys_pages;
+
+  resv_pages=available_pages=0;
+  available_pages=check_avail_pages();
+  
   for (i=t_start,j=0;i<t_other;i++) {
-    k=tm_table[i].tm_maxpage;
-    if (tm_table[i].tm_type==t_relocatable)
-      k*=2;
-    else
-      j+=k;
-    available_pages-=k;
+    massert(set_tm_maxpage(tm_table+i,tm_table[i].tm_npage));
+    j+=tm_table[i].tm_maxpage;
   }
   resv_pages=40<available_pages ? 40 : available_pages;
   available_pages-=resv_pages;
+  
+  if (sSAoptimize_maximum_pagesA && sSAoptimize_maximum_pagesA->s.s_dbind!=Cnil) {
 
-  new_holepage=available_pages/starting_hole_div;
-  k=available_pages/20;
-  j*=starting_relb_heap_mult;
-  j=j<k ? j : k;
-  if (maxrbpage<j)
-    set_tm_maxpage(tm_table+t_relocatable,j);
+    for (i=t_start,j=0;i<t_relocatable;i++)
+      j+=tm_table[i].tm_maxpage;
+    
+    if (j<free_phys_pages) {
+      for (i=t_start,k=0;i<t_relocatable;i++)
+       if (tm_table[i].tm_maxpage) {
+         massert(set_tm_maxpage(tm_table+i,((double)0.7*free_phys_pages/j)*tm_table[i].tm_maxpage));
+         k+=tm_table[i].tm_maxpage;
+       }
+      set_tm_maxpage(tm_table+t_relocatable,(free_phys_pages-k)>>1);
+    }
+    
+    new_holepage=0;
+    for (i=t_start;i<t_relocatable;i++)
+      new_holepage+=tm_table[i].tm_maxpage-tm_table[i].tm_npage;
+    
+  } else
+    new_holepage=available_pages/starting_hole_div;
 
   return 0;
 
@@ -257,25 +286,13 @@ update_real_maxpage(void) {
 static int
 minimize_image(void) {
 
-#ifdef SGC
-  int in_sgc=sgc_enabled;
-#else
-  int in_sgc=0;
-#endif
   extern long new_holepage;
-  fixnum old_holepage=new_holepage,i;
-  void *new;
-  
-  if (in_sgc) sgc_quit();
-  holepage=new_holepage=1;
-  GBC(t_relocatable);
-  if (in_sgc) sgc_start();
-  new = (void *)(((((ufixnum)rb_pointer)+ PAGESIZE-1)/PAGESIZE)*PAGESIZE);
-  core_end = new;
-  rb_end=rb_limit=new;
-  set_tm_maxpage(tm_table+t_relocatable,(nrbpage=((char *)new-REAL_RB_START)/PAGESIZE));
-  new_holepage=old_holepage;
+  fixnum i;
   
+  empty_relblock();
+  holepage=nrbpage=0;
+  core_end=rb_start=rb_end=rb_limit=rb_pointer=heap_end;
+
 #ifdef GCL_GPROF
   gprof_cleanup();
 #endif
@@ -301,7 +318,7 @@ DEFUN_NEW("SET-LOG-MAXPAGE-BOUND",object,fSset_log_maxpage_bound,SI,1,1,NONE,II,
   l=l<def ? l : def;
   end=data_start+(1L<<l)-PAGESIZE;
   GBC(t_relocatable);
-  dend=heap_end+PAGESIZE+(((rb_pointer-REAL_RB_START)+PAGESIZE-1)&(-PAGESIZE));
+  dend=heap_end+PAGESIZE+CEI(rb_pointer-(rb_pointer<rb_end ? rb_start : rb_end),PAGESIZE);
   if (end >= dend) {
     minimize_image();
     log_maxpage_bound=l;
@@ -352,6 +369,8 @@ gcl_mprotect(void *v,unsigned long l,int p) {
 }
 #endif
 
+DEFVAR("*CODE-BLOCK-RESERVE*",sSAcode_block_reserveA,SI,Cnil,"");
+
 int
 main(int argc, char **argv, char **envp) {
 
@@ -430,9 +449,10 @@ main(int argc, char **argv, char **envp) {
     gcl_init_readline_function();
 #endif
 #ifdef NEED_STACK_CHK_GUARD
-  __stack_chk_guard=random_ulong();/*Cannot be safely set inside a function which returns*/
+    __stack_chk_guard=random_ulong();/*Cannot be safely set inside a function which returns*/
 #endif
-
+    allocate_code_block_reserve();
+  
   }
 
 #ifdef _WIN32
@@ -549,22 +569,10 @@ initlisp(void) {
        import(Ct, lisp_package);
        export(Ct, lisp_package);
 
-#ifdef ANSI_COMMON_LISP
-/*     Cnil->s.s_hpack = common_lisp_package; */
-       import(Cnil, common_lisp_package);
-       export(Cnil, common_lisp_package);
-
-/*     Ct->s.s_hpack = common_lisp_package; */
-       import(Ct, common_lisp_package);
-       export(Ct, common_lisp_package);
-#endif
-
-/*     sLquote = make_ordinary("QUOTE"); */
-/*     sLfunction = make_ordinary("FUNCTION"); */
        sLlambda = make_ordinary("LAMBDA");
-       sLlambda_block = make_ordinary("LAMBDA-BLOCK");
-       sLlambda_closure = make_ordinary("LAMBDA-CLOSURE");
-       sLlambda_block_closure = make_ordinary("LAMBDA-BLOCK-CLOSURE");
+       sSlambda_block = make_si_ordinary("LAMBDA-BLOCK");
+       sSlambda_closure = make_si_ordinary("LAMBDA-CLOSURE");
+       sSlambda_block_closure = make_si_ordinary("LAMBDA-BLOCK-CLOSURE");
        sLspecial = make_ordinary("SPECIAL");
 
        
@@ -702,7 +710,7 @@ segmentation_catcher(int i) {
 /*     error("end of file"); */
 /* } */
 
-DEFUNO_NEW("BYE",object,fLbye,LISP
+DEFUNO_NEW("BYE",object,fSbye,SI
        ,0,1,NONE,OO,OO,OO,OO,void,Lby,(object exitc),"")
 {      int n=VFUN_NARGS;
        int exit_code;
@@ -714,9 +722,9 @@ DEFUNO_NEW("BYE",object,fLbye,LISP
 }
 
 
-DEFUN_NEW("QUIT",object,fLquit,LISP
+DEFUN_NEW("QUIT",object,fSquit,SI
        ,0,1,NONE,OO,OO,OO,OO,(object exitc),"")
-{      return FFN(fLbye)(exitc); }
+{      return FFN(fSbye)(exitc); }
  
 /* DEFUN_NEW("EXIT",object,fLexit,LISP */
 /*        ,0,1,NONE,OI,OO,OO,OO,(fixnum exitc),"") */
@@ -976,8 +984,8 @@ FFN(siLsave_system)(void) {
 
   saving_system = FALSE;
 
-  Lsave();
-  alloc_page(-(holepage+nrbpage));
+  siLsave();
+  alloc_page(-(holepage+2*nrbpage));
 
 }
 
@@ -990,7 +998,7 @@ DEFVAR("*COMMAND-ARGS*",sSAcommand_argsA,SI,sLnil,"");
 static void
 init_main(void) {
 
-  make_function("BY", Lby);
+  make_si_function("BY", Lby);
   make_si_function("ARGC", siLargc);
   make_si_function("ARGV", siLargv);
   
index 4831d2bc3cf8294fb9bef07f65ae95ad88431343..80b502b02761ef1ffeab5276c3c3c5f92ad77e16 100755 (executable)
@@ -1159,17 +1159,12 @@ gcl_init_package()
 {
 
        lisp_package
-       = make_package(make_simple_string("LISP"),
-                      Cnil, Cnil,47,509);
+       = make_package(make_simple_string("COMMON-LISP"),
+                      list(2,make_simple_string("CL"),make_simple_string("LISP")),Cnil,47,509);
        user_package
-       = make_package(make_simple_string("USER"),
-                      Cnil,
+       = make_package(make_simple_string("COMMON-LISP-USER"),
+                      list(2,make_simple_string("CL-USER"),make_simple_string("USER")),
                       make_cons(lisp_package, Cnil),509,97);
-#ifdef ANSI_COMMON_LISP
-       common_lisp_package
-       = make_package(make_simple_string("COMMON-LISP"),
-                      Cnil, Cnil,47,509);
-#endif
        keyword_package
        = make_package(make_simple_string("KEYWORD"),
                       Cnil, Cnil,11,509);
index 4c983bdcc65994ab9bb3459e94553585651bd788..571876a868f0274b1d7fe76f11183e3063e8ece7 100755 (executable)
@@ -341,9 +341,9 @@ DEFUNO_NEW("FUNCTIONP",object,fLfunctionp,LISP
                        x0 = Cnil; }
        else if (t == t_cons) {
                x = x0->c.c_car;
-               if (x == sLlambda || x == sLlambda_block ||
+               if (x == sLlambda || x == sSlambda_block ||
                    x == sSlambda_block_expanded ||
-                   x == sLlambda_closure || x == sLlambda_block_closure)
+                   x == sSlambda_closure || x == sSlambda_block_closure)
                        x0 = Ct;
                else
                        x0 = Cnil;
@@ -358,6 +358,14 @@ fLfunctionp(object x) {
 #endif
 
 
+DEFUNO_NEW("COMMONP",object,fScommonp,SI,1,1,NONE,OO,OO,OO,OO,void,siLcommonp,(object x0),"") {
+  if (type_of(x0) != t_spice)
+    x0 = Ct;
+  else
+    x0 = Cnil;
+  RETURN1(x0);
+}
+
 DEFUNO_NEW("COMPILED-FUNCTION-P",object,fLcompiled_function_p,LISP
    ,1,1,NONE,OO,OO,OO,OO,void,Lcompiled_function_p,(object x0),"")
 
@@ -379,18 +387,6 @@ DEFUNO_NEW("COMPILED-FUNCTION-P",object,fLcompiled_function_p,LISP
                x0 = Cnil;
 RETURN1(x0);}
 
-DEFUNO_NEW("COMMONP",object,fLcommonp,LISP
-   ,1,1,NONE,OO,OO,OO,OO,void,Lcommonp,(object x0),"")
-
-{
-       /* 1 args */;
-
-       if (type_of(x0) != t_spice)
-               x0 = Ct;
-       else
-               x0 = Cnil;
-RETURN1(x0);}
-
 DEFUN_NEW("EQ",object,fLeq,LISP,2,2,NONE,OO,OO,OO,OO,(object x0,object x1),"") {
   RETURN1(x0==x1 ? Ct : Cnil);
 }
index f00a77af958f2d94096d8eaf6cbba3913e45932b..b9bf2b685a0938628a435db447be433de98d27ba 100755 (executable)
--- a/o/read.d
+++ b/o/read.d
@@ -2152,7 +2152,8 @@ LFD(Lreadtablep)()
                rdtbl->rt.rt_self[c].rte_chattrib
                = cat_terminating;
        rdtbl->rt.rt_self[c].rte_macro = fnc;
-       @(return Ct)
+        SGC_TOUCH(rdtbl);
+        @(return Ct)
 @)
 
 @(defun get_macro_character (chr &optional (rdtbl `current_readtable()`))
index 29c1ba460ceaaf6d8376185208ddb09e500d73c4..555208936b40ae6ddf0163f247cb48214653e527 100755 (executable)
@@ -82,7 +82,7 @@ LFD(Lsymbol_function)(void)
                FEundefined_function(sym);
        if (sym->s.s_mflag) {
                vs_push(sym->s.s_gfdef);
-               vs_base[0] = sLmacro;
+               vs_base[0] = sSmacro;
                stack_cons();
                return;
        }
@@ -131,7 +131,7 @@ FFN(Ffunction)(object form)
                vs_base[0] = MMcons(lex_env[2], vs_base[0]);
                vs_base[0] = MMcons(lex_env[1], vs_base[0]);
                vs_base[0] = MMcons(lex_env[0], vs_base[0]);
-               vs_base[0] = MMcons(sLlambda_closure, vs_base[0]);
+               vs_base[0] = MMcons(sSlambda_closure, vs_base[0]);
        } else
                FEinvalid_function(fun);
 }
@@ -173,7 +173,7 @@ LFD(Lmacro_function)(void)
                vs_base[0] = Cnil;
 }
 
-LFD(Lspecial_form_p)(void)
+LFD(Lspecial_operator_p)(void)
 {
        check_arg(1);
        if (type_of(vs_base[0]) != t_symbol)
@@ -194,7 +194,6 @@ gcl_init_reference(void)
        make_function("SYMBOL-VALUE", Lsymbol_value);
        make_function("BOUNDP", Lboundp);
        make_function("MACRO-FUNCTION", Lmacro_function);
-       make_function("SPECIAL-FORM-P", Lspecial_form_p);
-       make_function("SPECIAL-OPERATOR-P", Lspecial_form_p);
+       make_function("SPECIAL-OPERATOR-P", Lspecial_operator_p);
 }
 
index f6c39c32746f922c3d4f534e3ebac0ae8d4cabaa..0cfcfc2294ca5dbafc08eb29d00ef5266e263af4 100755 (executable)
@@ -432,7 +432,7 @@ enum smmode smm;
        stream->sm.sm_fp = fp;
        stream->sm.sm_buffer = 0;
 
-       stream->sm.sm_object0 = sLstring_char;
+       stream->sm.sm_object0 = sLcharacter;
        stream->sm.sm_object1 = host_l;
        stream->sm.sm_int0 = stream->sm.sm_int1 = 0;
        vs_push(stream);
index 08e605eb5fceb8bbcae5ed57c5904efb9ccdd1a6..3b6377e213072653c2454dce10bc4f8cc58a6546 100755 (executable)
--- a/o/save.c
+++ b/o/save.c
@@ -16,11 +16,12 @@ memory_save(char *original_file, char *save_file)
 extern void _cleanup();
 #endif
 
-LFD(Lsave)(void) {
+LFD(siLsave)(void) {
 
   char filename[256];
   extern char *kcl_self;
-
+  extern void *initial_sbrk;
+  
   check_arg(1);
   check_type_or_pathname_string_symbol_stream(&vs_base[0]);
   coerce_to_filename(vs_base[0], filename);
@@ -33,7 +34,8 @@ LFD(Lsave)(void) {
   
   raw_image=FALSE;
   cs_org=0;
-
+  initial_sbrk=core_end;
+  
 #ifdef MEMORY_SAVE
   MEMORY_SAVE(kcl_self,filename);
 #else    
index 61f5f37ffd813fd04aeb1556f2e5b922838918a3..296fe4cd96abd4f65744bc6599eb5d4a23352c78 100644 (file)
@@ -212,7 +212,7 @@ fasload(object faslfile) {
 
     set_type_of(&dum,t_stream);
     dum.sm.sm_mode=smm_input;
-    dum.sm.sm_object0=sLstring_char;
+    dum.sm.sm_object0=sLcharacter;
 
     link_callbacks.add_archive_element=madd_archive_element;
     link_callbacks.multiple_definition=mmultiple_definition;
index 247ebdf0d863586b7df5eea57d2d82f4cd6af945..134d0e024baecf61a89f0bf91aa57ce3c5dad002 100755 (executable)
@@ -58,7 +58,7 @@ License for more details.
 #define  LOAD_SYM(sym) ({ul _b=ELF_ST_BIND(sym->st_info),_t=ELF_ST_TYPE(sym->st_info); \
       sym->st_value && (_b==STB_GLOBAL || _b==STB_WEAK || (_t>=STT_LOPROC && _t<=STT_HIPROC));})
 
-#define MASK(n) (~(~0L << (n)))
+#define MASK(n) (~(~0ULL << (n)))
 
 
 
@@ -242,6 +242,46 @@ relocate_symbols(Sym *sym,Sym *syme,Shdr *sec1,Shdr *sece,const char *st1) {
   
 }
 
+#ifndef MAX_CODE_ADDRESS
+#define MAX_CODE_ADDRESS -1UL
+#endif
+
+static void *
+alloc_memory(ul sz) {
+
+  void *v;
+
+  if (sSAcode_block_reserveA &&
+      sSAcode_block_reserveA->s.s_dbind!=Cnil && sSAcode_block_reserveA->s.s_dbind->st.st_dim>=sz) {
+    
+    v=sSAcode_block_reserveA->s.s_dbind->st.st_self;
+    sSAcode_block_reserveA->s.s_dbind->st.st_self+=sz;
+    sSAcode_block_reserveA->s.s_dbind->st.st_dim-=sz;
+    sSAcode_block_reserveA->s.s_dbind->st.st_fillp=sSAcode_block_reserveA->s.s_dbind->st.st_dim;
+    
+  } else
+    v=alloc_contblock(sz);
+
+  massert(v && (ul)(v+sz)<MAX_CODE_ADDRESS);
+
+  return v;
+
+}
+
+void
+allocate_code_block_reserve(void) {
+
+  const char *s=getenv("GCL_CODESPACE");
+  ul n;
+
+  if (!s || sscanf(s,"%lu",&n)!=1)
+    return;
+
+  sSAcode_block_reserveA->s.s_dbind=alloc_simple_string(n);
+  sSAcode_block_reserveA->s.s_dbind->st.st_self=alloc_memory(n);
+
+}
+
 static object
 load_memory(Shdr *sec1,Shdr *sece,void *v1,ul **got,ul **gote) {
 
@@ -275,9 +315,7 @@ load_memory(Shdr *sec1,Shdr *sece,void *v1,ul **got,ul **gote) {
   memory->cfd.cfd_size=sz;
   memory->cfd.cfd_self=0;
   memory->cfd.cfd_start=0;
-  prefer_low_mem_contblock=TRUE;
-  memory->cfd.cfd_start=alloc_contblock(sz);
-  prefer_low_mem_contblock=FALSE;
+  memory->cfd.cfd_start=alloc_memory(sz);
 
   a=(ul)memory->cfd.cfd_start;
   a=(a+ma)&~ma;
index 9e0f53a532c14b3bb7c2b03053e8fe36accf1632..d76626dcfcca04238ecc5f966db374d2eeed0d9b 100755 (executable)
--- a/o/sgbc.c
+++ b/o/sgbc.c
@@ -7,9 +7,6 @@
     
 */
 
-static void
-sgc_mark_object1(object);
-
 #ifdef BSD
 /* ulong may have been defined in mp.h but the define is no longer needed */
 #undef ulong
@@ -51,81 +48,12 @@ int gclmprotect ( void *addr, size_t len, int prot ) {
 
 #include <signal.h>
 
-/*  void segmentation_catcher(void); */
-
-
-#define sgc_mark_pack_list(u)      \
-do {register object xtmp = u;  \
- while (xtmp != Cnil) \
-   {if (ON_WRITABLE_PAGE(xtmp)) {mark(xtmp);}  \
-     sgc_mark_object(xtmp->c.c_car); \
-     xtmp=Scdr(xtmp);}}while(0) 
-
-
 #ifdef SDEBUG
 object sdebug;
 joe1(){;}
 joe() {;}     
 #endif
 
-/* static void */
-/* sgc_mark_cons(object x) { */
-  
-/*   cs_check(x); */
-  
-/*   /\*  x is already marked.  *\/ */
-  
-/*  BEGIN: */
-/* #ifdef SDEBUG */
-/*   if(x==sdebug) joe1(); */
-/* #endif */
-/*   sgc_mark_object(x->c.c_car); */
-/* #ifdef OLD */
-/*   IF_WRITABLE(x->c.c_car, goto MARK_CAR;); */
-/*   goto MARK_CDR; */
-  
-/*  MARK_CAR: */
-/*   if (!is_marked_or_free(x->c.c_car)) { */
-/*     if (consp(x->c.c_car)) { */
-/*       mark(x->c.c_car); */
-/*       sgc_mark_cons(x->c.c_car); */
-/*     } else */
-/*       sgc_mark_object1(x->c.c_car);} */
-/*  MARK_CDR:   */
-/* #endif */
-/*   /\* if (is_imm_fixnum(x->c.c_cdr)) return; *\/ */
-/*   x = Scdr(x); */
-/*   IF_WRITABLE(x, goto WRITABLE_CDR;); */
-/*   return; */
-/*  WRITABLE_CDR: */
-/*   if (is_marked_or_free(x)) return; */
-/*   if (consp(x)) { */
-/*     mark(x); */
-/*     goto BEGIN; */
-/*   } */
-/*   sgc_mark_object1(x); */
-/* } */
-
-inline void
-sgc_mark_cons(object x) {
-  
-  do {
-    object d=x->c.c_cdr;
-    mark(x);
-    sgc_mark_object(x->c.c_car);
-    x=d;
-    if (!IS_WRITABLE(page(x)) || is_marked_or_free(x))/*catches Cnil*/
-      return;
-  } while (cdr_listp(x));
-  sgc_mark_object(x);
-
-}
-
-/* Whenever two arrays are linked together by displacement,
-   if one is live, the other will be made live */
-#define sgc_mark_displaced_field(ar) sgc_mark_object(ar->a.a_displaced)
-
-
 /* structures and arrays of type t, need to be marked if their
    bodies are not write protected even if the headers are.
    So we should keep these on pages particular to them.
@@ -133,415 +61,6 @@ sgc_mark_cons(object x) {
    header, that way we won't have to keep the headers in memory.
    This takes only 1.47 as opposed to 1.33 microseconds per set.
 */
-static void
-sgc_mark_object1(object x) {
-
-  fixnum i,j;
-  object *p;
-  char *cp;
-  enum type tp;
-  
-  cs_check(x);
- BEGIN:
-#ifdef SDEBUG
-  if (x == OBJNULL || !ON_WRITABLE_PAGE(x))
-    return;
-  IF_WRITABLE(x,goto OK);
-  joe();
- OK:
-#endif 
-  if (is_marked_or_free(x))
-    return;
-#ifdef SDEBUG
-  if(x==sdebug) joe1();
-#endif
-  
-  tp=type_of(x);
-
-  if (tp==t_cons) {
-    sgc_mark_cons(x);
-    return;
-  }
-
-  mark(x);
-
-  switch (tp) {
-
-  case t_fixnum:
-    break;
-    
-  case t_ratio:
-    sgc_mark_object(x->rat.rat_num);
-    x = x->rat.rat_den;
-    IF_WRITABLE(x,if(!is_marked_or_free(x)) goto BEGIN);
-    
-  case t_shortfloat:
-    break;
-    
-  case t_longfloat:
-    break;
-    
-  case t_complex:
-    sgc_mark_object(x->cmp.cmp_imag);
-    x = x->cmp.cmp_real;
-    IF_WRITABLE(x,if(!is_marked_or_free(x)) goto BEGIN);
-    
-  case t_character:
-    break;
-    
-  case t_symbol:
-    IF_WRITABLE(x->s.s_plist,if(!is_marked_or_free(x->s.s_plist))
-    {/* mark(x->s.s_plist); */
-    sgc_mark_cons(x->s.s_plist);});
-    sgc_mark_object(x->s.s_gfdef);
-    sgc_mark_object(x->s.s_dbind);
-    if (x->s.s_self == NULL)
-      break;
-    /* to do */
-    if (inheap(x->s.s_self)) {
-      if (what_to_collect == t_contiguous)
-       mark_contblock(x->s.s_self,x->s.s_fillp);
-    } else if (SGC_RELBLOCK_P(x->s.s_self) && COLLECT_RELBLOCK_P)
-      x->s.s_self = copy_relblock(x->s.s_self, x->s.s_fillp);
-    break;
-    
-  case t_package:
-    sgc_mark_object(x->p.p_name);
-    sgc_mark_object(x->p.p_nicknames);
-    sgc_mark_object(x->p.p_shadowings);
-    sgc_mark_object(x->p.p_uselist);
-    sgc_mark_object(x->p.p_usedbylist);
-    if (what_to_collect == t_contiguous) {
-      if (x->p.p_internal != NULL)
-       mark_contblock((char *)(x->p.p_internal),
-                      x->p.p_internal_size*sizeof(object));
-      if (x->p.p_external != NULL)
-       mark_contblock((char *)(x->p.p_external),
-                      x->p.p_external_size*sizeof(object));
-    }
-    break;
-    
-  case t_hashtable:
-    sgc_mark_object(x->ht.ht_rhsize);
-    sgc_mark_object(x->ht.ht_rhthresh);
-    if (x->ht.ht_self == NULL)
-      break;
-    for (i = 0, j = x->ht.ht_size;  i < j;  i++) {
-      if (ON_WRITABLE_PAGE(&x->ht.ht_self[i])) {
-       sgc_mark_object(x->ht.ht_self[i].hte_key);
-       sgc_mark_object(x->ht.ht_self[i].hte_value);
-      }
-    }
-    if (inheap(x->ht.ht_self)) {
-      if (what_to_collect == t_contiguous)
-       mark_contblock((char *)(x->ht.ht_self),j * sizeof(struct htent));
-    } else if (SGC_RELBLOCK_P(x->ht.ht_self) && COLLECT_RELBLOCK_P)
-      x->ht.ht_self=(void *)copy_relblock((char *)x->ht.ht_self,j*sizeof(struct htent));;
-    break;
-    
-  case t_array:
-    if ((x->a.a_displaced) != Cnil)
-      sgc_mark_displaced_field(x);
-    if (x->a.a_dims != NULL) {
-      if (inheap(x->a.a_dims)) {
-       if (what_to_collect == t_contiguous)
-         mark_contblock((char *)(x->a.a_dims),sizeof(int)*x->a.a_rank);
-      } else if (SGC_RELBLOCK_P(x->a.a_dims) && COLLECT_RELBLOCK_P)
-       x->a.a_dims = (int *) copy_relblock((char *)(x->a.a_dims),sizeof(int)*x->a.a_rank);
-    }
-    if ((enum aelttype)x->a.a_elttype == aet_ch)
-      goto CASE_STRING;
-    if ((enum aelttype)x->a.a_elttype == aet_bit)
-      goto CASE_BITVECTOR;
-    if ((enum aelttype)x->a.a_elttype == aet_object)
-      goto CASE_GENERAL;
-    
-  CASE_SPECIAL:
-    cp = (char *)(x->fixa.fixa_self);
-    if (cp == NULL)
-      break;
-    /* set j to the size in char of the body of the array */
-    
-    switch((enum aelttype)x->a.a_elttype){
-    case aet_lf:
-      j= sizeof(longfloat)*x->lfa.lfa_dim;
-      if ((COLLECT_RELBLOCK_P) && !(inheap(cp)) && SGC_RELBLOCK_P(x->a.a_self))
-       ROUND_RB_POINTERS_DOUBLE;/*FIXME gc space violation*/
-      break;
-    case aet_char:
-    case aet_uchar:
-      j=sizeof(char)*x->a.a_dim;
-      break;
-    case aet_short:
-    case aet_ushort:
-      j=sizeof(short)*x->a.a_dim;
-      break;
-    default:
-      j=sizeof(fixnum)*x->fixa.fixa_dim;}
-    
-    goto COPY;
-    
-  CASE_GENERAL:
-    p = x->a.a_self;
-    if (p == NULL
-#ifdef HAVE_ALLOCA
-       || (char *)p >= core_end
-#endif  
-       
-       )
-      break;
-    j=0;
-    if (x->a.a_displaced->c.c_car == Cnil)
-      for (i = 0, j = x->a.a_dim;  i < j;  i++)
-       if (ON_WRITABLE_PAGE(&p[i]))
-         sgc_mark_object(p[i]);
-    cp = (char *)p;
-    j *= sizeof(object);
-  COPY:
-    if (inheap(cp)) {
-      if (what_to_collect == t_contiguous)
-       mark_contblock(cp, j);
-    } else if (SGC_RELBLOCK_P(cp) && COLLECT_RELBLOCK_P) {
-      if (x->a.a_displaced == Cnil) {
-#ifdef HAVE_ALLOCA
-       if (!NULL_OR_ON_C_STACK(cp))  /* only if body of array not on C stack */
-#endif                   
-         x->a.a_self = (object *)copy_relblock(cp, j);
-      } else if (x->a.a_displaced->c.c_car == Cnil) {
-       i = (long)(object *)copy_relblock(cp, j) - (long)(x->a.a_self);
-       adjust_displaced(x, i);
-      }
-    }
-    break;
-    
-  case t_vector:
-    if ((x->v.v_displaced) != Cnil)
-      sgc_mark_displaced_field(x);
-    if ((enum aelttype)x->v.v_elttype == aet_object)
-      goto CASE_GENERAL;
-    else
-      goto CASE_SPECIAL;
-    
-  case t_bignum:
-#ifdef SDEBUG
-    if (TYPE_MAP(page(x->big.big_self)) < t_contiguous)
-       printf("bad body for %x (%x)\n",x,cp);
-#endif
-#ifndef GMP_USE_MALLOC
-    j = MP_ALLOCATED(x);
-    cp = (char *)MP_SELF(x);
-    if (cp == 0)
-      break;
-    j = j * MP_LIMB_SIZE;
-    if (inheap(cp)) {
-      if (what_to_collect == t_contiguous)
-       mark_contblock(cp, j);
-    } else if (SGC_RELBLOCK_P(cp) && COLLECT_RELBLOCK_P)
-      MP_SELF(x) = (void *) copy_relblock(cp, j);
-#endif /* not GMP_USE_MALLOC */
-    break;
-    
-    
-  CASE_STRING:
-  case t_string:
-    if ((x->st.st_displaced) != Cnil)
-      sgc_mark_displaced_field(x);
-    j = x->st.st_dim;
-    cp = x->st.st_self;
-    if (cp == NULL)
-      break;
-    
-  COPY_STRING:
-    if (inheap(cp)) {
-      if (what_to_collect == t_contiguous)
-       mark_contblock(cp, j);
-    } else if (SGC_RELBLOCK_P(cp) && COLLECT_RELBLOCK_P) {
-      if (x->st.st_displaced == Cnil)
-       x->st.st_self = copy_relblock(cp, j);
-      else if (x->st.st_displaced->c.c_car == Cnil) {
-       i = copy_relblock(cp, j) - cp;
-       adjust_displaced(x, i);
-      }
-    }
-    break;
-    
-  CASE_BITVECTOR:
-  case t_bitvector:
-    if ((x->bv.bv_displaced) != Cnil)
-      sgc_mark_displaced_field(x);
-    /* We make bitvectors multiple of sizeof(int) in size allocated
-       Assume 8 = number of bits in char */
-    
-#define W_SIZE (8*sizeof(fixnum))
-    j= sizeof(fixnum) *
-      ((BV_OFFSET(x) + x->bv.bv_dim + W_SIZE -1)/W_SIZE);
-    cp = x->bv.bv_self;
-    if (cp == NULL)
-      break;
-    goto COPY_STRING;
-    
-  case t_structure:
-    sgc_mark_object(x->str.str_def);
-    p = x->str.str_self;
-    if (p == NULL)
-      break;
-    {
-      object def=x->str.str_def;
-      unsigned char  *s_type = &SLOT_TYPE(def,0);
-      unsigned short *s_pos  = &SLOT_POS (def,0);
-      for (i = 0, j = S_DATA(def)->length;  i < j;  i++)
-       if (s_type[i]==0 && ON_WRITABLE_PAGE(&STREF(object,x,s_pos[i])))
-         sgc_mark_object(STREF(object,x,s_pos[i]));
-      if (inheap(x->str.str_self)) {
-       if (what_to_collect == t_contiguous)
-         mark_contblock((char *)p,S_DATA(def)->size);
-      } else if (SGC_RELBLOCK_P(p) && (COLLECT_RELBLOCK_P))
-       x->str.str_self = (object *) copy_relblock((char *)p, S_DATA(def)->size);
-    }
-    break;
-    
-  case t_stream:
-    switch (x->sm.sm_mode) {
-    case smm_input:
-    case smm_output:
-    case smm_io:
-    case smm_socket:  
-    case smm_probe:
-      sgc_mark_object(x->sm.sm_object0);
-      sgc_mark_object(x->sm.sm_object1);
-      if (what_to_collect == t_contiguous &&
-         x->sm.sm_fp &&
-         x->sm.sm_buffer)
-       mark_contblock(x->sm.sm_buffer, BUFSIZ);
-      break;
-      
-    case smm_synonym:
-      sgc_mark_object(x->sm.sm_object0);
-      break;
-      
-    case smm_broadcast:
-    case smm_concatenated:
-      sgc_mark_object(x->sm.sm_object0);
-      break;
-      
-    case smm_two_way:
-    case smm_echo:
-      sgc_mark_object(x->sm.sm_object0);
-      sgc_mark_object(x->sm.sm_object1);
-      break;
-      
-    case smm_string_input:
-    case smm_string_output:
-      sgc_mark_object(x->sm.sm_object0);
-      break;
-#ifdef USER_DEFINED_STREAMS
-    case smm_user_defined:
-      sgc_mark_object(x->sm.sm_object0);
-      sgc_mark_object(x->sm.sm_object1);
-      break;
-#endif
-    default:
-      error("mark stream botch");
-    }
-    break;
-    
-#define SGC_MARK_CP(a_,b_) {fixnum _t=(b_);if (inheap((a_))) {\
-       if (what_to_collect == t_contiguous) mark_contblock((void *)(a_),_t); \
-      } else if (SGC_RELBLOCK_P((a_)) && COLLECT_RELBLOCK_P) (a_)=(void *)copy_relblock((void *)(a_),_t);}
-
-#define SGC_MARK_MP(a_) {if ((a_)->_mp_d) SGC_MARK_CP((a_)->_mp_d,(a_)->_mp_alloc*MP_LIMB_SIZE);}
-
-  case t_random:
-    SGC_MARK_MP(x->rnd.rnd_state._mp_seed);
-#if __GNU_MP_VERSION < 4 || (__GNU_MP_VERSION == 4 && __GNU_MP_VERSION_MINOR < 2)
-    if (x->rnd.rnd_state._mp_algdata._mp_lc) {
-      SGC_MARK_MP(x->rnd.rnd_state._mp_algdata._mp_lc->_mp_a);
-      if (!x->rnd.rnd_state._mp_algdata._mp_lc->_mp_m2exp) SGC_MARK_MP(x->rnd.rnd_state._mp_algdata._mp_lc->_mp_m);
-      SGC_MARK_CP(x->rnd.rnd_state._mp_algdata._mp_lc,sizeof(*x->rnd.rnd_state._mp_algdata._mp_lc));
-    }
-#endif
-    break;
-    
-  case t_readtable:
-    if (x->rt.rt_self == NULL)
-      break;
-    if (what_to_collect == t_contiguous)
-      mark_contblock((char *)(x->rt.rt_self),RTABSIZE*sizeof(struct rtent));
-    for (i = 0;  i < RTABSIZE;  i++) {
-      sgc_mark_object(x->rt.rt_self[i].rte_macro);
-      if (x->rt.rt_self[i].rte_dtab != NULL) {
-       if (what_to_collect == t_contiguous)
-         mark_contblock((char *)(x->rt.rt_self[i].rte_dtab),RTABSIZE*sizeof(object));
-       for (j = 0;  j < RTABSIZE;  j++)
-         sgc_mark_object(x->rt.rt_self[i].rte_dtab[j]);
-      }
-    }
-    break;
-    
-  case t_pathname:
-    sgc_mark_object(x->pn.pn_host);
-    sgc_mark_object(x->pn.pn_device);
-    sgc_mark_object(x->pn.pn_directory);
-    sgc_mark_object(x->pn.pn_name);
-    sgc_mark_object(x->pn.pn_type);
-    sgc_mark_object(x->pn.pn_version);
-    break;
-    
-  case t_closure:
-    { 
-      int i ;
-      for (i= 0 ; i < x->cl.cl_envdim ; i++) 
-       sgc_mark_object(x->cl.cl_env[i]);
-      if (SGC_RELBLOCK_P(x->cl.cl_env) && COLLECT_RELBLOCK_P)
-       x->cl.cl_env=(void *)copy_relblock((void *)x->cl.cl_env,x->cl.cl_envdim*sizeof(object));
-
-    }
-    
-  case t_cfun:
-  case t_sfun:
-  case t_vfun:
-  case t_afun:
-  case t_gfun:
-    sgc_mark_object(x->cf.cf_name);
-    sgc_mark_object(x->cf.cf_data);
-    break;
-    
-  case t_cfdata:
-    
-    if (x->cfd.cfd_self != NULL) {
-      int i=x->cfd.cfd_fillp;
-      while(i-- > 0)
-       sgc_mark_object(x->cfd.cfd_self[i]);
-    }
-    if (what_to_collect == t_contiguous) {
-      mark_contblock(x->cfd.cfd_start, x->cfd.cfd_size);
-      mark_link_array(x->cfd.cfd_start,x->cfd.cfd_start+x->cfd.cfd_size);
-    }
-    break;
-  case t_cclosure:
-    sgc_mark_object(x->cc.cc_name);
-    sgc_mark_object(x->cc.cc_env);
-    sgc_mark_object(x->cc.cc_data);
-    if (x->cc.cc_turbo!=NULL) {
-      sgc_mark_object(*(x->cc.cc_turbo-1));
-      if (SGC_RELBLOCK_P(x->cc.cc_turbo) && COLLECT_RELBLOCK_P)
-       x->cc.cc_turbo=(void *)copy_relblock((char *)(x->cc.cc_turbo-1),(1+fix(*(x->cc.cc_turbo-1)))*sizeof(object))+sizeof(object);
-    }
-    break;
-    
-  case t_spice:
-    break;
-    
-  default:
-#ifdef DEBUG
-    if (debug)
-      printf("\ttype = %d\n", type_of(x));
-#endif
-    error("mark botch");
-  }
-  
-}
-
 static void
 sgc_mark_phase(void) {
 
@@ -552,8 +71,8 @@ sgc_mark_phase(void) {
   STATIC ihs_ptr ihsp;
   STATIC struct pageinfo *v;
   
-  sgc_mark_object(Cnil->s.s_plist);
-  sgc_mark_object(Ct->s.s_plist);
+  mark_object(Cnil->s.s_plist);
+  mark_object(Ct->s.s_plist);
   
   /* mark all non recent data on writable pages */
   {
@@ -563,15 +82,17 @@ sgc_mark_phase(void) {
     
     for (v=cell_list_head;v;v=v->next) {
       i=page(v);
-      if (!WRITABLE_PAGE_P(i)) continue;
+      if (v->sgc_flags&SGC_PAGE_FLAG || !WRITABLE_PAGE_P(i)) continue;
 
       t=v->type;
       tm=tm_of(t);
       p=pagetochar(i);
       for (j = tm->tm_nppage; --j >= 0; p += tm->tm_size) {
        object x = (object) p; 
-       if (SGC_OR_M(x)) continue;
-       sgc_mark_object1(x);
+#ifndef SGC_WHOLE_PAGE
+       if (TYPEWORD_TYPE_P(v->type) && x->d.s) continue;
+#endif
+       mark_object1(x);
       }
     }
   }
@@ -595,24 +116,24 @@ sgc_mark_phase(void) {
   mark_stack_carefully(MVloc+(sizeof(MVloc)/sizeof(object)),MVloc,0);
 
   for (bdp = bds_org;  bdp<=bds_top;  bdp++) {
-    sgc_mark_object(bdp->bds_sym);
-    sgc_mark_object(bdp->bds_val);
+    mark_object(bdp->bds_sym);
+    mark_object(bdp->bds_val);
   }
   
   for (frp = frs_org;  frp <= frs_top;  frp++)
-    sgc_mark_object(frp->frs_val);
+    mark_object(frp->frs_val);
   
   for (ihsp = ihs_org;  ihsp <= ihs_top;  ihsp++)
-    sgc_mark_object(ihsp->ihs_function);
+    mark_object(ihsp->ihs_function);
   
   for (i = 0;  i < mark_origin_max;  i++)
-    sgc_mark_object(*mark_origin[i]);
+    mark_object(*mark_origin[i]);
   for (i = 0;  i < mark_origin_block_max;  i++)
     for (j = 0;  j < mark_origin_block[i].mob_size;  j++)
-      sgc_mark_object(mark_origin_block[i].mob_addr[j]);
+      mark_object(mark_origin_block[i].mob_addr[j]);
   
   for (pp = pack_pointer;  pp != NULL;  pp = pp->p_link)
-    sgc_mark_object((object)pp);
+    mark_object((object)pp);
 #ifdef KCLOVM
   if (ovm_process_created)
     sgc_mark_all_stacks();
@@ -624,20 +145,6 @@ sgc_mark_phase(void) {
     fflush(stdout);
   }
 #endif 
-  {
-    int size;
-  
-    for (pp = pack_pointer;  pp != NULL;  pp = pp->p_link) {
-      size = pp->p_internal_size;
-      if (pp->p_internal != NULL)
-       for (i = 0;  i < size;  i++)
-         sgc_mark_pack_list(pp->p_internal[i]);
-      size = pp->p_external_size;
-      if (pp->p_external != NULL)
-       for (i = 0;  i < size;  i++)
-         sgc_mark_pack_list(pp->p_external[i]);
-    }
-  }
   
   mark_c_stack(0,N_RECURSION_REQD,mark_stack_carefully);
   
@@ -657,9 +164,6 @@ sgc_sweep_phase(void) {
 
     tm = tm_of((enum type)v->type);
     
-    if (!WRITABLE_PAGE_P(page(v))) 
-      continue;
-
     p = pagetochar(page(v));
     f = tm->tm_free;
     k = 0;
@@ -678,14 +182,18 @@ sgc_sweep_phase(void) {
          continue;
        }
 
-       if (TYPEWORD_TYPE_P(pageinfo(x)->type) && x->d.s == SGC_NORMAL)
+#ifndef SGC_WHOLE_PAGE
+       if (TYPEWORD_TYPE_P(v->type) && x->d.s == SGC_NORMAL)
          continue;
+#endif
        
        /* it is ok to free x */
        
        SET_LINK(x,f);
        make_free(x);
+#ifndef SGC_WHOLE_PAGE
        if (TYPEWORD_TYPE_P(v->type)) x->d.s = SGC_RECENT;
+#endif
        f = x;
        k++;
 
@@ -694,7 +202,7 @@ sgc_sweep_phase(void) {
       tm->tm_nfree += k;
       v->in_use-=k;
 
-    } else /*non sgc_page */
+    } else if (WRITABLE_PAGE_P(page(v))) /*non sgc_page */
       for (j = tm->tm_nppage; --j >= 0;  p += size) {
        x = (object)p;
        if (is_marked(x) && !is_free(x)) {
@@ -711,9 +219,9 @@ sgc_contblock_sweep_phase(void) {
 
   STATIC char *s, *e, *p, *q;
   STATIC struct pageinfo *v;
+    
+  reset_contblock_freelist();
   
-  cb_pointer = NULL;
-  ncb = 0;
   for (v=contblock_list_head;v;v=v->next) {
     bool z;
 
@@ -739,13 +247,6 @@ sgc_contblock_sweep_phase(void) {
 
 }
 
-
-
-#define PAGE_ROUND_UP(adr) \
-    ((char *)(PAGESIZE*(((long)(adr)+PAGESIZE -1) >> PAGEWIDTH)))
-
-/* char *old_rb_start; */
-
 #undef tm
 
 #ifdef SDEBUG
@@ -763,11 +264,11 @@ sgc_count(object yy) {
 
 fixnum writable_pages=0;
 
-/* count writable pages excluding the hole */
+/* count read-only pages */
 static fixnum
-sgc_count_writable(void) { 
+sgc_count_read_only(void) { 
 
-  return page(core_end)-page(rb_start)+writable_pages-(page(old_rb_start)-page(heap_end));
+  return sgc_enabled ? sSAwritableA->s.s_dbind->v.v_dim-writable_pages : 0;
 
 }
 
@@ -1031,7 +532,11 @@ memprotect_test_reset(void) {
 /* If opt_maxpage is set, add full pages to the sgc set if needed
    too. 20040804 CM*/
 /* #define FSGC(tm) (tm->tm_type==t_cons ? tm->tm_nppage : (tm->tm_opt_maxpage ? 0 : tm->tm_sgc_minfree)) */
+#ifdef SGC_WHOLE_PAGE
+#define FSGC(tm) tm->tm_nppage
+#else
 #define FSGC(tm) (!TYPEWORD_TYPE_P(tm->tm_type) ? tm->tm_nppage : tm->tm_sgc_minfree)
+#endif
 
 DEFVAR("*WRITABLE*",sSAwritableA,SI,Cnil,"");
 
@@ -1047,13 +552,16 @@ sgc_start(void) {
   object omp=sSAoptimize_maximum_pagesA->s.s_dbind;
   double tmp,scale;
 
+  allocate_more_pages=0;
+  if (sgc_enabled)
+    return 1;
+
   sSAoptimize_maximum_pagesA->s.s_dbind=Cnil;
   
   if (memprotect_result!=memprotect_success && do_memprotect_test())
     return 0;
 
-  if (sgc_enabled)
-    return 1;
+  empty_relblock();
 
   /* Reset maxpage statistics if not invoked automatically on a hole
      overrun. 20040804 CM*/
@@ -1193,26 +701,7 @@ sgc_start(void) {
 
   }
 
-  /* Now  allocate the sgc relblock.   We do this as the tail
-     end of the ordinary rb.     */  
-  {
-    char *new;
-    tm=tm_of(t_relocatable);
-    
-    {
-      old_rb_start=rb_start;
-      if(((unsigned long)WSGC(tm)) && allocate_more_pages) {
-       new=alloc_relblock(((unsigned long)WSGC(tm))*PAGESIZE);
-       /* the above may cause a gc, shifting the relblock */
-       old_rb_start=rb_start;
-       new= PAGE_ROUND_UP(new);
-      } else new=PAGE_ROUND_UP(rb_pointer);
-      rb_start=rb_pointer=new;
-    }
-  }
-  /* the relblock has been allocated */
-  
-  sSAwritableA->s.s_dbind=fSmake_vector1_1((page(rb_start)-first_data_page),aet_bit,Cnil);
+  sSAwritableA->s.s_dbind=fSmake_vector1_1((page(heap_end)-first_data_page),aet_bit,Ct);
   wrimap=(void *)sSAwritableA->s.s_dbind->v.v_self;
 
   /* now move the sgc free lists into place.   alt_free should
@@ -1231,12 +720,16 @@ sgc_start(void) {
 #endif
        if (pageinfo(f)->sgc_flags&SGC_PAGE_FLAG) {
          SET_LINK(f,x);
+#ifndef SGC_WHOLE_PAGE
          if (TYPEWORD_TYPE_P(pageinfo(f)->type)) f->d.s = SGC_RECENT;
+#endif
          x=f;
          count++;
        } else {
          SET_LINK(f,y);
+#ifndef SGC_WHOLE_PAGE
          if (TYPEWORD_TYPE_P(pageinfo(f)->type)) f->d.s = SGC_NORMAL;
+#endif
          y=f;
        }
        f=next;
@@ -1253,9 +746,12 @@ sgc_start(void) {
 
     {
 
-      struct contblock *new_cb_pointer=NULL,*tmp_cb_pointer=NULL,**cbpp;
+      struct contblock **cbpp;
       void *p=NULL,*pe;
       struct pageinfo *pi;
+      
+      old_cb_pointer=cb_pointer;
+      reset_contblock_freelist();
 
       for (pi=contblock_list_head;pi;pi=pi->next) {
        
@@ -1264,26 +760,17 @@ sgc_start(void) {
        p=CB_DATA_START(pi);
        pe=p+CB_DATA_SIZE(pi->in_use);
        
-       for (cbpp=&cb_pointer;*cbpp;)
+       for (cbpp=&old_cb_pointer;*cbpp;)
          if ((void *)*cbpp>=p && (void *)*cbpp<pe) {
            void *s=*cbpp,*e=s+(*cbpp)->cb_size,*l=(*cbpp)->cb_link;
            set_sgc_bits(pi,s,e);
-           tmp_cb_pointer=cb_pointer;
-           cb_pointer=new_cb_pointer;
            insert_contblock(s,e-s);
-           new_cb_pointer=cb_pointer;
-           cb_pointer=tmp_cb_pointer;
            *cbpp=l;
          } else
            cbpp=&(*cbpp)->cb_link;
 
       }
       
-      /* SGC contblock pages: switch to new free SGC contblock list. CM
-        20030827 */
-      old_cb_pointer=cb_pointer;
-      cb_pointer=new_cb_pointer;
-      
 #ifdef SGC_CONT_DEBUG
       overlap_check(old_cb_pointer,cb_pointer);
 #endif
@@ -1315,11 +802,13 @@ sgc_start(void) {
            SET_WRITABLE(i);
     }
 
-    for (i=page(heap_end);i<page(old_rb_start);i++)
-       SET_WRITABLE(i);
-    tm_of(t_relocatable)->tm_alt_npage=page(rb_start)-page(old_rb_start);
-    for (i=page(rb_start);i<page(core_end);i++)
+    {
+      object v=sSAwritableA->s.s_dbind;
+      for (i=page(v->v.v_self);i<=page(v->v.v_self+CEI(v->bv.bv_offset+v->v.v_dim-1,8*sizeof(fixnum))/(8*sizeof(fixnum)));i++)
        SET_WRITABLE(i);
+    }
+
+    tm_of(t_relocatable)->tm_alt_npage=0;
 
     fault_pages=0;
 
@@ -1363,8 +852,7 @@ sgc_quit(void) {
 
   struct typemanager *tm;
   struct contblock *tmp_cb_pointer,*next;
-  unsigned long i,j,np;
-  char *p;
+  unsigned long i,np;
   struct pageinfo *v;
 
   memory_protect(0);
@@ -1379,7 +867,6 @@ sgc_quit(void) {
   wrimap=NULL;
 
   sgc_enabled=0;
-  rb_start = old_rb_start;
 
   /* SGC cont pages: restore contblocks, each tmp_cb_pointer coming
      from the new list is guaranteed not to be on the old. Need to
@@ -1389,9 +876,7 @@ sgc_quit(void) {
 #ifdef SGC_CONT_DEBUG
     overlap_check(old_cb_pointer,cb_pointer);
 #endif
-    tmp_cb_pointer=cb_pointer;
-    cb_pointer=old_cb_pointer;
-    for (;tmp_cb_pointer;  tmp_cb_pointer=next) {
+    for (tmp_cb_pointer=old_cb_pointer;tmp_cb_pointer;  tmp_cb_pointer=next) {
       next=tmp_cb_pointer->cb_link;
       insert_contblock((void *)tmp_cb_pointer,tmp_cb_pointer->cb_size);
     }
@@ -1440,11 +925,13 @@ sgc_quit(void) {
 
   /*FIXME*/
   /* remove the recent flag from any objects on sgc pages */
-  for (v=cell_list_head;v;v=v->next) 
+#ifndef SGC_WHOLE_PAGE
+  for (v=cell_list_head;v;v=v->next)
     if (v->type==(tm=tm_of(v->type))->tm_type && TYPEWORD_TYPE_P(v->type) && v->sgc_flags & SGC_PAGE_FLAG)
       for (p=pagetochar(page(v)),j=tm->tm_nppage;j>0;--j,p+=tm->tm_size)
-       ((object) p)->d.s=SGC_NORMAL;
-
+       ((object) p)->d.s=SGC_NORMAL;
+#endif
+  
   for (v=contblock_list_head;v;v=v->next) 
     if (v->sgc_flags&SGC_PAGE_FLAG) 
       bzero(CB_SGCF_START(v),CB_DATA_START(v)-CB_SGCF_START(v));
@@ -1488,7 +975,6 @@ memprotect_handler(int sig, long code, void *scp, char *addr) {
   faddr = addr;
 #endif 
   p = page(faddr);
-  /* p = ROUND_DOWN_PAGE_NO(p); */
   if (p >= first_protectable_page
       && faddr < (void *)core_end
       && !(WRITABLE_PAGE_P(p))) {
@@ -1560,10 +1046,10 @@ memory_protect(int on) {
   INSTALL_MPROTECT_HANDLER;
 
   beg=first_protectable_page;
-  writable = IS_WRITABLE(beg);
+  writable = WRITABLE_PAGE_P(beg);
   for (i=beg ; ++i<= end; ) {
 
-    if (writable==IS_WRITABLE(i) && i<=end) continue;
+    if (writable==WRITABLE_PAGE_P(i) && i<end) continue;
 
     if (sgc_mprotect(beg,i-beg,writable)) 
       return -1;
index ee847b508d292efdf251237795fab3d1a316abee..c262b17e47c86bbf25e4da9d813bc1be3457beec 100755 (executable)
@@ -403,7 +403,7 @@ LFD(Lstring_not_equal)()   { string_sign =  0; string_boundary = 1;  FFN(Lstring
               char_bits(initial_element) != 0 ||
               char_font(initial_element) != 0)
                initial_element
-               = wrong_type_argument(sLstring_char, initial_element);
+               = wrong_type_argument(sLcharacter, initial_element);
        {BEGIN_NO_INTERRUPT;    
        x = alloc_simple_string(fix(size));
        x->st.st_self = alloc_relblock(fix(size));
index f71d8ae88d43faf7eaa1e2226260af51113f4d41..5ea5194a38ef093a421a21e03479ac37d0efd36a 100755 (executable)
@@ -257,7 +257,7 @@ LFD(siLmake_structure)(void)
 }
 
 static void
-FFN(siLcopy_structure)(void)
+FFN(Lcopy_structure)(void)
 {
        object x, y;
        struct s_data *def;
@@ -452,7 +452,7 @@ gcl_init_structure_function(void)
 
        make_si_function("MAKE-STRUCTURE", siLmake_structure);
        make_si_function("MAKE-S-DATA-STRUCTURE",siLmake_s_data_structure);
-       make_si_function("COPY-STRUCTURE", siLcopy_structure);
+       make_function("COPY-STRUCTURE", Lcopy_structure);
        make_si_function("STRUCTURE-NAME", siLstructure_name);
        /* make_si_function("STRUCTURE-REF", siLstructure_ref); */
        /* make_si_function("STRUCTURE-DEF", siLstructure_def); */
index 2d59075797e1fb835272ddff08d503b6b1e27d45..48a462eb6c851278da52fb8b6481ba688f8f91e6 100755 (executable)
@@ -68,12 +68,12 @@ FFN(Fdefun)(object args)
        }
        vs_base = vs_top;
        if (lex_env[0] == Cnil && lex_env[1] == Cnil && lex_env[2] == Cnil) {
-               vs_push(MMcons(sLlambda_block, args));
+               vs_push(MMcons(sSlambda_block, args));
        } else {
                vs_push(MMcons(lex_env[2], args));
                vs_base[0] = MMcons(lex_env[1], vs_base[0]);
                vs_base[0] = MMcons(lex_env[0], vs_base[0]);
-               vs_base[0] = MMcons(sLlambda_block_closure, vs_base[0]);
+               vs_base[0] = MMcons(sSlambda_block_closure, vs_base[0]);
        }
        {object fname =  clear_compiler_properties(name,vs_base[0]);
         fname->s.s_gfdef = vs_base[0];
index 9a8b124aaee6b2fb443592d543d0e46ca47b6fc9..1fadadbd48bd12eb61bc7c52b3de8fdb36b039a6 100755 (executable)
@@ -73,7 +73,7 @@ LFD(Ltype_of)(void)
                        if ((' ' <= i && i < '\177') || i == '\n')
                                vs_base[0] = sLstandard_char;
                        else
-                               vs_base[0] = sLstring_char;
+                               vs_base[0] = sLcharacter;
                }
                break;
 
@@ -176,7 +176,6 @@ LFD(Ltype_of)(void)
 DEF_ORDINARY("PROCLAIMED-ARG-TYPES",sSproclaimed_arg_types,SI,"");
 DEF_ORDINARY("PROCLAIMED-RETURN-TYPE",sSproclaimed_return_type,SI,"");
 DEF_ORDINARY("PROCLAIMED-FUNCTION",sSproclaimed_function,SI,"");
-DEF_ORDINARY("COMMON",sLcommon,LISP,"");
 DEF_ORDINARY("NULL",sLnull,LISP,"");
 DEF_ORDINARY("CONS",sLcons,LISP,"");
 DEF_ORDINARY("LIST",sLlist,LISP,"");
@@ -197,7 +196,6 @@ DEF_ORDINARY("CHARACTER",sLcharacter,LISP,"");
 DEF_ORDINARY("NUMBER",sLnumber,LISP,"");
 DEF_ORDINARY("RATIONAL",sLrational,LISP,"");
 DEF_ORDINARY("FLOAT",sLfloat,LISP,"");
-DEF_ORDINARY("STRING-CHAR",sLstring_char,LISP,"");
 DEF_ORDINARY("REAL",sLreal,LISP,"");
 DEF_ORDINARY("INTEGER",sLinteger,LISP,"");
 DEF_ORDINARY("RATIO",sLratio,LISP,"");
@@ -205,7 +203,6 @@ DEF_ORDINARY("SHORT-FLOAT",sLshort_float,LISP,"");
 DEF_ORDINARY("STANDARD-CHAR",sLstandard_char,LISP,"");
 DEF_ORDINARY("BOOLEAN",sLboolean,LISP,"");
 DEF_ORDINARY("FIXNUM",sLfixnum,LISP,"");
-DEF_ORDINARY("POSITIVE-FIXNUM",sLpositive_fixnum,LISP,"");
 DEF_ORDINARY("COMPLEX",sLcomplex,LISP,"");
 DEF_ORDINARY("SINGLE-FLOAT",sLsingle_float,LISP,"");
 DEF_ORDINARY("PACKAGE",sLpackage,LISP,"");
@@ -228,10 +225,10 @@ DEF_ORDINARY("VALUES",sLvalues,LISP,"");
 DEF_ORDINARY("MOD",sLmod,LISP,"");
 DEF_ORDINARY("SIGNED-BYTE",sLsigned_byte,LISP,"");
 DEF_ORDINARY("UNSIGNED-BYTE",sLunsigned_byte,LISP,"");
-DEF_ORDINARY("SIGNED-CHAR",sLsigned_char,LISP,"");
-DEF_ORDINARY("UNSIGNED-CHAR",sLunsigned_char,LISP,"");
-DEF_ORDINARY("SIGNED-SHORT",sLsigned_short,LISP,"");
-DEF_ORDINARY("UNSIGNED-SHORT",sLunsigned_short,LISP,"");
+DEF_ORDINARY("SIGNED-CHAR",sSsigned_char,SI,"");
+DEF_ORDINARY("UNSIGNED-CHAR",sSunsigned_char,SI,"");
+DEF_ORDINARY("SIGNED-SHORT",sSsigned_short,SI,"");
+DEF_ORDINARY("UNSIGNED-SHORT",sSunsigned_short,SI,"");
 DEF_ORDINARY("*",sLA,LISP,"");
 DEF_ORDINARY("PLUSP",sLplusp,LISP,"");
 DEF_ORDINARY("DIVISION-BY-ZERO",sLdivision_by_zero,LISP,"");
@@ -244,8 +241,6 @@ DEF_ORDINARY("UNDEFINED-FUNCTION",sLundefined_function,LISP,"");
 DEF_ORDINARY("UNBOUND-VARIABLE",sLunbound_variable,LISP,"");
 DEF_ORDINARY("PACKAGE-ERROR",sLpackage_error,LISP,"");
 
-/* #ifdef ANSI_COMMON_LISP */
-/* New ansi types */
 DEF_ORDINARY("METHOD-COMBINATION",sLmethod_combination,LISP,"");
 DEF_ORDINARY("ARITHMETIC-ERROR",sLarithmetic_error,LISP,"");
 DEF_ORDINARY("BASE-CHAR",sLbase_char,LISP,"");
@@ -290,7 +285,6 @@ DEF_ORDINARY("TWO-WAY-STREAM",sLtwo_way_stream,LISP,"");
 DEF_ORDINARY("TYPE-ERROR",sLtype_error,LISP,"");
 DEF_ORDINARY("UNBOUND-SLOT",sLunbound_slot,LISP,"");
 DEF_ORDINARY("WARNING",sLwarning,LISP,"");
-/* #endif */
 
 DEFCONST("CHAR-SIZE",sSchar_size,SI,small_fixnum(CHAR_SIZE),"Size in bits of a character");
 DEFCONST("SHORT-SIZE",sSshort_size,SI,small_fixnum(CHAR_SIZE*sizeof(short)),"Size in bits of a short integer");
index 8df244a659a023440a492b275c9647df8c445b8f..8a1ced7f8573446028e44da396a8e7a38ffc2ab7 100755 (executable)
@@ -634,7 +634,7 @@ find_section (char *name, char *section_names, char *file_name, ElfW(Ehdr) *old_
 static void
 unexec (char *new_name, char *old_name, unsigned int data_start, unsigned int bss_start, unsigned int entry_address)
 {
-  int new_file, old_file, new_file_size;
+  int new_file, old_file;
 
   /* Pointers to the base of the image of the two files. */
   caddr_t old_base, new_base;
@@ -654,17 +654,14 @@ unexec (char *new_name, char *old_name, unsigned int data_start, unsigned int bs
   /* Point to the section name table in the old file */
   char *old_section_names;
 
-  ElfW(Addr) old_bss_addr, new_bss_addr;
-  ElfW(Word) old_bss_size, new_data2_size,old_bss_offset;
-  ElfW(Off)  new_data2_offset;
-  ElfW(Addr) new_data2_addr;
+  ElfW(Addr) old_bss_addr, new_bss_addr,new_data2_addr;
+  ElfW(Off)  old_bss_size, new_data2_size,old_bss_offset,new_data2_offset,old_file_size,new_file_size;
 
   int n, nn;
   int old_bss_index, old_sbss_index;
   int old_data_index, new_data2_index;
   int old_mdebug_index;
   struct stat stat_buf;
-  int old_file_size;
 
   /* Open the old file, allocate a buffer of the right size, and read
      in the file contents.  */
index 6a26100904cb13e8d2340c8e6117ff8cf9246225..9b003c24a90ccae5847770313bdf50e6fb12867d 100755 (executable)
@@ -140,7 +140,7 @@ char *original_file, *save_file;
 
 extern void _cleanup();
 
-LFD(Lsave)() {
+LFD(siLsave)() {
   char filename[256];
   
   check_arg(1);
@@ -159,6 +159,6 @@ LFD(Lsave)() {
 void
 gcl_init_unixsave(void)
 {
-       make_function("SAVE", Lsave);
+       make_si_function("SAVE", siLsave);
 }
 
index 30560dd02ef59e0bd8765d938b27f79d8a364dff..98a9ff2b38dbdb0ff1dd0bc31e5f5e97e023b17d 100755 (executable)
@@ -169,7 +169,7 @@ msystem(const char *s) {
 }
 
 static void
-FFN(Lsystem)(void)
+FFN(siLsystem)(void)
 {
        char command[32768];
        int i;
@@ -284,6 +284,6 @@ un_mmap(void *v1,void *ve) {
 void
 gcl_init_unixsys(void) {
 
-  make_function("SYSTEM", Lsystem);
+  make_si_function("SYSTEM", siLsystem);
 
 }
index ff9d07d5faf8e01eff40b96af49a15820e23bc6e..0b557bb44e4e8f1dcffa3977fb6745b07e92aa2b 100755 (executable)
@@ -282,7 +282,7 @@ DEFUN_NEW("CURRENT-TIMEZONE",object,fScurrent_timezone,SI,0,0,NONE,IO,OO,OO,OO,(
   localtime_r(&_t, &lt);
   return (object)(gt.tm_hour-lt.tm_hour+24*(gt.tm_yday!=lt.tm_yday ? (gt.tm_year>lt.tm_year||gt.tm_yday>lt.tm_yday ? 1 : -1) : 0));
 #else
-  fixnum _t=time(0);
+  time_t _t=time(0);
   return (object)(-localtime(&_t)->tm_gmtoff/3600);
 #endif
 }
@@ -296,7 +296,7 @@ DEFUN_NEW("CURRENT-DSTP",object,fScurrent_dstp,SI,0,0,NONE,OO,OO,OO,OO,(void),""
 #elif defined NO_SYSTEM_TIME_ZONE /*solaris*/
   return Cnil;
 #else
-  fixnum _t=time(0);
+  time_t _t=time(0);
   return localtime(&_t)->tm_isdst > 0 ? Ct : Cnil;
 #endif
 }
index 9980298cfdaf4abc451805f7736653937054ae66..29c85280eb74fbb0a53ac48bbf53bdfa9d4e49ff 100644 (file)
 
 (in-package :user)
 
-#+kcl (in-package :walker :use '(:lisp))
-#+kcl (in-package :iterate :use '(:lisp :walker))
-#+kcl (in-package :pcl :use '(:walker :iterate :lisp))
+(load "package.lisp")
 
 (eval-when (compile load eval)
 
-(if (find-package ':walker)
-    (use-package '(:lisp) ':walker)
-    (make-package ':walker :use '(:lisp)))
-
-(if (find-package ':iterate)
-    (use-package '(:lisp :walker) ':iterate)
-    (make-package ':iterate :use '(:lisp :walker)))
-
-(if (find-package ':pcl)
-    (use-package '(:walker :iterate :lisp) ':pcl)
-    (make-package ':pcl :use '(:walker :iterate :lisp)))
-
 (export (intern (symbol-name :iterate)         ;Have to do this here,
                (find-package :iterate))        ;because in the defsystem
        (find-package :iterate))                ;(later in this file)
@@ -90,7 +76,7 @@
 
 (eval-when (compile load eval)
 (defvar *pcl-proclaim*
-  '(optimize (speed 3) (safety #+kcl 0 #-kcl 1) (space 0)
+  '(optimize (speed 3) (safety 1) (space 0)
              #+lucid (compilation-speed 0)))
 )
 
@@ -261,7 +247,6 @@ and load your system with:
            #+Xerox-Medley         (Xerox-Medley xerox)
            #+TI                   TI 
            #+(and dec vax common) Vaxlisp
-           #+KCL                  KCL
            #+IBCL                 IBCL
            #+gcl                  gcl
            #+excl                 (excl franz)
@@ -305,7 +290,6 @@ and load your system with:
         #+Cloe-Runtime                      ("l"     . "fasl")
         #+(and dec common vax (not ultrix)) ("LSP"   . "FAS")
         #+(and dec common vax ultrix)       ("lsp"   . "fas")
-        #+KCL                               ("lsp"   . "o")
         #+IBCL                              ("lsp"   . "o")
         #+Xerox                             ("lisp"  . "dfasl")
         #+(and Lucid MC68000)               ("lisp"  . "lbin")
@@ -675,7 +659,7 @@ and load your system with:
     ;; 3.0 it's in the LUCID-COMMON-LISP package.
     ;;
     #+LUCID (or lucid::*source-pathname* (bad-time))
-    #+akcl   si:*load-pathname*
+    #+akcl  *load-pathname*
     #+cmu17 *load-truename*
     #-(or Lispm excl Xerox (and dec vax common) LUCID akcl cmu17) nil))
 
index 493f8e19f1022dcdabc6c38c57a07722c4a93b05..115044d181b487413ad6123dea8c6f712642849f 100644 (file)
   
   nil))
 
-#+kcl
-(progn
-(import '(si:structurep si:structure-def si:structure-ref))
-(shadow 'lisp:dotimes)
-)
+#+kcl(import '(si:structurep si:structure-def si:structure-ref))
+
 #+kcl
 (in-package "SI")
 #+kcl
index 7f2cf6a9ab91aba3bd692eb0f6b1d711279867ea..19c928b01a159511f5fab94e1115cdf911730c7f 100644 (file)
       (push `(,(car f) .  (function  . (,#'unbound-lexical-function . nil)))
            lexicals))
     (dolist (m macros)
-      (push `(,(car m)  .  (macro . ( ,(cadr m) . nil))) 
+      (push `(,(car m)  .  (si::macro . ( ,(cadr m) . nil))) 
            lexicals))
     (list first lexicals third)))
 
   (when env
        (let ((entry (assoc macro (second env))))
          (and entry
-              (eq (cadr entry) 'macro)
+              (eq (cadr entry) 'si::macro)
               (caddr entry)))))
 );#+(or KCL IBCL)
 
 
 #+(or KCL IBCL)
 (progn
-  (define-walker-template lambda-block walk-named-lambda);Not really right,
+  (define-walker-template si::lambda-block walk-named-lambda);Not really right,
                                                         ;we don't hack block
                                                         ;names anyways.
   )
                         #+cmu17
                         (special-operator-p fn)
                         #-cmu17
-                        (special-form-p fn))
+                        (special-operator-p fn))
                    (error
                     "~S is a special form, not defined in the CommonLisp.~%~
                      manual This code walker doesn't know how to walk it.~%~
index 85c4d4269cd1fc5fc1d820305bc4e38b9068b0b1..f68e999ba4731e982c2317c95c5a37a35345bddb 100644 (file)
@@ -277,17 +277,17 @@ static object set_cclosure (object result_cc,object value_cc,fixnum available_si
   (fourth slotd))
 
 (defun renew-sys-files()
-  ;; packages:
-  (compiler::get-packages "sys-package.lisp")
-  (with-open-file (st "sys-package.lisp"
-                         :direction :output
-                         :if-exists :append)
-       (format st "(lisp::in-package \"SI\")
-(export '(%structure-name
-          %compiled-function-name
-          %set-compiled-function-name))
-(in-package \"PCL\")
-"))
+;;   ;; packages:
+;;   (compiler::get-packages "sys-package.lisp")
+;;   (with-open-file (st "sys-package.lisp"
+;;                       :direction :output
+;;                       :if-exists :append)
+;;     (format st "(lisp::in-package \"SI\")
+;; (export '(%structure-name
+;;           %compiled-function-name
+;;           %set-compiled-function-name))
+;; (in-package \"PCL\")
+;; "))
 
   ;; proclaims
   (compiler::make-all-proclaims "*.fn")
index 9617882119276df79432b0221155be53f1de457d..9fb21cfbc373970a40bbb1e53ce895ab60aed183 100644 (file)
@@ -9,9 +9,7 @@ GFILES:=$(addprefix gcl_pcl_gazonk,$(GFILES1))
 
 AFILES:=$(FILES) $(GFILES)
 
-SETUP='(load "sys-package.lisp")' \
-       '(setq *features* (delete (quote :kcl) *features*))'\
-       '(load "defsys.lisp")(push (quote :kcl) *features*)' \
+SETUP='(load "defsys.lisp")' \
        '(setq pcl::*default-pathname-extensions* (cons "lisp" "o"))' \
        '(setq pcl::*pathname-extensions* (cons "lisp" "o"))' \
        '(load "sys-proclaim.lisp")' \
diff --git a/pcl/package.lisp b/pcl/package.lisp
new file mode 100644 (file)
index 0000000..fc190e0
--- /dev/null
@@ -0,0 +1,21 @@
+(in-package :user)
+
+(eval-when (compile load eval)
+
+(if (find-package :walker)
+    (use-package '(:lisp) :walker)
+  (make-package :walker :use '(:lisp)))
+
+(if (find-package :iterate)
+    (use-package '(:lisp :walker) :iterate)
+    (make-package :iterate :use '(:lisp :walker)))
+
+(if (find-package :pcl)
+    (use-package '(:walker :iterate :lisp) :pcl)
+    (make-package :pcl :use '(:walker :iterate :lisp))))
+
+(in-package :pcl)
+(defvar *the-pcl-package* (find-package :pcl))
+(defun load-truename (&optional errorp) *load-pathname*)
+(import 'si::(clines defentry defcfun object void int double))
+(import 'si::compiler-let :walker)
index 8380d84909aa84cd93c8588164abd1d8cd06e2d9..2e1b703980e8e6106b0f776174199107ce89ca74 100644 (file)
 
-(IN-PACKAGE "PCL") 
-(PROCLAIM
-    '(FTYPE (FUNCTION NIL T)
-            INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST MAKE-ARG-INFO
-            RENEW-SYS-FILES ALLOCATE-FUNCALLABLE-INSTANCE-1
-            SHOW-DFUN-CONSTRUCTORS MAKE-CACHE SHOW-EMF-CALL-TRACE
-            INITIAL-DISPATCH-DFUN-INFO DISPATCH-DFUN-INFO
-            IN-THE-COMPILER-P UPDATE-DISPATCH-DFUNS
-            SHOW-FREE-CACHE-VECTORS NO-METHODS-DFUN-INFO
-            %%ALLOCATE-INSTANCE--CLASS DEFAULT-METHOD-ONLY-DFUN-INFO
-            BOOTSTRAP-META-BRAID GET-EFFECTIVE-METHOD-GENSYM
-            STRUCTURE-FUNCTIONS-EXIST-P LIST-ALL-DFUNS MAKE-CPD
-            CACHES-TO-ALLOCATE INITIAL-DFUN-INFO
-            ALLOCATE-FUNCALLABLE-INSTANCE-2 BOOTSTRAP-BUILT-IN-CLASSES)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T) *) DEFAULT-CODE-CONVERTER
-            MAKE-FINAL-DISPATCH-DFUN PROTOTYPES-FOR-MAKE-METHOD-LAMBDA
-            FIND-STRUCTURE-CLASS EARLY-COLLECT-INHERITANCE
-            EMIT-ONE-INDEX-WRITERS NET-CODE-CONVERTER
-            MAKE-DISPATCH-DFUN *NORMALIZE-TYPE COMPILE-IIS-FUNCTIONS
-            GENERIC-FUNCTION-NAME-P EMIT-IN-CHECKING-CACHE-P
-            EMIT-ONE-CLASS-READER GET-GENERIC-FUNCTION-INFO
-            COMPUTE-APPLICABLE-METHODS-EMF ANALYZE-LAMBDA-LIST
-            EMIT-ONE-INDEX-READERS EARLY-METHOD-FUNCTION PCL-DESCRIBE
-            TYPE-FROM-SPECIALIZER FIND-WRAPPER METHOD-PROTOTYPE-FOR-GF
-            SPECIALIZER-FROM-TYPE STRUCTURE-WRAPPER
-            GET-DISPATCH-FUNCTION EMIT-TWO-CLASS-READER
-            PARSE-METHOD-GROUP-SPECIFIER CLASS-EQ-TYPE
-            EMIT-CONSTANT-VALUE EMIT-TWO-CLASS-WRITER
-            CONVERT-TO-SYSTEM-TYPE PARSE-DEFMETHOD
-            EMIT-ONE-CLASS-WRITER)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (*) T) |__si::MAKE-CACHING| |__si::MAKE-N-N|
-            MAKE-INITIALIZE-INFO |__si::MAKE-NO-METHODS|
-            |__si::MAKE-TWO-CLASS| INTERN-PV-TABLE
-            |__si::MAKE-ARG-INFO| |__si::MAKE-ONE-INDEX-DFUN-INFO|
-            FIX-EARLY-GENERIC-FUNCTIONS CALLED-FIN-WITHOUT-FUNCTION
-            MAKE-FAST-METHOD-CALL STRING-APPEND |__si::MAKE-ONE-INDEX|
-            |__si::MAKE-INITIAL| |__si::MAKE-CHECKING| ZERO
-            |__si::MAKE-PV-TABLE| MAKE-PROGN FALSE MAKE-PV-TABLE
-            WALKER::UNBOUND-LEXICAL-FUNCTION |__si::MAKE-DISPATCH|
-            USE-PACKAGE-PCL TRUE |__si::MAKE-DEFAULT-METHOD-ONLY|
-            |__si::MAKE-INITIAL-DISPATCH| |__si::MAKE-CONSTANT-VALUE|
-            |__si::MAKE-DFUN-INFO| |__si::MAKE-STD-INSTANCE|
-            MAKE-METHOD-CALL |__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION|
-            MAKE-FAST-INSTANCE-BOUNDP |__si::MAKE-ACCESSOR-DFUN-INFO|
-            |STRUCTURE-OBJECT class constructor| |__si::MAKE-CACHE|
-            |__si::MAKE-ONE-CLASS| PV-WRAPPERS-FROM-PV-ARGS)) 
-(PROCLAIM '(FTYPE (FUNCTION (T) (OR CACHE NULL)) PV-TABLE-CACHE)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T *) *) MAKE-METHOD-FUNCTION-INTERNAL
-            PARSE-METHOD-OR-SPEC MAKE-METHOD-LAMBDA-INTERNAL
-            COERCE-TO-CLASS MAKE-FINAL-DFUN-INTERNAL GET-FUNCTION
-            EXTRACT-DECLARATIONS COMPILE-LAMBDA GET-FUNCTION1
-            MAKE-CACHING-DFUN GET-METHOD-FUNCTION DISPATCH-DFUN-COST
-            MACROEXPAND-ALL PARSE-SPECIALIZED-LAMBDA-LIST ENSURE-CLASS
-            WALK-FORM MAKE-INSTANCE-1 GET-DFUN-CONSTRUCTOR
-            MAP-ALL-CLASSES ENSURE-GENERIC-FUNCTION
-            MAKE-CONSTANT-VALUE-DFUN)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T) T) ACCESSOR-MISS-FUNCTION ADD-TO-CVECTOR
-            QUALIFIER-CHECK-RUNTIME SET-FUNCTION-PRETTY-ARGLIST
-            ADD-DIRECT-SUBCLASSES REMOVE-METHOD SET-WRAPPER
-            DOCTOR-DFUN-FOR-THE-DEBUGGER MAKE-PLIST
-            SYMBOL-OR-CONS-LESSP MAKE-STD-BOUNDP-METHOD-FUNCTION
-            UPDATE-CPL METHODS-CONVERTER MAKE-DFUN-ARG-LIST
-            MAKE-DISCRIMINATING-FUNCTION-ARGLIST
-            STANDARD-INSTANCE-ACCESS REMTAIL DO-SATISFIES-DEFTYPE
-            CPL-FORWARD-REFERENCED-CLASS-ERROR FIND-STANDARD-II-METHOD
-            MAKE-UNORDERED-METHODS-EMF UPDATE-INITIALIZE-INFO-INTERNAL
-            ADD-METHOD COMPUTE-PV |SETF PCL FIND-CLASS-PREDICATE|
-            PROCLAIM-DEFMETHOD UPDATE-ALL-PV-TABLE-CACHES
-            ITERATE::SIMPLE-EXPAND-ITERATE-FORM CLASS-MIGHT-PRECEDE-P
-            MEC-ALL-CLASSES SET-FUNCALLABLE-INSTANCE-FUNCTION
-            MAKE-DFUN-LAMBDA-LIST CHECKING-DFUN-INFO
-            METHOD-FUNCTION-RETURNING-T PV-WRAPPERS-FROM-ALL-WRAPPERS
-            SET-METHODS ITERATE::MV-SETQ SUPERCLASSES-COMPATIBLE-P
-            SLOT-EXISTS-P SWAP-WRAPPERS-AND-SLOTS DESCRIBE-PACKAGE
-            VALUE-FOR-CACHING SAUT-NOT-PROTOTYPE
-            SET-STANDARD-SVUC-METHOD PLIST-VALUE AUGMENT-TYPE
-            UPDATE-CLASS N-N-DFUN-INFO VARIABLE-SPECIAL-P
-            UPDATE-STD-OR-STR-METHODS ADD-FORMS MAKE-CAXR
-            MAKE-DLAP-LAMBDA-LIST REDIRECT-EARLY-FUNCTION-INTERNAL
-            GET-KEY-ARG1 EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION
-            MAKE-INTERNAL-READER-METHOD-FUNCTION |SETF PCL FIND-CLASS|
-            COMPUTE-CALLS PROCLAIM-DEFGENERIC WALKER::NOTE-DECLARATION
-            SYSTEM:%SET-COMPILED-FUNCTION-NAME VARIABLE-LEXICAL-P
-            CANONICALIZE-DEFCLASS-OPTION RAISE-METATYPE
-            PARSE-QUALIFIER-PATTERN SAUT-NOT-CLASS-EQ
-            MAKE-PV-TABLE-INTERNAL WALKER::ENVIRONMENT-FUNCTION
-            COMPUTE-APPLICABLE-METHODS-FUNCTION
-            EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION
-            PV-TABLE-LOOKUP VARIABLE-CLASS
-            MAKE-FAST-METHOD-CALL-LAMBDA-LIST |SETF PCL GDEFINITION|
-            NET-CONSTANT-CONVERTER WALKER::VARIABLE-SYMBOL-MACRO-P
-            SYMBOL-LESSP GF-MAKE-FUNCTION-FROM-EMF
-            REMOVE-DIRECT-SUBCLASSES UPDATE-INITS
-            |SETF PCL METHOD-FUNCTION-PLIST| COMPUTE-STD-CPL
-            CPL-INCONSISTENT-ERROR CHANGE-CLASS-INTERNAL
-            FIND-SLOT-DEFINITION COMPUTE-LAYOUT NO-SLOT
-            %SET-CCLOSURE-ENV COMPUTE-CONSTANTS
-            SET-STRUCTURE-SVUC-METHOD GET-KEY-ARG REMOVE-SLOT-ACCESSORS
-            MAKE-CDXR MEMF-CONSTANT-CONVERTER BOOTSTRAP-SLOT-INDEX
-            CLASS-CAN-PRECEDE-P MEC-ALL-CLASSES-INTERNAL
-            CLASSES-HAVE-COMMON-SUBCLASS-P MAKE-CLASS-PREDICATE
-            SAUT-NOT-CLASS DESTRUCTURE-INTERNAL
-            ITERATE::EXTRACT-SPECIAL-BINDINGS MAKE-EARLY-ACCESSOR
-            MAP-PV-TABLE-REFERENCES-OF MAKE-STD-WRITER-METHOD-FUNCTION
-            FUNCALLABLE-STANDARD-INSTANCE-ACCESS
-            METHOD-FUNCTION-RETURNING-NIL MEC-ALL-CLASS-LISTS
-            ADD-SLOT-ACCESSORS EMIT-1-NIL-DLAP
-            MAKE-STD-READER-METHOD-FUNCTION
-            CANONICALIZE-SLOT-SPECIFICATION LIST-EQ REAL-REMOVE-METHOD
-            WALKER::ENVIRONMENT-MACRO SAUT-NOT-EQL UPDATE-SLOTS
-            DEAL-WITH-ARGUMENTS-OPTION PRINTING-RANDOM-THING-INTERNAL
-             WALKER::WALK-REPEAT-EVAL
-            PV-WRAPPERS-FROM-ALL-ARGS WALKER::NOTE-LEXICAL-BINDING)) 
-(PROCLAIM '(FTYPE (FUNCTION (T) (INTEGER 1 255)) CACHE-NKEYS)) 
-(PROCLAIM '(FTYPE (FUNCTION (T) (INTEGER 1 256)) CACHE-LINE-SIZE)) 
-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T T) *) COMPUTE-CACHE-PARAMETERS)) 
-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T *) *) FIND-FREE-CACHE-LINE)) 
-(PROCLAIM '(FTYPE (FUNCTION (T) FIELD-TYPE) CACHE-FIELD)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T) FUNCTION) CACHE-LIMIT-FN
-            FAST-METHOD-CALL-FUNCTION METHOD-CALL-FUNCTION)) 
-(MAPC (LAMBDA (COMPILER::X)
-        (SETF (GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE) T))
-      '(TRACE-METHOD-INTERNAL FDEFINE-CAREFULLY DO-STANDARD-DEFSETF-1
-           REDEFINE-FUNCTION)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (FIXNUM FIXNUM T) FIXNUM)
-            COMPUTE-PRIMARY-CACHE-LOCATION)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T FIXNUM *) T) GET-CACHE-FROM-CACHE
-            COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T) (VALUES T T)) MAKE-KEYWORD
-            MAKE-CLASS-PREDICATE-NAME)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T *) T) FIND-CLASS-PREDICATE FIND-CLASS-CELL
-            USE-CONSTANT-VALUE-DFUN-P MAKE-EARLY-GF ITERATE::MAYBE-WARN
-            TRACE-METHOD ALLOCATE-FUNCALLABLE-INSTANCE WALKER::RELIST
-            UPDATE-DFUN USE-DISPATCH-DFUN-P PV-TABLE-LOOKUP-PV-ARGS
-            MAKE-WRAPPER EARLY-METHOD-SPECIALIZERS
-            INITIALIZE-METHOD-FUNCTION MAKE-FINAL-DFUN
-            WALKER::WALKER-ENVIRONMENT-BIND-1 MAKE-TYPE-PREDICATE-NAME
-            ALLOCATE-STRUCTURE-INSTANCE MAKE-SPECIALIZABLE
-            CAPITALIZE-WORDS SET-DFUN ITERATE::FUNCTION-LAMBDA-P
-            FIND-CLASS INITIALIZE-INTERNAL-SLOT-GFS SET-ARG-INFO
-            WALKER::RELIST* ALLOCATE-STANDARD-INSTANCE)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T) *) SAUT-NOT ENSURE-CLASS-VALUES
-            EMIT-CHECKING EMIT-DEFAULT-ONLY-FUNCTION EMIT-DEFAULT-ONLY
-            SAUT-CLASS CLASS-APPLICABLE-USING-CLASS-P EMIT-CACHING
-            DESTRUCTURE GET-NEW-FUNCTION-GENERATOR-INTERNAL
-            COMPUTE-TEST MAKE-DIRECT-SLOTD SLOT-NAME-LISTS-FROM-SLOTS
-            SAUT-EQL INSURE-DFUN CHECK-INITARGS-VALUES
-            SET-FUNCTION-NAME INITIAL-DFUN COMPUTE-STD-CPL-PHASE-1
-            *SUBTYPEP COMPUTE-APPLICABLE-METHODS-USING-TYPES
-            SDFUN-FOR-CACHING INVOKE-EMF SPLIT-DECLARATIONS
-            GENERATE-FAST-CLASS-SLOT-ACCESS-P COMPUTE-CODE SLOT-VALUE
-            SPECIALIZER-APPLICABLE-USING-TYPE-P SLOT-BOUNDP
-            FORM-LIST-TO-LISP ITERATE::PARSE-DECLARATIONS
-            MAKE-INSTANCE-FUNCTION-TRAP SAUT-PROTOTYPE
-            MUTATE-SLOTS-AND-CALLS SAUT-AND SAUT-CLASS-EQ
-            FIND-SUPERCLASS-CHAIN SLOT-UNBOUND-INTERNAL
-            UPDATE-SLOT-VALUE-GF-INFO SLOT-MAKUNBOUND)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION NIL *) EMIT-N-N-WRITERS EMIT-N-N-READERS
-            COUNT-ALL-DFUNS)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T) T) CHECKING-FUNCTION
-            METHOD-CALL-CALL-METHOD-ARGS EARLY-COLLECT-CPL
-            METHOD-FUNCTION-PV-TABLE ECD-OTHER-INITARGS
-            BOOTSTRAP-CLASS-PREDICATES CONSTANT-SYMBOL-P GDEFINITION
-            %FBOUNDP INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION
-            MAKE-INSTANCE-FUNCTION-SYMBOL FGEN-TEST
-            GF-PRECOMPUTE-DFUN-AND-EMF-P VARIABLE-GLOBALLY-SPECIAL-P
-            SLOT-INITARGS-FROM-STRUCTURE-SLOTD ARG-INFO-P
-            STRUCTURE-TYPE-INTERNAL-SLOTDS CCLOSUREP CHECKING-CACHE
-            GF-LAMBDA-LIST
-            MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
-            STRUCTURE-SVUC-METHOD DISPATCH-CACHE
-            BOOTSTRAP-ACCESSOR-DEFINITIONS FINAL-ACCESSOR-DFUN-TYPE
-            SETFBOUNDP ONE-CLASS-P EARLY-GF-P UPDATE-C-A-M-GF-INFO
-            FGEN-GENSYMS SORT-SLOTS MAKE-CLASS-EQ-PREDICATE N-N-CACHE
-            SFUN-P DFUN-ARG-SYMBOL
-            INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION
-            EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME
-            MAKE-TYPE-PREDICATE SORT-CALLS
-            MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION TWO-CLASS-WRAPPER1
-            USE-DEFAULT-METHOD-ONLY-DFUN-P FGEN-SYSTEM
-            CACHING-DFUN-COST CPD-CLASS CACHING-CACHE
-            INITIAL-DISPATCH-P LOOKUP-FGEN
-            COMPUTE-APPLICABLE-METHODS-EMF-STD-P COMPUTE-LINE-SIZE
-            GF-INFO-STATIC-C-A-M-EMF FAST-INSTANCE-BOUNDP-P
-            N-N-ACCESSOR-TYPE KEYWORD-SPEC-NAME DEFAULT-TEST-CONVERTER
-            RESET-INITIALIZE-INFO INITIAL-P
-            INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL
-            EXPAND-MAKE-INSTANCE-FORM STRUCTURE-SLOT-BOUNDP
-            STANDARD-SVUC-METHOD TWO-CLASS-INDEX
-            EARLY-CLASS-PRECEDENCE-LIST MAKE-INITIAL-DFUN GMAKUNBOUND
-            METHODS-CONTAIN-EQL-SPECIALIZER-P EXPAND-SHORT-DEFCOMBIN
-            ACCESSOR-DFUN-INFO-CACHE MAKE-CALL-METHODS
-            STRUCTURE-SLOTD-NAME ALLOCATE-CACHE-VECTOR
-            RESET-CLASS-INITIALIZE-INFO GET-SETF-FUNCTION-NAME
-            METHOD-CALL-P LEGAL-CLASS-NAME-P EXTRACT-PARAMETERS
-            EARLY-SLOT-DEFINITION-NAME ECD-METACLASS DISPATCH-P
-            METHOD-FUNCTION-PLIST %STD-INSTANCE-SLOTS
-            CANONICAL-SLOT-NAME CONSTANT-VALUE-DFUN-INFO
-            FUNCTION-RETURNING-T FUNCTION-PRETTY-ARGLIST
-            STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST CHECK-WRAPPER-VALIDITY
-            INITIALIZE-INFO-P CPD-AFTER
-            MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
-            ONE-INDEX-INDEX WALKER::ENV-DECLARATIONS
-            STRUCTURE-SLOTD-TYPE MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION
-            EVAL-FORM LIST-DFUN
-            INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION
-            CACHE-OWNER FAST-METHOD-CALL-PV-CELL DFUN-INFO-P
-            UPDATE-PV-TABLE-CACHE-INFO EARLY-CLASS-SLOTDS
-            FUNCTION-RETURNING-NIL ECD-CLASS-NAME
-            TWO-CLASS-ACCESSOR-TYPE EARLY-CLASS-DEFINITION
-            FAST-METHOD-CALL-P INITIALIZE-INFO-CACHED-RI-VALID-P
-            COMPUTE-MCASE-PARAMETERS GF-DFUN-INFO
-            INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST
-            EARLY-METHOD-LAMBDA-LIST ONE-CLASS-WRAPPER0
-            CLASS-PRECEDENCE-DESCRIPTION-P GET-MAKE-INSTANCE-FUNCTIONS
-            EXPAND-LONG-DEFCOMBIN MAP-SPECIALIZERS
-            EARLY-CLASS-DIRECT-SUBCLASSES WALKER::ENV-WALK-FORM
-            STRUCTURE-TYPE-INCLUDED-TYPE-NAME
-            ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE GBOUNDP ECD-SOURCE
-            CLASS-FROM-TYPE INITIALIZE-INFO-CACHED-NEW-KEYS
-            ARG-INFO-NKEYS DEFAULT-CONSTANT-CONVERTER
-            INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION
-            STORE-FGEN EARLY-METHOD-STANDARD-ACCESSOR-P
-            INTERN-FUNCTION-NAME NET-TEST-CONVERTER ARG-INFO-KEY/REST-P
-            COMPLICATED-INSTANCE-CREATION-METHOD
-            FTYPE-DECLARATION-FROM-LAMBDA-LIST
-            GENERIC-CLOBBERS-FUNCTION DEFAULT-STRUCTUREP
-            GF-INFO-C-A-M-EMF-STD-P ARG-INFO-VALID-P
-            FORMAT-CYCLE-REASONS FAST-METHOD-CALL-ARG-INFO
-            GET-MAKE-INSTANCE-FUNCTION-SYMBOL %STD-INSTANCE-WRAPPER
-            SLOT-BOUNDP-SYMBOL INITIAL-CACHE
-            METHOD-FUNCTION-NEEDS-NEXT-METHODS-P
-            SYSTEM:%COMPILED-FUNCTION-NAME MAKE-CALLS-TYPE-DECLARATION
-            UPDATE-CLASS-CAN-PRECEDE-P SLOT-READER-SYMBOL FREE-CACHE
-            DNET-METHODS-P CONSTANT-VALUE-CACHE
-            GET-BUILT-IN-CLASS-SYMBOL UPDATE-GFS-OF-CLASS
-            ONE-CLASS-CACHE STD-INSTANCE-P ONE-INDEX-CACHE
-            STRUCTURE-SLOTD-WRITER-FUNCTION FGEN-GENERATOR-LAMBDA
-            EXTRACT-SPECIALIZER-NAMES EARLY-SLOT-DEFINITION-LOCATION
-            DO-STANDARD-DEFSETFS-FOR-DEFCLASS %CCLOSURE-ENV
-            EARLY-ACCESSOR-METHOD-SLOT-NAME ACCESSOR-DFUN-INFO-P
-            INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS SLOT-WRITER-SYMBOL
-            ARG-INFO-KEYWORDS INITIALIZE-INFO-WRAPPER
-            FAST-METHOD-CALL-NEXT-METHOD-CALL INITIAL-DISPATCH-CACHE
-            NEXT-WRAPPER-FIELD
-            INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST CHECKING-P
-            EXTRACT-REQUIRED-PARAMETERS GET-BUILT-IN-WRAPPER-SYMBOL
-            INITIALIZE-INFO-CACHED-CONSTANTS
-            STRUCTURE-SLOTD-READER-FUNCTION EARLY-METHOD-CLASS
-            STRUCTURE-OBJECT-P DEFAULT-METHOD-ONLY-CACHE
-            PARSE-SPECIALIZERS INTERN-EQL-SPECIALIZER
-            COMPILE-LAMBDA-DEFERRED MAKE-CONSTANT-FUNCTION
-            MAKE-PV-TYPE-DECLARATION ARG-INFO-APPLYP
-            GET-PV-CELL-FOR-CLASS ONE-INDEX-DFUN-INFO-INDEX
-            UNENCAPSULATED-FDEFINITION CHECK-CACHE
-            WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE
-            INITIALIZE-INFO-KEY ONE-CLASS-INDEX SYSTEM:%STRUCTURE-NAME
-            SLOT-VECTOR-SYMBOL MAKE-PV-TABLE-TYPE-DECLARATION
-            TWO-CLASS-CACHE PROCLAIM-INCOMPATIBLE-SUPERCLASSES
-            BUILT-IN-OR-STRUCTURE-WRAPPER1 ECD-SUPERCLASS-NAMES
-            STRUCTURE-TYPE CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P
-            N-N-P INTERNED-SYMBOL-P DEFAULT-METHOD-ONLY-P
-            EARLY-CLASS-SLOTS NO-METHODS-P ARG-INFO-NUMBER-OPTIONAL
-            ONE-INDEX-P GET-MAKE-INSTANCE-FUNCTION EARLY-CLASS-NAME
-            METHOD-FUNCTION-FROM-FAST-FUNCTION MAKE-PERMUTATION-VECTOR
-            ONE-CLASS-ACCESSOR-TYPE TWO-CLASS-P BUILT-IN-WRAPPER-OF
-            FREE-CACHE-VECTOR GET-CACHE-VECTOR ARG-INFO-LAMBDA-LIST
-            UPDATE-GF-INFO ONE-INDEX-DFUN-INFO-CACHE %SYMBOL-FUNCTION
-            ACCESSOR-DFUN-INFO-ACCESSOR-TYPE FUNCALLABLE-INSTANCE-P
-            ECD-CANONICAL-SLOTS EARLY-COLLECT-SLOTS
-            INITIALIZE-INFO-CACHED-VALID-P UNPARSE-SPECIALIZERS
-            GF-INFO-FAST-MF-P
-            MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION
-            EARLY-CLASS-NAME-OF GF-DFUN-CACHE CLASS-PREDICATE
-            EXTRACT-LAMBDA-LIST CLASS-OF COPY-CACHE SYMBOL-PKG-NAME
-            ONE-INDEX-DFUN-INFO-P WRAPPER-OF METHOD-FUNCTION-METHOD
-            CPD-SUPERS DEFAULT-STRUCTURE-INSTANCE-P
-            STRUCTURE-SLOTD-INIT-FORM EARLY-METHOD-QUALIFIERS
-            LIST-LARGE-CACHE UPDATE-GF-SIMPLE-ACCESSOR-TYPE TYPE-CLASS
-            MAKE-EQL-PREDICATE EARLY-GF-NAME UPDATE-ALL-C-A-M-GF-INFO
-            FLUSH-CACHE-VECTOR-INTERNAL ITERATE::SEQUENCE-ACCESSOR
-            MAP-ALL-GENERIC-FUNCTIONS STRUCTURE-TYPE-P
-            FIND-CYCLE-REASONS DEFAULT-STRUCTURE-TYPE
-            COMPUTE-CLASS-SLOTS WRAPPER-FOR-STRUCTURE
-            INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION
-            USE-CACHING-DFUN-P EARLY-COLLECT-DEFAULT-INITARGS
-            DEFAULT-SECONDARY-DISPATCH-FUNCTION ONE-INDEX-ACCESSOR-TYPE
-            WALKER::ENV-WALK-FUNCTION WALKER::ENV-LOCK
-            STRUCTURE-SLOTD-ACCESSOR-SYMBOL
-            METHOD-LL->GENERIC-FUNCTION-LL CACHE-P WRAPPER-FIELD
-            INITIALIZE-INFO-BOUND-SLOTS DEFAULT-CONSTANTP
-            MAKE-FUNCTION-INLINE COMPUTE-STD-CPL-PHASE-2
-            CACHING-DFUN-INFO CONSTANT-VALUE-P
-            WALKER::GET-WALKER-TEMPLATE ARG-INFO-METATYPES COUNT-DFUN
-            MAKE-INITFUNCTION WALKER::ENV-LEXICAL-VARIABLES PV-TABLEP
-            COMPILE-LAMBDA-UNCOMPILED UNDEFMETHOD-1
-            GF-INFO-SIMPLE-ACCESSOR-TYPE FORCE-CACHE-FLUSHES
-            DFUN-INFO-CACHE GFS-OF-TYPE TWO-CLASS-WRAPPER0
-            ITERATE::VARIABLES-FROM-LET SHOW-DFUN-COSTS
-            ARG-INFO-PRECEDENCE FGEN-GENERATOR
-            RESET-CLASS-INITIALIZE-INFO-1 CACHING-P NO-METHODS-CACHE)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (*) *) INVALID-METHOD-ERROR
-            METHOD-COMBINATION-ERROR UNTRACE-METHOD
-            UPDATE-MAKE-INSTANCE-FUNCTION-TABLE LIST-LARGE-CACHES)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T) LIST) CACHE-OVERFLOW PV-TABLE-SLOT-NAME-LISTS
-            PV-TABLE-CALL-LIST)) 
-(PROCLAIM '(FTYPE (FUNCTION (T) BOOLEAN) CACHE-VALUEP)) 
-(PROCLAIM '(FTYPE (FUNCTION NIL FIXNUM) GET-WRAPPER-CACHE-NUMBER)) 
-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM T) T) %CCLOSURE-ENV-NTHCDR)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T T) *)
-            COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL
-            WALK-METHOD-LAMBDA
-            |(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))|
-            |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
-            |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))|
-            |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))|
-            |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))|
-            |(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))|
-            |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))|
-            |(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))|
-            |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))|
-            ADD-METHOD-DECLARATIONS
-            |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))|
-            MAKE-TWO-CLASS-ACCESSOR-DFUN
-            |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))|
-            |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))|
-            |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))|
-            |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
-            |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))|
-            |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))|
-            |(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))|
-            |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))|)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T T T T) *)
-            |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))|
-            ITERATE::ITERATE-TRANSFORM-BODY)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T *) *) ITERATE::RENAME-LET-BINDINGS
-            MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T) *) CONSTANT-VALUE-MISS
-            EMIT-ONE-OR-N-INDEX-READER/WRITER CACHING-MISS
-            CACHE-MISS-VALUES
-            |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))|
-            WALKER::WALK-FORM-INTERNAL
-            GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION
-            SLOT-VALUE-USING-CLASS-DFUN SLOT-BOUNDP-USING-CLASS-DFUN
-            |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))|
-            |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))|
-            |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))|
-            MAKE-FINAL-CONSTANT-VALUE-DFUN CHECK-METHOD-ARG-INFO
-            MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION
-            MAKE-FINAL-CACHING-DFUN EMIT-READER/WRITER-FUNCTION
-            SET-SLOT-VALUE
-            |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))|
-            WALKER::WALK-LET-IF ACCESSOR-VALUES1
-            |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))|
-            ITERATE::EXPAND-INTO-LET OPTIMIZE-SLOT-VALUE-BY-CLASS-P
-            ITERATE::RENAME-VARIABLES
-            EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION CHECKING-MISS
-            |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))|
-            ACCESSOR-VALUES-INTERNAL GET-CLASS-SLOT-VALUE-1
-            LOAD-LONG-DEFCOMBIN
-            |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))|
-            |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))|
-            MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION
-            |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))|
-            MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION
-            EMIT-READER/WRITER GENERATING-LISP
-            MAKE-FINAL-N-N-ACCESSOR-DFUN
-            |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))|
-            ITERATE::WALK-GATHERING-BODY
-            |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))|
-            GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
-            CONVERT-METHODS)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T) *) BOOTSTRAP-ACCESSOR-DEFINITION
-            INITIALIZE-INSTANCE-SIMPLE-FUNCTION
-            |(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))|
-            ORDER-SPECIALIZERS MAKE-ONE-CLASS-ACCESSOR-DFUN
-            |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))|
-            |(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))|
-            GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION
-            |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))|
-            SETF-SLOT-VALUE-USING-CLASS-DFUN
-            GENERATE-DISCRIMINATION-NET
-            MAKE-FINAL-ONE-INDEX-ACCESSOR-DFUN
-            |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))|
-            |(FAST-METHOD DESCRIBE-OBJECT (T T))| ACCESSOR-VALUES
-            LOAD-SHORT-DEFCOMBIN SET-CLASS-SLOT-VALUE-1
-            |(FAST-METHOD MAKE-INSTANCE (SYMBOL))|
-            REAL-MAKE-METHOD-LAMBDA EMIT-CHECKING-OR-CACHING-FUNCTION
-            |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))|
-            |(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))|
-            MAKE-SHARED-INITIALIZE-FORM-LIST
-            |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))|
-            ACCESSOR-MISS |(FAST-METHOD NO-APPLICABLE-METHOD (T))|
-            MAKE-FINAL-CHECKING-DFUN
-            |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))|
-            GET-ACCESSOR-METHOD-FUNCTION
-            |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))|
-            |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))|
-            |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))|
-            |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))|
-            |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))|
-            |(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))|
-            |(FAST-METHOD CHANGE-CLASS (T SYMBOL))|
-            EMIT-CHECKING-OR-CACHING)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T T T) *) MEMF-CODE-CONVERTER
-            |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
-            GENERATE-DISCRIMINATION-NET-INTERNAL
-            DO-SHORT-METHOD-COMBINATION
-            MAKE-LONG-METHOD-COMBINATION-FUNCTION
-            CACHE-MISS-VALUES-INTERNAL)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T *) *) MAKE-ONE-INDEX-ACCESSOR-DFUN
-            WALKER::WALK-DECLARATIONS GET-SECONDARY-DISPATCH-FUNCTION)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T *) *) SLOT-VALUE-OR-DEFAULT NESTED-WALK-FORM
-            LOAD-DEFGENERIC MAKE-ACCESSOR-TABLE
-            MAKE-DEFAULT-INITARGS-FORM-LIST
-            GET-EFFECTIVE-METHOD-FUNCTION MAKE-CHECKING-DFUN
-            GET-COMPLEX-INITIALIZATION-FUNCTIONS MAKE-N-N-ACCESSOR-DFUN
-            GET-SIMPLE-INITIALIZATION-FUNCTION MAKE-FINAL-ACCESSOR-DFUN
-            TYPES-FROM-ARGUMENTS MAKE-EFFECTIVE-METHOD-FUNCTION
-            COMPUTE-SECONDARY-DISPATCH-FUNCTION)) 
-(PROCLAIM '(FTYPE (FUNCTION (T T T T T T *) *) REAL-MAKE-A-METHOD)) 
-(PROCLAIM '(FTYPE (FUNCTION (T) SIMPLE-VECTOR) CACHE-VECTOR)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T T T) T) BOOTSTRAP-MAKE-SLOT-DEFINITION
-            |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
-            LOAD-DEFCLASS MAKE-EARLY-CLASS-DEFINITION
-            WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1 OPTIMIZE-GF-CALL
-            EMIT-SLOT-ACCESS REAL-LOAD-DEFCLASS SET-ARG-INFO1)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T T) T)
-            |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))|
-            |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))|
-            |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))|
-            |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
-            |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))|
-            EXPAND-EMF-CALL-METHOD
-            |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))|
-            COMPUTE-PV-SLOT
-            |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
-            |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))|
-            UPDATE-SLOTS-IN-PV BOOTSTRAP-MAKE-SLOT-DEFINITIONS
-            WALKER::WALK-TEMPLATE-HANDLE-REPEAT WALKER::WALK-BINDINGS-1
-            OPTIMIZE-ACCESSOR-CALL REAL-MAKE-METHOD-INITARGS-FORM
-            |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))|
-            |(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))|
-            MAKE-EMF-CACHE MAKE-METHOD-INITARGS-FORM-INTERNAL1
-            BOOTSTRAP-ACCESSOR-DEFINITIONS1
-            |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))|
-            MAKE-INSTANCE-FUNCTION-COMPLEX MAKE-FGEN
-            |(FAST-METHOD REMOVE-NAMED-METHOD (T T))|
-            |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))|
-            |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))|
-            MAKE-FINAL-ORDINARY-DFUN-INTERNAL
-            |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
-            MAKE-INSTANCE-FUNCTION-SIMPLE OPTIMIZE-INSTANCE-ACCESS
-            MAKE-PARAMETER-REFERENCES
-            GET-MAKE-INSTANCE-FUNCTION-INTERNAL
-            |(FAST-METHOD SLOT-UNBOUND (T T T))|
-            |(FAST-METHOD (SETF DOCUMENTATION) (T T))|
-            |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))|
-            |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
-            LOAD-FUNCTION-GENERATOR
-            |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))|
-            |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))|
-            |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))|
-            |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))|
-            OPTIMIZE-GENERIC-FUNCTION-CALL)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T *) T) EMIT-FETCH-WRAPPER FILL-CACHE
-            GET-METHOD CHECK-INITARGS-2-PLIST MAKE-EMF-CALL
-            CHECK-INITARGS-1 WALKER::WALK-ARGLIST REAL-GET-METHOD
-            CAN-OPTIMIZE-ACCESS1 CHECK-INITARGS-2-LIST)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T) T) ONE-CLASS-DFUN-INFO
-            |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))| SORT-METHODS
-            OPTIMIZE-GF-CALL-INTERNAL WALKER::WALK-LABELS
-            |(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))|
-            |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))|
-            WALKER::WALK-DO
-            |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))|
-            ITERATE::RENAME-AND-CAPTURE-VARIABLES EXPAND-DEFGENERIC
-            |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))|
-            |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))|
-            FLUSH-CACHE-TRAP WALKER::WALK-MACROLET
-            |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))|
-            |(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))|
-            COMPUTE-EFFECTIVE-METHOD OPTIMIZE-SET-SLOT-VALUE
-            WALKER::WALK-SYMBOL-MACROLET OPTIMIZE-SLOT-BOUNDP
-            |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))|
-            GET-FUNCTION-GENERATOR FIX-SLOT-ACCESSORS
-            SET-FUNCTION-NAME-1 WALKER::WALK-LET EMIT-BOUNDP-CHECK
-            INITIALIZE-INTERNAL-SLOT-GFS* PRINT-CACHE WALKER::WALK-IF
-            WALKER::WALK-SETQ WALKER::RELIST-INTERNAL
-            |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))|
-            EMIT-1-T-DLAP CAN-OPTIMIZE-ACCESS WALKER::WALK-COMPILER-LET
-            |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))|
-            |SETF PCL METHOD-FUNCTION-GET|
-            |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))|
-            GET-NEW-FUNCTION-GENERATOR WALKER::WALK-UNEXPECTED-DECLARE
-            |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))|
-            VARIABLE-DECLARATION
-            |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))|
-            MAP-ALL-ORDERS ONE-INDEX-DFUN-INFO WALKER::WALK-LAMBDA
-            |(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))|
-            NOTE-PV-TABLE-REFERENCE WALKER::RECONS
-            STANDARD-COMPUTE-EFFECTIVE-METHOD
-            |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))|
-            |SETF PCL PLIST-VALUE| EMIT-GREATER-THAN-1-DLAP
-            MAKE-METHOD-SPEC ITERATE::OPTIMIZE-GATHERING-FORM
-            OPTIMIZE-SLOT-VALUE PRINT-STD-INSTANCE COMPUTE-PRECEDENCE
-            WALKER::WALK-TAGBODY WALKER::WALK-NAMED-LAMBDA
-            |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))|
-            SKIP-FAST-SLOT-ACCESS-P TRACE-EMF-CALL-INTERNAL
-            |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))|
-            |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))|
-            |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))|
-            ITERATE::SIMPLE-EXPAND-GATHERING-FORM
-            |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))|
-            SORT-APPLICABLE-METHODS SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P
-            OBSOLETE-INSTANCE-TRAP WALKER::WALK-PROG
-            |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))|
-            INVALIDATE-WRAPPER
-            |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))|
-            |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))|
-            |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))|
-            ENTRY-IN-CACHE-P WALKER::WALK-TAGBODY-1
-            |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))|
-            MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
-            |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))|
-            WALKER::WALK-LOCALLY WALKER::WALK-MULTIPLE-VALUE-BIND
-            |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))|
-            |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))|
-            WRAP-METHOD-GROUP-SPECIFIER-BINDINGS WALKER::WALK-LET*
-            |(FAST-METHOD CLASS-PREDICATE-NAME (T))|
-            |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))|
-            |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))|
-            EMIT-SLOT-READ-FORM FIRST-FORM-TO-LISP
-            MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION
-            |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))|
-            WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL
-            WALKER::WALK-PROG* WALKER::WALK-FLET
-            |(FAST-METHOD SPECIALIZER-CLASS (CLASS))|
-            MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
-            |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))|
-            MAKE-METHOD-INITARGS-FORM-INTERNAL WALKER::WALK-DO*
-            MAKE-TOP-LEVEL-FORM
-            |(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))|
-            |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))|
-            |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))|
-            ITERATE::OPTIMIZE-ITERATE-FORM DECLARE-STRUCTURE
-            MAKE-DFUN-CALL ITERATE::VARIABLE-SAME-P
-            |(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))|
-            WALKER::WALK-MULTIPLE-VALUE-SETQ CONVERT-TABLE
-            |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))|
-            |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))|)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T) T)
-            |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))|
-            EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY
-            |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))|
-            WALKER::WALK-LET/LET*
-            |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))|
-            |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))|
-            |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))|
-            MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE
-            |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))|
-            |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))|
-            |(FAST-METHOD DOCUMENTATION (T))|
-            |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))|
-            MAYBE-EXPAND-ACCESSOR-FORM BOOTSTRAP-SET-SLOT
-            |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))|
-            WALKER::WALK-TEMPLATE
-            |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))|
-            |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))|
-            |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))|
-            GET-WRAPPERS-FROM-CLASSES
-            |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))|
-            MAKE-EFFECTIVE-METHOD-FUNCTION1
-            |(FAST-METHOD PRINT-OBJECT (CLASS T))|
-            |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))|
-            |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))|
-            EXPAND-CACHE EXPAND-DEFCLASS
-            |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))|
-            |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))|
-            |(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))|
-            |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))|
-            |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))|
-            |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))|
-            |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))|
-            |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))|
-            MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL
-            |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))|
-            |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))|
-            |(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))|
-            TWO-CLASS-DFUN-INFO
-            |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))|
-            |(FAST-METHOD PRINT-OBJECT (T T))|
-            |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))|
-            FILL-CACHE-P MEMF-TEST-CONVERTER
-            |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))|
-            WALKER::WALK-BINDINGS-2
-            |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))|
-            |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))|
-            |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))|
-            |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))|
-            |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))|
-            WALKER::WALK-DO/DO* ADJUST-CACHE
-            |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))|
-            |(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))|
-            |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))|
-            OPTIMIZE-READER
-            |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))|
-            |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))|
-            |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))|
-            EXPAND-SYMBOL-MACROLET-INTERNAL
-            |(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))|
-            |(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))|
-            MAKE-DISPATCH-LAMBDA
-            |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))|
-            |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))|
-            INITIALIZE-INSTANCE-SIMPLE
-            |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))|
-            OPTIMIZE-WRITER
-            |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))|
-            |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))|
-            |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))|
-            |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))|
-            LOAD-PRECOMPILED-IIS-ENTRY
-            LOAD-PRECOMPILED-DFUN-CONSTRUCTOR
-            |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))|
-            |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))|
-            |(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))|
-            WALKER::WALK-PROG/PROG*
-            |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))|
-            |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))|
-            |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))|
-            |(FAST-METHOD MAKE-INSTANCE (CLASS))|
-            |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))|
-            |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))|
-            |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))|)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T *) T) COMPUTE-SECONDARY-DISPATCH-FUNCTION1
-            FIND-CLASS-PREDICATE-FROM-CELL
-            ENSURE-GENERIC-FUNCTION-USING-CLASS GET-DECLARATION
-            METHOD-FUNCTION-GET CPL-ERROR EMIT-MISS
-            PRECOMPUTE-EFFECTIVE-METHODS GET-METHOD-FUNCTION-PV-CELL
-            MAP-CACHE EXPAND-EFFECTIVE-METHOD-FUNCTION
-            MAKE-EMF-FROM-METHOD GET-EFFECTIVE-METHOD-FUNCTION1
-            REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION
-            NAMED-OBJECT-PRINT-FUNCTION
-            MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE PROBE-CACHE
-            INITIALIZE-INFO REAL-ENSURE-GF-USING-CLASS--NULL
-            FIND-CLASS-FROM-CELL WALKER::CONVERT-MACRO-TO-LAMBDA
-            REAL-ADD-METHOD RECORD-DEFINITION)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T T T *) T) MAKE-DEFMETHOD-FORM
-            MAKE-DEFMETHOD-FORM-INTERNAL LOAD-DEFMETHOD
-            EARLY-MAKE-A-METHOD)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T T *) T) EMIT-DLAP
-            GET-SECONDARY-DISPATCH-FUNCTION1)) 
-(PROCLAIM '(FTYPE (FUNCTION (T T FIXNUM) T) COMPUTE-STD-CPL-PHASE-3)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T T T T T) T)
-            GET-SECONDARY-DISPATCH-FUNCTION2)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T *) T) REAL-ADD-NAMED-METHOD
-            EARLY-ADD-NAMED-METHOD FILL-DFUN-CACHE)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T T T T) T)
-            |(FAST-METHOD SLOT-MISSING (T T T T))|
-            LOAD-DEFMETHOD-INTERNAL EXPAND-DEFMETHOD)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T FIXNUM) T) GET-CACHE
-            FILL-CACHE-FROM-CACHE-P)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T T T T T T T T T *) T)
-            BOOTSTRAP-INITIALIZE-CLASS)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T) FIXNUM) N-N-ACCESSORS-LIMIT-FN
-            FAST-INSTANCE-BOUNDP-INDEX PV-TABLE-PV-SIZE
-            ARG-INFO-NUMBER-REQUIRED EARLY-CLASS-SIZE DEFAULT-LIMIT-FN
-            CHECKING-LIMIT-FN ONE-INDEX-LIMIT-FN CPD-COUNT CACHE-COUNT
-            PV-CACHE-LIMIT-FN CACHING-LIMIT-FN)) 
-(PROCLAIM '(FTYPE (FUNCTION (FIXNUM) T) POWER-OF-TWO-CEILING)) 
-(PROCLAIM '(FTYPE (FUNCTION (T T *) (VALUES T T)) SYMBOL-APPEND)) 
-(PROCLAIM '(FTYPE (FUNCTION (T STREAM T) T) PRINT-DFUN-INFO)) 
-(PROCLAIM
-    '(FTYPE (FUNCTION (T) NON-NEGATIVE-FIXNUM) CACHE-NLINES CACHE-MASK
-            CACHE-MAX-LOCATION CACHE-SIZE)) 
+(COMMON-LISP::IN-PACKAGE "PCL") 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FUNCTION)
+         PCL::CACHE-LIMIT-FN PCL::FAST-METHOD-CALL-FUNCTION
+         PCL::METHOD-CALL-FUNCTION)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T)
+         PCL::DISPATCH-DFUN-INFO PCL::DEFAULT-METHOD-ONLY-DFUN-INFO
+         PCL::MAKE-CACHE PCL::BOOTSTRAP-BUILT-IN-CLASSES
+         PCL::RENEW-SYS-FILES PCL::SHOW-EMF-CALL-TRACE PCL::MAKE-CPD
+         PCL::BOOTSTRAP-META-BRAID PCL::CACHES-TO-ALLOCATE
+         PCL::LIST-ALL-DFUNS PCL::INITIAL-DISPATCH-DFUN-INFO
+         PCL::INITIAL-DFUN-INFO PCL::%%ALLOCATE-INSTANCE--CLASS
+         PCL::MAKE-ARG-INFO PCL::ALLOCATE-FUNCALLABLE-INSTANCE-2
+         PCL::SHOW-FREE-CACHE-VECTORS PCL::UPDATE-DISPATCH-DFUNS
+         PCL::GET-EFFECTIVE-METHOD-GENSYM PCL::IN-THE-COMPILER-P
+         PCL::SHOW-DFUN-CONSTRUCTORS PCL::NO-METHODS-DFUN-INFO
+         PCL::INITIALIZE-CHECKING-OR-CACHING-FUNCTION-LIST
+         PCL::ALLOCATE-FUNCALLABLE-INSTANCE-1
+         PCL::STRUCTURE-FUNCTIONS-EXIST-P)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T) PCL::FIELD-TYPE)
+         PCL::CACHE-FIELD)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T)
+             COMMON-LISP::SIMPLE-VECTOR)
+         PCL::CACHE-VECTOR)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T)
+             (COMMON-LISP::INTEGER 1 256))
+         PCL::CACHE-LINE-SIZE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T)
+             (COMMON-LISP::INTEGER 1 255))
+         PCL::CACHE-NKEYS)) 
+(COMMON-LISP::MAPC
+    (COMMON-LISP::LAMBDA (COMPILER::X)
+      (COMMON-LISP::SETF
+          (COMMON-LISP::GET COMPILER::X 'SYSTEM::PROCLAIMED-CLOSURE)
+          COMMON-LISP::T))
+    '(PCL::REDEFINE-FUNCTION PCL::DO-STANDARD-DEFSETF-1
+         PCL::FDEFINE-CAREFULLY PCL::TRACE-METHOD-INTERNAL)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
+             (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T))
+         PCL::SYMBOL-APPEND)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T)
+         PCL::FAST-METHOD-CALL-NEXT-METHOD-CALL
+         PCL::GENERIC-CLOBBERS-FUNCTION PCL::STRUCTURE-SLOTD-TYPE
+         WALKER::GET-WALKER-TEMPLATE PCL::COMPILE-LAMBDA-UNCOMPILED
+         PCL::EXTRACT-LAMBDA-LIST PCL::DEFAULT-METHOD-ONLY-P
+         PCL::DISPATCH-CACHE PCL::STRUCTURE-SLOTD-NAME
+         PCL::FAST-METHOD-CALL-P PCL::SFUN-P
+         PCL::FTYPE-DECLARATION-FROM-LAMBDA-LIST
+         PCL::EARLY-CLASS-DEFINITION PCL::CONSTANT-SYMBOL-P
+         PCL::ARG-INFO-LAMBDA-LIST WALKER::ENV-LEXICAL-VARIABLES
+         PCL::INTERN-EQL-SPECIALIZER PCL::PARSE-SPECIALIZERS
+         PCL::%STD-INSTANCE-WRAPPER PCL::UPDATE-ALL-C-A-M-GF-INFO
+         PCL::INITIALIZE-INFO-CACHED-COMBINED-INITIALIZE-FUNCTION
+         PCL::STORE-FGEN PCL::COMPUTE-MCASE-PARAMETERS
+         PCL::INTERNED-SYMBOL-P PCL::MAKE-CALL-METHODS
+         PCL::USE-CACHING-DFUN-P PCL::LEGAL-CLASS-NAME-P
+         WALKER::VARIABLE-GLOBALLY-SPECIAL-P PCL::FUNCTION-RETURNING-T
+         PCL::METHOD-FUNCTION-METHOD PCL::GET-BUILT-IN-CLASS-SYMBOL
+         PCL::DEFAULT-STRUCTURE-TYPE PCL::GF-DFUN-INFO PCL::CACHING-P
+         PCL::FREE-CACHE-VECTOR PCL::ONE-CLASS-CACHE
+         PCL::DEFAULT-TEST-CONVERTER PCL::UNDEFMETHOD-1
+         PCL::MAKE-INITFUNCTION PCL::GET-CACHE-VECTOR
+         PCL::CLASS-PRECEDENCE-DESCRIPTION-P PCL::GF-INFO-FAST-MF-P
+         PCL::ECD-SOURCE PCL::INITIAL-P PCL::ARG-INFO-APPLYP
+         PCL::ARG-INFO-KEYWORDS
+         PCL::MAKE-DEFAULT-METHOD-GROUP-DESCRIPTION
+         PCL::CACHING-DFUN-COST PCL::INITIAL-DISPATCH-P PCL::EVAL-FORM
+         PCL::MAKE-CONSTANT-FUNCTION PCL::FUNCTION-RETURNING-NIL
+         PCL::INITIALIZE-INFO-BOUND-SLOTS PCL::FGEN-GENSYMS
+         PCL::EXPAND-SHORT-DEFCOMBIN WALKER::ENV-LOCK
+         PCL::INITIALIZE-INFO-CACHED-CONSTANTS
+         PCL::INITIALIZE-INFO-WRAPPER
+         PCL::STRUCTURE-TYPE-INCLUDED-TYPE-NAME PCL::TWO-CLASS-INDEX
+         PCL::ONE-INDEX-ACCESSOR-TYPE
+         PCL::EARLY-COLLECT-DEFAULT-INITARGS WALKER::ENV-WALK-FORM
+         PCL::STRUCTURE-TYPE-INTERNAL-SLOTDS PCL::MAKE-FUNCTION-INLINE
+         PCL::FLUSH-CACHE-VECTOR-INTERNAL
+         PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-T-FUNCTION
+         PCL::FGEN-GENERATOR PCL::CONSTANT-VALUE-P
+         PCL::METHOD-FUNCTION-FROM-FAST-FUNCTION
+         PCL::EARLY-CLASS-PRECEDENCE-LIST PCL::SLOT-BOUNDP-SYMBOL
+         PCL::ARG-INFO-NUMBER-OPTIONAL
+         PCL::GF-PRECOMPUTE-DFUN-AND-EMF-P PCL::GET-PV-CELL-FOR-CLASS
+         PCL::CHECKING-FUNCTION PCL::USE-DEFAULT-METHOD-ONLY-DFUN-P
+         PCL::INITIAL-DISPATCH-CACHE PCL::STRUCTURE-SVUC-METHOD
+         PCL::NO-METHODS-CACHE PCL::GF-DFUN-CACHE PCL::%CCLOSURE-ENV
+         PCL::CONSTANT-VALUE-CACHE PCL::BUILT-IN-WRAPPER-OF
+         PCL::CLASS-HAS-A-FORWARD-REFERENCED-SUPERCLASS-P
+         PCL::EARLY-COLLECT-CPL COMMON-LISP::CLASS-OF
+         PCL::STRUCTURE-SLOTD-ACCESSOR-SYMBOL PCL::SYMBOL-PKG-NAME
+         PCL::GDEFINITION
+         PCL::INITIALIZE-INFO-CACHED-SHARED-INITIALIZE-NIL-FUNCTION
+         PCL::ACCESSOR-DFUN-INFO-CACHE PCL::EXTRACT-SPECIALIZER-NAMES
+         PCL::CHECK-WRAPPER-VALIDITY PCL::MAKE-INITIAL-DFUN
+         PCL::WRAPPER-FIELD PCL::EARLY-SLOT-DEFINITION-LOCATION
+         PCL::EARLY-GF-P PCL::GF-INFO-STATIC-C-A-M-EMF PCL::LOOKUP-FGEN
+         PCL::MAKE-PV-TYPE-DECLARATION
+         PCL::INFORM-TYPE-SYSTEM-ABOUT-STD-CLASS
+         PCL::EARLY-METHOD-CLASS
+         PCL::DEFAULT-SECONDARY-DISPATCH-FUNCTION
+         WALKER::ENV-DECLARATIONS PCL::ALLOCATE-CACHE-VECTOR
+         PCL::FUNCTION-PRETTY-ARGLIST
+         PCL::EARLY-CLASS-DIRECT-SUBCLASSES
+         PCL::COMPUTE-APPLICABLE-METHODS-EMF-STD-P
+         PCL::MAKE-CLASS-EQ-PREDICATE PCL::ECD-OTHER-INITARGS
+         PCL::GBOUNDP PCL::METHOD-FUNCTION-PV-TABLE
+         WALKER::GET-IMPLEMENTATION-DEPENDENT-WALKER-TEMPLATE
+         PCL::MAKE-INSTANCE-FUNCTION-SYMBOL
+         PCL::MAKE-OPTIMIZED-STRUCTURE-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
+         PCL::FIND-CYCLE-REASONS PCL::FGEN-TEST
+         PCL::SLOT-INITARGS-FROM-STRUCTURE-SLOTD PCL::FREE-CACHE
+         PCL::TYPE-CLASS PCL::INITIAL-CACHE
+         PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS
+         PCL::STRUCTURE-SLOTD-WRITER-FUNCTION
+         PCL::INITIALIZE-INFO-CACHED-DEFAULT-INITARGS-FUNCTION
+         PCL::EARLY-COLLECT-SLOTS PCL::LIST-DFUN
+         PCL::EXPAND-MAKE-INSTANCE-FORM PCL::N-N-CACHE
+         PCL::MAKE-TYPE-PREDICATE PCL::INTERN-FUNCTION-NAME
+         PCL::GET-MAKE-INSTANCE-FUNCTIONS WALKER::ENV-WALK-FUNCTION
+         PCL::TWO-CLASS-CACHE PCL::MAKE-CALLS-TYPE-DECLARATION
+         PCL::MAKE-STRUCTURE-SLOT-BOUNDP-FUNCTION
+         PCL::INITIALIZE-INFO-KEY PCL::GF-LAMBDA-LIST
+         ITERATE::VARIABLES-FROM-LET PCL::COMPUTE-CLASS-SLOTS
+         PCL::DFUN-ARG-SYMBOL PCL::CHECKING-P PCL::ARG-INFO-P
+         PCL::INITIALIZE-INFO-CACHED-RI-VALID-P PCL::CHECKING-CACHE
+         PCL::METHOD-FUNCTION-PLIST PCL::STRUCTURE-OBJECT-P
+         PCL::ARG-INFO-PRECEDENCE PCL::ONE-CLASS-INDEX
+         PCL::STD-INSTANCE-P PCL::STRUCTURE-TYPE-SLOT-DESCRIPTION-LIST
+         PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
+         PCL::EARLY-SLOT-DEFINITION-NAME PCL::UNPARSE-SPECIALIZERS
+         PCL::STRUCTURE-TYPE-P PCL::ACCESSOR-DFUN-INFO-ACCESSOR-TYPE
+         PCL::PV-TABLEP PCL::CLASS-FROM-TYPE
+         PCL::GF-INFO-SIMPLE-ACCESSOR-TYPE PCL::STRUCTURE-TYPE
+         PCL::MAKE-EQL-PREDICATE PCL::TWO-CLASS-ACCESSOR-TYPE
+         PCL::DEFAULT-STRUCTURE-INSTANCE-P
+         PCL::EARLY-METHOD-STANDARD-ACCESSOR-SLOT-NAME
+         PCL::ONE-INDEX-DFUN-INFO-ACCESSOR-TYPE PCL::GFS-OF-TYPE
+         PCL::DEFAULT-STRUCTUREP PCL::EARLY-CLASS-NAME-OF
+         PCL::%STD-INSTANCE-SLOTS PCL::ONE-INDEX-INDEX PCL::WRAPPER-OF
+         PCL::ARG-INFO-VALID-P PCL::KEYWORD-SPEC-NAME
+         PCL::METHOD-CALL-P PCL::SHOW-DFUN-COSTS PCL::DFUN-INFO-CACHE
+         PCL::DEFAULT-CONSTANT-CONVERTER ITERATE::SEQUENCE-ACCESSOR
+         PCL::COUNT-DFUN PCL::EXPAND-LONG-DEFCOMBIN
+         PCL::CACHING-DFUN-INFO PCL::INITIALIZE-INFO-CACHED-VALID-P
+         PCL::FAST-INSTANCE-BOUNDP-P PCL::ARG-INFO-METATYPES
+         PCL::EXTRACT-PARAMETERS PCL::GF-INFO-C-A-M-EMF-STD-P
+         PCL::FINAL-ACCESSOR-DFUN-TYPE PCL::GMAKUNBOUND
+         PCL::FAST-METHOD-CALL-ARG-INFO PCL::COMPUTE-LINE-SIZE
+         PCL::ONE-INDEX-CACHE PCL::NO-METHODS-P
+         PCL::COMPUTE-STD-CPL-PHASE-2
+         PCL::COMPLICATED-INSTANCE-CREATION-METHOD
+         PCL::MAKE-PERMUTATION-VECTOR PCL::CONSTANT-VALUE-DFUN-INFO
+         PCL::TWO-CLASS-WRAPPER1 PCL::MAP-ALL-GENERIC-FUNCTIONS
+         PCL::CLASS-PREDICATE SYSTEM::%STRUCTURE-NAME
+         PCL::RESET-CLASS-INITIALIZE-INFO
+         PCL::BUILT-IN-OR-STRUCTURE-WRAPPER1 PCL::EARLY-CLASS-NAME
+         PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION-SYMBOL
+         PCL::UPDATE-PV-TABLE-CACHE-INFO PCL::SLOT-READER-SYMBOL
+         PCL::ARG-INFO-NKEYS PCL::METHOD-CALL-CALL-METHOD-ARGS
+         PCL::CCLOSUREP PCL::DEFAULT-METHOD-ONLY-CACHE
+         PCL::NEXT-WRAPPER-FIELD PCL::SLOT-WRITER-SYMBOL
+         PCL::ACCESSOR-DFUN-INFO-P
+         PCL::GET-MAKE-INSTANCE-FUNCTION-SYMBOL
+         PCL::EXTRACT-REQUIRED-PARAMETERS PCL::FORMAT-CYCLE-REASONS
+         PCL::UNENCAPSULATED-FDEFINITION
+         PCL::GET-BUILT-IN-WRAPPER-SYMBOL PCL::ONE-CLASS-P
+         PCL::ECD-METACLASS PCL::METHOD-LL->GENERIC-FUNCTION-LL
+         PCL::PROCLAIM-INCOMPATIBLE-SUPERCLASSES PCL::ONE-INDEX-P
+         PCL::INITIALIZE-INFO-CACHED-INITARGS-FORM-LIST
+         PCL::ECD-CANONICAL-SLOTS
+         PCL::METHOD-FUNCTION-NEEDS-NEXT-METHODS-P
+         PCL::INITIALIZE-INFO-CACHED-NEW-KEYS
+         PCL::STRUCTURE-SLOTD-READER-FUNCTION
+         PCL::INITIALIZE-INFO-CACHED-COMBINED-INITARGS-FORM-LIST
+         PCL::DISPATCH-P PCL::LIST-LARGE-CACHE
+         PCL::FAST-METHOD-CALL-PV-CELL PCL::GET-MAKE-INSTANCE-FUNCTION
+         PCL::DNET-METHODS-P PCL::STRUCTURE-SLOTD-INIT-FORM
+         PCL::UPDATE-CLASS-CAN-PRECEDE-P PCL::ONE-CLASS-ACCESSOR-TYPE
+         PCL::RESET-INITIALIZE-INFO PCL::STANDARD-SVUC-METHOD
+         PCL::DEFAULT-CONSTANTP PCL::UPDATE-C-A-M-GF-INFO
+         PCL::ONE-INDEX-DFUN-INFO-CACHE PCL::EARLY-CLASS-SLOTS
+         PCL::CPD-SUPERS PCL::FGEN-GENERATOR-LAMBDA
+         PCL::ECD-SUPERCLASS-NAMES PCL::ECD-CLASS-NAME PCL::SETFBOUNDP
+         PCL::GET-SETF-FUNCTION-NAME PCL::DFUN-INFO-P
+         PCL::SLOT-VECTOR-SYMBOL PCL::INITIALIZE-INFO-P
+         PCL::TWO-CLASS-P PCL::UPDATE-GF-SIMPLE-ACCESSOR-TYPE
+         PCL::COPY-CACHE PCL::MAKE-PV-TABLE-TYPE-DECLARATION
+         PCL::SORT-CALLS PCL::STRUCTURE-SLOT-BOUNDP PCL::%FBOUNDP
+         PCL::RESET-CLASS-INITIALIZE-INFO-1 PCL::UPDATE-GF-INFO
+         PCL::WRAPPER-FOR-STRUCTURE PCL::FUNCALLABLE-INSTANCE-P
+         PCL::CPD-CLASS PCL::EARLY-METHOD-STANDARD-ACCESSOR-P
+         PCL::SORT-SLOTS PCL::CANONICAL-SLOT-NAME
+         PCL::MAKE-OPTIMIZED-STRUCTURE-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION
+         PCL::EARLY-ACCESSOR-METHOD-SLOT-NAME PCL::%SYMBOL-FUNCTION
+         PCL::EARLY-METHOD-LAMBDA-LIST PCL::ONE-INDEX-DFUN-INFO-INDEX
+         PCL::N-N-ACCESSOR-TYPE PCL::CACHING-CACHE
+         PCL::EARLY-CLASS-SLOTDS PCL::ONE-INDEX-DFUN-INFO-P
+         SYSTEM::%COMPILED-FUNCTION-NAME
+         PCL::BOOTSTRAP-CLASS-PREDICATES PCL::NET-TEST-CONVERTER
+         PCL::DO-STANDARD-DEFSETFS-FOR-DEFCLASS PCL::TWO-CLASS-WRAPPER0
+         PCL::MAP-SPECIALIZERS PCL::EARLY-GF-NAME PCL::N-N-P
+         PCL::FGEN-SYSTEM PCL::METHODS-CONTAIN-EQL-SPECIALIZER-P
+         PCL::UPDATE-GFS-OF-CLASS PCL::ONE-CLASS-WRAPPER0
+         PCL::CPD-AFTER
+         PCL::INITIALIZE-INFO-CACHED-MAKE-INSTANCE-FUNCTION
+         PCL::CACHE-P PCL::EARLY-METHOD-QUALIFIERS PCL::CHECK-CACHE
+         PCL::FORCE-CACHE-FLUSHES PCL::CACHE-OWNER
+         PCL::COMPILE-LAMBDA-DEFERRED PCL::ARG-INFO-KEY/REST-P)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*)
+         COMMON-LISP::INVALID-METHOD-ERROR PCL::LIST-LARGE-CACHES
+         PCL::UPDATE-MAKE-INSTANCE-FUNCTION-TABLE PCL::UNTRACE-METHOD
+         COMMON-LISP::METHOD-COMBINATION-ERROR)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T)
+             PCL::NON-NEGATIVE-FIXNUM)
+         PCL::CACHE-MAX-LOCATION PCL::CACHE-NLINES PCL::CACHE-SIZE
+         PCL::CACHE-MASK)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::T)
+         PCL::MAKE-INTERNAL-READER-METHOD-FUNCTION
+         ITERATE::SIMPLE-EXPAND-ITERATE-FORM PCL::ADD-DIRECT-SUBCLASSES
+         PCL::PROCLAIM-DEFMETHOD PCL::UPDATE-INITIALIZE-INFO-INTERNAL
+         PCL::RAISE-METATYPE PCL::CLASS-CAN-PRECEDE-P
+         WALKER::VARIABLE-SPECIAL-P PCL::GF-MAKE-FUNCTION-FROM-EMF
+         PCL::|SETF PCL METHOD-FUNCTION-PLIST|
+         PCL::SET-FUNCTION-PRETTY-ARGLIST
+         PCL::FUNCALLABLE-STANDARD-INSTANCE-ACCESS
+         PCL::MAKE-DISCRIMINATING-FUNCTION-ARGLIST
+         PCL::DEAL-WITH-ARGUMENTS-OPTION WALKER::NOTE-DECLARATION
+         PCL::MAKE-CLASS-PREDICATE PCL::VALUE-FOR-CACHING
+         PCL::EMIT-1-NIL-DLAP PCL::MAKE-CAXR PCL::SYMBOL-LESSP
+         PCL::GET-KEY-ARG1 PCL::ADD-FORMS
+         PCL::EMIT-N-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION
+         PCL::DOCTOR-DFUN-FOR-THE-DEBUGGER
+         PCL::CLASSES-HAVE-COMMON-SUBCLASS-P PCL::N-N-DFUN-INFO
+         PCL::CANONICALIZE-SLOT-SPECIFICATION
+         PCL::REDIRECT-EARLY-FUNCTION-INTERNAL
+         PCL::UPDATE-STD-OR-STR-METHODS PCL::%SET-CCLOSURE-ENV
+         PCL::QUALIFIER-CHECK-RUNTIME
+         PCL::MAKE-STD-READER-METHOD-FUNCTION 
+         PCL::ADD-SLOT-ACCESSORS PCL::ADD-TO-CVECTOR
+         PCL::COMPUTE-LAYOUT PCL::DESTRUCTURE-INTERNAL
+         PCL::SUPERCLASSES-COMPATIBLE-P
+         PCL::COMPUTE-APPLICABLE-METHODS-FUNCTION ITERATE::MV-SETQ
+         PCL::COMPUTE-STD-CPL PCL::SET-METHODS PCL::CHECKING-DFUN-INFO
+         ITERATE::EXTRACT-SPECIAL-BINDINGS PCL::SWAP-WRAPPERS-AND-SLOTS
+         PCL::CANONICALIZE-DEFCLASS-OPTION PCL::MAKE-CDXR
+         PCL::PRINTING-RANDOM-THING-INTERNAL COMMON-LISP::ADD-METHOD
+         PCL::STANDARD-INSTANCE-ACCESS
+         SYSTEM::%SET-COMPILED-FUNCTION-NAME PCL::FIND-SLOT-DEFINITION
+         PCL::CLASS-MIGHT-PRECEDE-P
+         PCL::MAKE-STD-BOUNDP-METHOD-FUNCTION PCL::SAUT-NOT-EQL
+         PCL::SET-WRAPPER PCL::SET-STANDARD-SVUC-METHOD
+         PCL::SAUT-NOT-PROTOTYPE PCL::ACCESSOR-MISS-FUNCTION
+         PCL::NO-SLOT PCL::REMTAIL PCL::PV-WRAPPERS-FROM-ALL-ARGS
+         PCL::UPDATE-CLASS PCL::AUGMENT-TYPE PCL::MAKE-EARLY-ACCESSOR
+         PCL::MAKE-PLIST PCL::MEC-ALL-CLASSES-INTERNAL
+         PCL::MAKE-STD-WRITER-METHOD-FUNCTION
+         PCL::PARSE-QUALIFIER-PATTERN PCL::MEMF-CONSTANT-CONVERTER
+         PCL::|SETF PCL FIND-CLASS-PREDICATE|
+         PCL::MAKE-UNORDERED-METHODS-EMF WALKER::ENVIRONMENT-FUNCTION
+         PCL::MEC-ALL-CLASS-LISTS PCL::SAUT-NOT-CLASS-EQ
+         PCL::DO-SATISFIES-DEFTYPE PCL::SET-STRUCTURE-SVUC-METHOD
+         PCL::MAKE-DLAP-LAMBDA-LIST PCL::METHOD-FUNCTION-RETURNING-T
+         PCL::COMPUTE-CALLS PCL::REMOVE-SLOT-ACCESSORS
+         PCL::UPDATE-ALL-PV-TABLE-CACHES PCL::MAKE-DFUN-LAMBDA-LIST
+         WALKER::NOTE-LEXICAL-BINDING PCL::REMOVE-DIRECT-SUBCLASSES
+         PCL::MAP-PV-TABLE-REFERENCES-OF PCL::COMPUTE-CONSTANTS
+         PCL::METHOD-FUNCTION-RETURNING-NIL PCL::METHODS-CONVERTER
+         PCL::PV-TABLE-LOOKUP PCL::DESCRIBE-PACKAGE
+         COMMON-LISP::SLOT-EXISTS-P PCL::MAKE-PV-TABLE-INTERNAL
+         PCL::SAUT-NOT-CLASS PCL::|SETF PCL FIND-CLASS|
+         PCL::UPDATE-INITS PCL::UPDATE-CPL
+         PCL::EMIT-1-WRAPPER-COMPUTE-PRIMARY-CACHE-LOCATION
+         PCL::COMPUTE-PV WALKER::VARIABLE-LEXICAL-P
+         PCL::PROCLAIM-DEFGENERIC PCL::MAKE-DFUN-ARG-LIST
+         PCL::GET-KEY-ARG COMMON-LISP::REMOVE-METHOD
+         PCL::PV-WRAPPERS-FROM-ALL-WRAPPERS PCL::VARIABLE-CLASS
+         PCL::UPDATE-SLOTS PCL::SYMBOL-OR-CONS-LESSP
+         PCL::MEC-ALL-CLASSES PCL::LIST-EQ
+         PCL::SET-FUNCALLABLE-INSTANCE-FUNCTION
+         WALKER::WALK-REPEAT-EVAL WALKER::ENVIRONMENT-MACRO
+         WALKER::VARIABLE-SYMBOL-MACRO-P
+         PCL::MAKE-FAST-METHOD-CALL-LAMBDA-LIST
+         PCL::BOOTSTRAP-SLOT-INDEX PCL::PLIST-VALUE
+         PCL::CHANGE-CLASS-INTERNAL PCL::NET-CONSTANT-CONVERTER
+         PCL::|SETF PCL GDEFINITION| PCL::FIND-STANDARD-II-METHOD)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::*)
+         WALKER::WALK-FORM PCL::MAKE-INSTANCE-1
+         PCL::EXTRACT-DECLARATIONS PCL::GET-FUNCTION
+         WALKER::MACROEXPAND-ALL PCL::ALLOCATE-STRUCTURE-INSTANCE
+         PCL::MAKE-FINAL-DFUN-INTERNAL PCL::GET-METHOD-FUNCTION
+         PCL::COERCE-TO-CLASS PCL::MAP-ALL-CLASSES PCL::ENSURE-CLASS
+         PCL::PARSE-METHOD-OR-SPEC COMMON-LISP::ENSURE-GENERIC-FUNCTION
+         PCL::MAKE-CACHING-DFUN PCL::GET-FUNCTION1
+         PCL::GET-DFUN-CONSTRUCTOR PCL::MAKE-CONSTANT-VALUE-DFUN
+         PCL::MAKE-METHOD-FUNCTION-INTERNAL PCL::COMPILE-LAMBDA
+         PCL::PARSE-SPECIALIZED-LAMBDA-LIST PCL::DISPATCH-DFUN-COST
+         PCL::MAKE-METHOD-LAMBDA-INTERNAL)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T)
+             (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T))
+         PCL::MAKE-CLASS-PREDICATE-NAME PCL::MAKE-KEYWORD)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::T)
+         PCL::FIND-CLASS-FROM-CELL PCL::GET-METHOD-FUNCTION-PV-CELL
+         PCL::PROBE-CACHE PCL::NAMED-OBJECT-PRINT-FUNCTION
+         PCL::PRECOMPUTE-EFFECTIVE-METHODS
+         PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE
+         PCL::GET-EFFECTIVE-METHOD-FUNCTION1 PCL::MAKE-EMF-FROM-METHOD
+         PCL::EMIT-MISS PCL::REAL-ENSURE-GF-USING-CLASS--NULL
+         PCL::RECORD-DEFINITION WALKER::CONVERT-MACRO-TO-LAMBDA
+         PCL::INITIALIZE-INFO PCL::EXPAND-EFFECTIVE-METHOD-FUNCTION
+         PCL::METHOD-FUNCTION-GET PCL::FIND-CLASS-PREDICATE-FROM-CELL
+         PCL::ENSURE-GENERIC-FUNCTION-USING-CLASS
+         PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION1 PCL::GET-DECLARATION
+         PCL::REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION
+         PCL::MAP-CACHE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T)
+             COMMON-LISP::T)
+         PCL::|(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))|
+         PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))|
+         PCL::|(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))|
+         WALKER::WALK-PROG/PROG*
+         PCL::|(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))|
+         WALKER::WALK-BINDINGS-2
+         PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))|
+         WALKER::WALK-DO/DO*
+         PCL::|(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))|
+         PCL::|(FAST-METHOD DOCUMENTATION (T))|
+         PCL::|(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))|
+         PCL::|(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))|
+         PCL::|(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))|
+         PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))|
+         PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))|
+         PCL::INITIALIZE-INSTANCE-SIMPLE PCL::BOOTSTRAP-SET-SLOT
+         PCL::|(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))|
+         PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))|
+         PCL::|(FAST-METHOD PRINT-OBJECT (CLASS T))|
+         PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))|
+         PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))|
+         PCL::|(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))|
+         PCL::FILL-CACHE-P
+         PCL::|(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))|
+         PCL::|(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))|
+         PCL::|(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))|
+         PCL::|(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))|
+         PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))|
+         PCL::OPTIMIZE-WRITER PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-TYPE
+         PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-INTERNAL
+         PCL::|(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))|
+         PCL::MAKE-EFFECTIVE-METHOD-FUNCTION1
+         PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))|
+         PCL::|(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))|
+         PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))|
+         PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))|
+         PCL::|(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))|
+         PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))|
+         PCL::|(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))|
+         PCL::|(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))|
+         PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))|
+         PCL::ADJUST-CACHE
+         PCL::|(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))|
+         PCL::LOAD-PRECOMPILED-DFUN-CONSTRUCTOR
+         PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))|
+         PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))|
+         PCL::|(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))|
+         PCL::|(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))|
+         PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))|
+         PCL::MEMF-TEST-CONVERTER
+         PCL::|(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))|
+         PCL::|(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))|
+         PCL::|(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))|
+         WALKER::WALK-TEMPLATE PCL::TWO-CLASS-DFUN-INFO
+         PCL::EXPAND-CACHE
+         PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))|
+         PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))|
+         PCL::|(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))|
+         PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))|
+         PCL::GET-WRAPPERS-FROM-CLASSES
+         PCL::|(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))|
+         PCL::|(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))|
+         PCL::LOAD-PRECOMPILED-IIS-ENTRY
+         PCL::|(FAST-METHOD PRINT-OBJECT (T T))|
+         PCL::EXPAND-SYMBOL-MACROLET-INTERNAL
+         PCL::MAYBE-EXPAND-ACCESSOR-FORM
+         PCL::EMIT-CHECKING-OR-CACHING-FUNCTION-PRELIMINARY
+         PCL::|(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))|
+         PCL::|(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))|
+         PCL::|(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))|
+         PCL::|(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))|
+         PCL::|(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))|
+         PCL::EXPAND-DEFCLASS
+         PCL::|(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))|
+         WALKER::WALK-LET/LET* PCL::MAKE-DISPATCH-LAMBDA
+         PCL::|(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))|
+         PCL::|(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))|
+         PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))|
+         PCL::|(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))|
+         PCL::OPTIMIZE-READER
+         PCL::|(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))|
+         PCL::|(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))|
+         PCL::|(FAST-METHOD MAKE-INSTANCE (CLASS))|)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::T)
+         PCL::OPTIMIZE-SET-SLOT-VALUE
+         PCL::|(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))|
+         PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))|
+         PCL::MAKE-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
+         PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))|
+         PCL::|(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))|
+         PCL::PRINT-CACHE WALKER::WALK-UNEXPECTED-DECLARE
+         ITERATE::OPTIMIZE-ITERATE-FORM
+         PCL::|(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))|
+         WALKER::WALK-MULTIPLE-VALUE-SETQ PCL::FIRST-FORM-TO-LISP
+         PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))|
+         WALKER::WALK-LABELS
+         PCL::|(FAST-METHOD SPECIALIZER-CLASS (CLASS))|
+         PCL::ONE-CLASS-DFUN-INFO PCL::GET-FUNCTION-GENERATOR
+         WALKER::RELIST-INTERNAL PCL::NOTE-PV-TABLE-REFERENCE
+         WALKER::WALK-LAMBDA PCL::WRAP-METHOD-GROUP-SPECIFIER-BINDINGS
+         PCL::ONE-INDEX-DFUN-INFO PCL::MAP-ALL-ORDERS
+         PCL::OPTIMIZE-GF-CALL-INTERNAL PCL::COMPUTE-PRECEDENCE
+         WALKER::WALK-DO PCL::PRINT-STD-INSTANCE
+         PCL::OBSOLETE-INSTANCE-TRAP PCL::SORT-APPLICABLE-METHODS
+         PCL::|(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))|
+         PCL::EMIT-GREATER-THAN-1-DLAP
+         PCL::|(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))|
+         WALKER::WALK-FLET
+         PCL::|(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))|
+         PCL::|SETF PCL PLIST-VALUE| WALKER::WALK-PROG*
+         WALKER::VARIABLE-DECLARATION
+         PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))|
+         PCL::SKIP-FAST-SLOT-ACCESS-P PCL::SET-FUNCTION-NAME-1
+         WALKER::WALK-MACROLET PCL::CAN-OPTIMIZE-ACCESS
+         WALKER::WITH-AUGMENTED-ENVIRONMENT-INTERNAL
+         PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))|
+         PCL::|(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))|
+         PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))|
+         PCL::SKIP-OPTIMIZE-SLOT-VALUE-BY-CLASS-P
+         PCL::|(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))|
+         PCL::|(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))|
+         PCL::EMIT-BOUNDP-CHECK PCL::|SETF PCL METHOD-FUNCTION-GET|
+         PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))|
+         PCL::MAKE-METHOD-SPEC PCL::FLUSH-CACHE-TRAP WALKER::WALK-IF
+         PCL::OPTIMIZE-SLOT-BOUNDP
+         PCL::STANDARD-COMPUTE-EFFECTIVE-METHOD
+         WALKER::WALK-MULTIPLE-VALUE-BIND
+         ITERATE::RENAME-AND-CAPTURE-VARIABLES WALKER::WALK-LET*
+         WALKER::WALK-DO*
+         PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))|
+         PCL::INVALIDATE-WRAPPER
+         PCL::|(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))|
+         PCL::|(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))|
+         PCL::MAKE-OPTIMIZED-STD-SLOT-BOUNDP-USING-CLASS-METHOD-FUNCTION
+         ITERATE::SIMPLE-EXPAND-GATHERING-FORM PCL::ENTRY-IN-CACHE-P
+         WALKER::WALK-LOCALLY PCL::OPTIMIZE-SLOT-VALUE
+         PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL
+         PCL::|(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))|
+         PCL::|(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))|
+         PCL::|(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))|
+         PCL::|(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))|
+         PCL::TRACE-EMF-CALL-INTERNAL WALKER::WALK-SYMBOL-MACROLET
+         PCL::|(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))|
+         PCL::CONVERT-TABLE
+         PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))|
+         PCL::INITIALIZE-INTERNAL-SLOT-GFS*
+         PCL::|(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))|
+         PCL::|(FAST-METHOD CLASS-PREDICATE-NAME (T))|
+         PCL::|(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))|
+         PCL::MAKE-OPTIMIZED-STD-SETF-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
+         PCL::|(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))|
+         PCL::|(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))|
+         PCL::|(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))|
+         WALKER::WALK-SETQ PCL::EXPAND-DEFGENERIC
+         PCL::|(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))|
+         ITERATE::OPTIMIZE-GATHERING-FORM PCL::FIX-SLOT-ACCESSORS
+         PCL::EMIT-SLOT-READ-FORM WALKER::WALK-PROG
+         PCL::|(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))|
+         WALKER::WALK-NAMED-LAMBDA PCL::GET-NEW-FUNCTION-GENERATOR
+         PCL::|(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))|
+         WALKER::WALK-TAGBODY
+         PCL::|(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))|
+         WALKER::WALK-COMPILER-LET PCL::DECLARE-STRUCTURE
+         WALKER::WALK-LET ITERATE::VARIABLE-SAME-P
+         PCL::|(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))|
+         PCL::EMIT-1-T-DLAP PCL::MAKE-DFUN-CALL
+         PCL::COMPUTE-EFFECTIVE-METHOD PCL::SORT-METHODS
+         WALKER::WALK-TAGBODY-1
+         PCL::|(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))|
+         PCL::|(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))|
+         PCL::|(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))|
+         PCL::MAKE-TOP-LEVEL-FORM
+         PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))|
+         WALKER::RECONS)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::T)
+         PCL::UPDATE-SLOTS-IN-PV PCL::MAKE-INSTANCE-FUNCTION-COMPLEX
+         PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
+         PCL::GET-MAKE-INSTANCE-FUNCTION-INTERNAL
+         PCL::|(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))|
+         PCL::MAKE-INSTANCE-FUNCTION-SIMPLE
+         PCL::|(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))|
+         PCL::COMPUTE-PV-SLOT PCL::MAKE-METHOD-INITARGS-FORM-INTERNAL1
+         PCL::|(FAST-METHOD SLOT-UNBOUND (T T T))|
+         PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))|
+         PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))|
+         PCL::OPTIMIZE-INSTANCE-ACCESS
+         PCL::|(FAST-METHOD REMOVE-NAMED-METHOD (T T))|
+         PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))|
+         PCL::REAL-MAKE-METHOD-INITARGS-FORM
+         PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))|
+         PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))|
+         PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T T))|
+         PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))|
+         PCL::MAKE-FINAL-ORDINARY-DFUN-INTERNAL
+         PCL::BOOTSTRAP-MAKE-SLOT-DEFINITIONS
+         PCL::|(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))|
+         PCL::MAKE-PARAMETER-REFERENCES
+         PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))|
+         PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))|
+         PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))|
+         PCL::|(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
+         PCL::OPTIMIZE-ACCESSOR-CALL
+         WALKER::WALK-TEMPLATE-HANDLE-REPEAT WALKER::WALK-BINDINGS-1
+         PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))|
+         PCL::BOOTSTRAP-ACCESSOR-DEFINITIONS1
+         PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
+         PCL::MAKE-FGEN
+         PCL::|(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))|
+         PCL::|(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))|
+         PCL::OPTIMIZE-GENERIC-FUNCTION-CALL
+         PCL::LOAD-FUNCTION-GENERATOR PCL::MAKE-EMF-CACHE
+         PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))|
+         PCL::|(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
+         PCL::EXPAND-EMF-CALL-METHOD)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T)
+             COMMON-LISP::T)
+         PCL::EXPAND-DEFMETHOD PCL::LOAD-DEFMETHOD-INTERNAL)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::*)
+             COMMON-LISP::T)
+         PCL::FILL-CACHE PCL::CAN-OPTIMIZE-ACCESS1 PCL::MAKE-EMF-CALL
+         PCL::EMIT-FETCH-WRAPPER PCL::CHECK-INITARGS-2-LIST
+         PCL::GET-METHOD PCL::CHECK-INITARGS-2-PLIST
+         PCL::CHECK-INITARGS-1 PCL::REAL-GET-METHOD
+         WALKER::WALK-ARGLIST)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::T)
+         PCL::GET-SECONDARY-DISPATCH-FUNCTION2)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::*)
+             COMMON-LISP::T)
+         PCL::LOAD-DEFMETHOD PCL::MAKE-DEFMETHOD-FORM
+         PCL::EARLY-MAKE-A-METHOD PCL::MAKE-DEFMETHOD-FORM-INTERNAL)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::T)
+         PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
+         PCL::SET-ARG-INFO1 PCL::BOOTSTRAP-MAKE-SLOT-DEFINITION
+         PCL::LOAD-DEFCLASS PCL::REAL-LOAD-DEFCLASS
+         PCL::OPTIMIZE-GF-CALL WALKER::WALK-TEMPLATE-HANDLE-REPEAT-1
+         PCL::EMIT-SLOT-ACCESS PCL::MAKE-EARLY-CLASS-DEFINITION)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::T)
+         PCL::EMIT-DLAP PCL::GET-SECONDARY-DISPATCH-FUNCTION1)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::T)
+         PCL::EARLY-ADD-NAMED-METHOD PCL::FILL-DFUN-CACHE
+         PCL::REAL-ADD-NAMED-METHOD)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::*)
+             COMMON-LISP::T)
+         PCL::BOOTSTRAP-INITIALIZE-CLASS)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::FIXNUM)
+             COMMON-LISP::T)
+         PCL::COMPUTE-STD-CPL-PHASE-3)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::FIXNUM)
+             COMMON-LISP::T)
+         PCL::FILL-CACHE-FROM-CACHE-P PCL::GET-CACHE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::LIST)
+         PCL::PV-TABLE-CALL-LIST PCL::CACHE-OVERFLOW
+         PCL::PV-TABLE-SLOT-NAME-LISTS)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::FIXNUM COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::*)
+         PCL::COMPUTE-CACHE-PARAMETERS)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::FIXNUM COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::*)
+         PCL::FIND-FREE-CACHE-LINE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::BOOLEAN)
+         PCL::CACHE-VALUEP)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*)
+         PCL::DEFAULT-CODE-CONVERTER PCL::EMIT-IN-CHECKING-CACHE-P
+         PCL::METHOD-PROTOTYPE-FOR-GF PCL::EMIT-TWO-CLASS-WRITER
+         PCL::PARSE-METHOD-GROUP-SPECIFIER PCL::EMIT-ONE-CLASS-WRITER
+         PCL::EMIT-ONE-INDEX-WRITERS PCL::FIND-STRUCTURE-CLASS
+         PCL::PROTOTYPES-FOR-MAKE-METHOD-LAMBDA PCL::MAKE-DISPATCH-DFUN
+         PCL::COMPUTE-APPLICABLE-METHODS-EMF PCL::EARLY-METHOD-FUNCTION
+         PCL::NET-CODE-CONVERTER PCL::GET-DISPATCH-FUNCTION
+         PCL::STRUCTURE-WRAPPER PCL::FIND-WRAPPER PCL::CLASS-EQ-TYPE
+         PCL::TYPE-FROM-SPECIALIZER PCL::SPECIALIZER-FROM-TYPE
+         PCL::PCL-DESCRIBE PCL::PARSE-DEFMETHOD
+         PCL::ANALYZE-LAMBDA-LIST PCL::EMIT-ONE-CLASS-READER
+         PCL::EARLY-COLLECT-INHERITANCE PCL::GET-GENERIC-FUNCTION-INFO
+         PCL::COMPILE-IIS-FUNCTIONS PCL::EMIT-CONSTANT-VALUE
+         PCL::EMIT-ONE-INDEX-READERS PCL::GENERIC-FUNCTION-NAME-P
+         PCL::CONVERT-TO-SYSTEM-TYPE PCL::MAKE-FINAL-DISPATCH-DFUN
+         PCL::EMIT-TWO-CLASS-READER PCL::*NORMALIZE-TYPE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T)
+         PCL::|__si::MAKE-CLASS-PRECEDENCE-DESCRIPTION|
+         PCL::MAKE-FAST-INSTANCE-BOUNDP PCL::MAKE-INITIALIZE-INFO
+         PCL::|STRUCTURE-OBJECT class constructor|
+         PCL::|__si::MAKE-CACHE| PCL::|__si::MAKE-DEFAULT-METHOD-ONLY|
+         PCL::TRUE PCL::|__si::MAKE-PV-TABLE|
+         PCL::|__si::MAKE-ONE-INDEX| WALKER::UNBOUND-LEXICAL-FUNCTION
+         PCL::|__si::MAKE-CHECKING| PCL::MAKE-PV-TABLE
+         PCL::|__si::MAKE-NO-METHODS| PCL::MAKE-METHOD-CALL
+         PCL::CALLED-FIN-WITHOUT-FUNCTION PCL::USE-PACKAGE-PCL
+         PCL::INTERN-PV-TABLE PCL::|__si::MAKE-ACCESSOR-DFUN-INFO|
+         PCL::|__si::MAKE-DISPATCH|
+         PCL::|__si::MAKE-ONE-INDEX-DFUN-INFO|
+         PCL::|__si::MAKE-ARG-INFO| PCL::FIX-EARLY-GENERIC-FUNCTIONS
+         PCL::ZERO PCL::MAKE-PROGN PCL::|__si::MAKE-INITIAL|
+         PCL::|__si::MAKE-ONE-CLASS| PCL::|__si::MAKE-DFUN-INFO|
+         PCL::|__si::MAKE-CONSTANT-VALUE|
+         PCL::|__si::MAKE-STD-INSTANCE| PCL::PV-WRAPPERS-FROM-PV-ARGS
+         PCL::|__si::MAKE-TWO-CLASS| PCL::|__si::MAKE-N-N|
+         PCL::|__si::MAKE-CACHING| PCL::FALSE PCL::STRING-APPEND
+         PCL::|__si::MAKE-INITIAL-DISPATCH| PCL::MAKE-FAST-METHOD-CALL)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::FIXNUM)
+         PCL::ARG-INFO-NUMBER-REQUIRED PCL::PV-TABLE-PV-SIZE
+         PCL::CACHE-COUNT PCL::PV-CACHE-LIMIT-FN PCL::CHECKING-LIMIT-FN
+         PCL::CACHING-LIMIT-FN PCL::N-N-ACCESSORS-LIMIT-FN
+         PCL::DEFAULT-LIMIT-FN PCL::EARLY-CLASS-SIZE PCL::CPD-COUNT
+         PCL::ONE-INDEX-LIMIT-FN PCL::FAST-INSTANCE-BOUNDP-INDEX)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM) COMMON-LISP::T)
+         PCL::POWER-OF-TWO-CEILING)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::T)
+         PCL::MAKE-TYPE-PREDICATE-NAME PCL::MAKE-FINAL-DFUN
+         PCL::CAPITALIZE-WORDS PCL::SET-DFUN ITERATE::MAYBE-WARN
+         PCL::MAKE-EARLY-GF PCL::USE-DISPATCH-DFUN-P WALKER::RELIST
+         PCL::MAKE-SPECIALIZABLE PCL::PV-TABLE-LOOKUP-PV-ARGS
+         PCL::ALLOCATE-STANDARD-INSTANCE
+         PCL::ALLOCATE-FUNCALLABLE-INSTANCE
+         PCL::USE-CONSTANT-VALUE-DFUN-P ITERATE::FUNCTION-LAMBDA-P
+         PCL::UPDATE-DFUN PCL::SET-ARG-INFO
+         PCL::EARLY-METHOD-SPECIALIZERS PCL::MAKE-WRAPPER
+         PCL::FIND-CLASS-CELL WALKER::WALKER-ENVIRONMENT-BIND-1
+         PCL::TRACE-METHOD WALKER::RELIST* COMMON-LISP::FIND-CLASS
+         PCL::INITIALIZE-INTERNAL-SLOT-GFS PCL::FIND-CLASS-PREDICATE
+         PCL::INITIALIZE-METHOD-FUNCTION)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::*)
+         PCL::SAUT-NOT PCL::INVOKE-EMF PCL::SAUT-PROTOTYPE
+         PCL::COMPUTE-CODE ITERATE::PARSE-DECLARATIONS
+         PCL::SDFUN-FOR-CACHING
+         PCL::COMPUTE-APPLICABLE-METHODS-USING-TYPES
+         PCL::GET-NEW-FUNCTION-GENERATOR-INTERNAL
+         PCL::SLOT-NAME-LISTS-FROM-SLOTS PCL::DESTRUCTURE
+         PCL::SPLIT-DECLARATIONS PCL::MAKE-DIRECT-SLOTD
+         PCL::FORM-LIST-TO-LISP PCL::EMIT-CHECKING
+         PCL::CPL-FORWARD-REFERENCED-CLASS-ERROR PCL::COMPUTE-TEST
+         PCL::SET-FUNCTION-NAME COMMON-LISP::SLOT-BOUNDP PCL::SAUT-AND
+         PCL::EMIT-CACHING PCL::INITIAL-DFUN
+         COMMON-LISP::SLOT-MAKUNBOUND COMMON-LISP::SLOT-VALUE
+         PCL::UPDATE-SLOT-VALUE-GF-INFO
+         PCL::CLASS-APPLICABLE-USING-CLASS-P
+         PCL::CPL-INCONSISTENT-ERROR PCL::*SUBTYPEP
+         PCL::SLOT-UNBOUND-INTERNAL
+         PCL::GENERATE-FAST-CLASS-SLOT-ACCESS-P
+         PCL::CHECK-INITARGS-VALUES PCL::ENSURE-CLASS-VALUES
+         PCL::SAUT-EQL PCL::REAL-REMOVE-METHOD PCL::EMIT-DEFAULT-ONLY
+         PCL::INSURE-DFUN PCL::EMIT-DEFAULT-ONLY-FUNCTION
+         PCL::MUTATE-SLOTS-AND-CALLS PCL::FIND-SUPERCLASS-CHAIN
+         PCL::SAUT-CLASS PCL::MAKE-INSTANCE-FUNCTION-TRAP
+         PCL::SAUT-CLASS-EQ PCL::COMPUTE-STD-CPL-PHASE-1
+         PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T)
+             (COMMON-LISP::OR PCL::CACHE COMMON-LISP::NULL))
+         PCL::PV-TABLE-CACHE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::*)
+             COMMON-LISP::*)
+         WALKER::WALK-DECLARATIONS PCL::GET-SECONDARY-DISPATCH-FUNCTION
+         PCL::MAKE-ONE-INDEX-ACCESSOR-DFUN)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T)
+             COMMON-LISP::*)
+         PCL::MAKE-SHARED-INITIALIZE-FORM-LIST PCL::ACCESSOR-MISS
+         PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))|
+         PCL::|(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))|
+         PCL::|(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))|
+         PCL::|(FAST-METHOD NO-APPLICABLE-METHOD (T))|
+         PCL::SET-CLASS-SLOT-VALUE-1
+         PCL::|(FAST-METHOD DESCRIBE-OBJECT (CLASS T))|
+         PCL::|(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))|
+         PCL::GET-ACCESSOR-FROM-SVUC-METHOD-FUNCTION
+         PCL::SETF-SLOT-VALUE-USING-CLASS-DFUN
+         PCL::|(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))|
+         PCL::EMIT-CHECKING-OR-CACHING-FUNCTION
+         PCL::MAKE-FINAL-ONE-INDEX-ACCESSOR-DFUN
+         PCL::LOAD-SHORT-DEFCOMBIN PCL::EMIT-CHECKING-OR-CACHING
+         PCL::|(FAST-METHOD MAKE-INSTANCE (SYMBOL))|
+         PCL::MAKE-FINAL-CHECKING-DFUN
+         PCL::|(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))|
+         PCL::|(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))|
+         PCL::ACCESSOR-VALUES
+         PCL::|(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))|
+         PCL::|(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))|
+         PCL::REAL-MAKE-METHOD-LAMBDA
+         PCL::|(FAST-METHOD CHANGE-CLASS (T SYMBOL))|
+         PCL::GET-ACCESSOR-METHOD-FUNCTION
+         PCL::|(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))|
+         PCL::|(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))|
+         PCL::ORDER-SPECIALIZERS
+         PCL::|(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))|
+         PCL::GENERATE-DISCRIMINATION-NET
+         PCL::|(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))|
+         PCL::|(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))|
+         PCL::MAKE-ONE-CLASS-ACCESSOR-DFUN
+         PCL::|(FAST-METHOD DESCRIBE-OBJECT (T T))|
+         PCL::BOOTSTRAP-ACCESSOR-DEFINITION
+         PCL::INITIALIZE-INSTANCE-SIMPLE-FUNCTION)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::*)
+         PCL::GET-OPTIMIZED-STD-ACCESSOR-METHOD-FUNCTION
+         PCL::MAKE-OPTIMIZED-STD-WRITER-METHOD-FUNCTION
+         PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))|
+         PCL::|(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))|
+         PCL::|(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))|
+         PCL::MAKE-OPTIMIZED-STD-BOUNDP-METHOD-FUNCTION
+         PCL::CONVERT-METHODS WALKER::WALK-LET-IF
+         PCL::EMIT-READER/WRITER-FUNCTION PCL::ACCESSOR-VALUES-INTERNAL
+         PCL::|(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))|
+         PCL::LOAD-LONG-DEFCOMBIN PCL::CHECK-METHOD-ARG-INFO
+         PCL::ACCESSOR-VALUES1
+         PCL::|(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))|
+         PCL::GENERATING-LISP PCL::MAKE-FINAL-N-N-ACCESSOR-DFUN
+         WALKER::WALK-FORM-INTERNAL PCL::CONSTANT-VALUE-MISS
+         PCL::SLOT-VALUE-USING-CLASS-DFUN PCL::CACHING-MISS
+         PCL::|(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))|
+         PCL::SLOT-BOUNDP-USING-CLASS-DFUN PCL::CHECKING-MISS
+         PCL::|(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))|
+         PCL::EMIT-READER/WRITER ITERATE::EXPAND-INTO-LET
+         PCL::GET-CLASS-SLOT-VALUE-1
+         PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER-FUNCTION
+         PCL::MAKE-FINAL-CACHING-DFUN
+         PCL::|(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))|
+         PCL::|(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))|
+         PCL::GET-OPTIMIZED-STD-SLOT-VALUE-USING-CLASS-METHOD-FUNCTION
+         PCL::|(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))|
+         PCL::OPTIMIZE-SLOT-VALUE-BY-CLASS-P PCL::SET-SLOT-VALUE
+         PCL::EMIT-ONE-OR-N-INDEX-READER/WRITER
+         ITERATE::RENAME-VARIABLES
+         PCL::|(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))|
+         PCL::|(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))|
+         ITERATE::WALK-GATHERING-BODY PCL::CACHE-MISS-VALUES
+         PCL::MAKE-OPTIMIZED-STD-READER-METHOD-FUNCTION
+         PCL::MAKE-FINAL-CONSTANT-VALUE-DFUN)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::*)
+         PCL::DO-SHORT-METHOD-COMBINATION PCL::MEMF-CODE-CONVERTER
+         PCL::GENERATE-DISCRIMINATION-NET-INTERNAL
+         PCL::|(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
+         PCL::MAKE-LONG-METHOD-COMBINATION-FUNCTION
+         PCL::CACHE-MISS-VALUES-INTERNAL)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::*)
+         PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))|
+         PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))|
+         PCL::ADD-METHOD-DECLARATIONS
+         PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))|
+         PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))|
+         PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))|
+         PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))|
+         PCL::|(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))|
+         PCL::COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO-INTERNAL
+         PCL::|(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))|
+         PCL::|(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))|
+         PCL::|(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))|
+         PCL::MAKE-TWO-CLASS-ACCESSOR-DFUN
+         PCL::|(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))|
+         PCL::|(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))|
+         PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
+         PCL::|(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))|
+         PCL::|(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))|
+         PCL::|(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))|
+         PCL::|(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
+         PCL::WALK-METHOD-LAMBDA
+         PCL::|(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))|)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::*)
+             COMMON-LISP::*)
+         PCL::REAL-MAKE-A-METHOD)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::*)
+         PCL::MAKE-DEFAULT-INITARGS-FORM-LIST
+         PCL::GET-COMPLEX-INITIALIZATION-FUNCTIONS
+         PCL::SLOT-VALUE-OR-DEFAULT
+         PCL::GET-SIMPLE-INITIALIZATION-FUNCTION PCL::REAL-ADD-METHOD
+         PCL::LOAD-DEFGENERIC PCL::CPL-ERROR
+         PCL::MAKE-FINAL-ACCESSOR-DFUN PCL::MAKE-N-N-ACCESSOR-DFUN
+         PCL::TYPES-FROM-ARGUMENTS PCL::MAKE-ACCESSOR-TABLE
+         PCL::MAKE-CHECKING-DFUN WALKER::NESTED-WALK-FORM
+         PCL::GET-EFFECTIVE-METHOD-FUNCTION
+         PCL::COMPUTE-SECONDARY-DISPATCH-FUNCTION
+         PCL::MAKE-EFFECTIVE-METHOD-FUNCTION)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T)
+             COMMON-LISP::*)
+         ITERATE::ITERATE-TRANSFORM-BODY
+         PCL::|(FAST-METHOD SLOT-MISSING (T T T T))|
+         PCL::|(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))|)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::*)
+         PCL::MAKE-EFFECTIVE-METHOD-FUNCTION-SIMPLE1
+         ITERATE::RENAME-LET-BINDINGS)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::FIXNUM COMMON-LISP::FIXNUM COMMON-LISP::T)
+             COMMON-LISP::FIXNUM)
+         PCL::COMPUTE-PRIMARY-CACHE-LOCATION)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::FIXNUM COMMON-LISP::*)
+             COMMON-LISP::T)
+         PCL::COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION
+         PCL::GET-CACHE-FROM-CACHE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::FIXNUM COMMON-LISP::T)
+             COMMON-LISP::T)
+         PCL::%CCLOSURE-ENV-NTHCDR)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::STREAM COMMON-LISP::T)
+             COMMON-LISP::T)
+         PCL::PRINT-DFUN-INFO)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*)
+         PCL::COUNT-ALL-DFUNS PCL::EMIT-N-N-WRITERS
+         PCL::EMIT-N-N-READERS)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM)
+         PCL::GET-WRAPPER-CACHE-NUMBER)) 
 (IN-PACKAGE "PCL")
 
-(DOLIST (V '(DISASSEMBLE |(FAST-WRITER-METHOD SLOT-OBJECT OPTIONS)|
-                |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHODS)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT METHODS)|
-                |(FAST-WRITER-METHOD SLOT-CLASS DIRECT-SLOTS)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SLOTS)|
-                |(FAST-WRITER-METHOD SLOT-CLASS SLOTS)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT SLOTS)|
+(DOLIST (V '(|(FAST-WRITER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)|
                 |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-METHODS)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT SLOTS)|
+                |(FAST-WRITER-METHOD SLOT-CLASS SLOTS)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SLOTS)|
+                |(FAST-WRITER-METHOD SLOT-CLASS DIRECT-SLOTS)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT METHODS)|
+                |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHODS)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT OPTIONS)|
                 |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)|
                 ADD-READER-METHOD
                 SHORT-COMBINATION-IDENTITY-WITH-ONE-ARGUMENT
-                REMOVE-READER-METHOD |LISP::T class predicate|
-                EQL-SPECIALIZER-P |(SETF GENERIC-FUNCTION-NAME)|
-                OBJECT-PLIST SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL
-                |PCL::STANDARD-METHOD-COMBINATION class predicate|
-                |PCL::STANDARD-EFFECTIVE-SLOT-DEFINITION class predicate|
-                |PCL::STANDARD-DIRECT-SLOT-DEFINITION class predicate|
+                REMOVE-READER-METHOD EQL-SPECIALIZER-P
+                |(SETF GENERIC-FUNCTION-NAME)| OBJECT-PLIST
+                SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL
                 |PCL::STANDARD-SLOT-DEFINITION class predicate|
-                |PCL::STANDARD-OBJECT class predicate|
+                |PCL::STANDARD-DIRECT-SLOT-DEFINITION class predicate|
+                |PCL::STANDARD-EFFECTIVE-SLOT-DEFINITION class predicate|
+                |PCL::STANDARD-METHOD-COMBINATION class predicate|
                 |(FAST-READER-METHOD SLOT-OBJECT METHOD)|
-                |PCL::BUILT-IN-CLASS class predicate| SPECIALIZER-TYPE
-                |LISP::RATIONAL class predicate|
-                |LISP::RATIO class predicate| GF-DFUN-STATE
+                SPECIALIZER-TYPE GF-DFUN-STATE
                 |(SETF GENERIC-FUNCTION-METHOD-CLASS)|
-                |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)|
                 |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)|
+                |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)|
                 |(SETF GENERIC-FUNCTION-METHOD-COMBINATION)|
                 CLASS-DEFSTRUCT-CONSTRUCTOR
-                |(FAST-READER-METHOD DEFINITION-SOURCE-MIXIN SOURCE)|
                 |(FAST-READER-METHOD SLOT-OBJECT SOURCE)|
+                |(FAST-READER-METHOD DEFINITION-SOURCE-MIXIN SOURCE)|
                 METHOD-FAST-FUNCTION |(SETF GENERIC-FUNCTION-METHODS)|
                 |(SETF GF-PRETTY-ARGLIST)|
-                |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)|
-                |(FAST-READER-METHOD SLOT-OBJECT ARG-INFO)|
-                |(FAST-READER-METHOD SLOT-CLASS INITIALIZE-INFO)|
                 |(FAST-READER-METHOD SLOT-OBJECT INITIALIZE-INFO)|
+                |(FAST-READER-METHOD SLOT-CLASS INITIALIZE-INFO)|
+                |(FAST-READER-METHOD SLOT-OBJECT ARG-INFO)|
+                |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)|
                 SPECIALIZERP EXACT-CLASS-SPECIALIZER-P
-                |(FAST-READER-METHOD PCL-CLASS WRAPPER)|
                 |(FAST-READER-METHOD SLOT-OBJECT WRAPPER)|
-                |(FAST-READER-METHOD SLOT-DEFINITION INITARGS)|
+                |(FAST-READER-METHOD PCL-CLASS WRAPPER)|
                 |(FAST-READER-METHOD SLOT-OBJECT INITARGS)|
-                |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-CONSTRUCTOR)|
-                |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)|
-                |(FAST-READER-METHOD SLOT-OBJECT OPERATOR)|
+                |(FAST-READER-METHOD SLOT-DEFINITION INITARGS)|
                 |(FAST-READER-METHOD SHORT-METHOD-COMBINATION OPERATOR)|
-                |LISP::CHARACTER class predicate|
+                |(FAST-READER-METHOD SLOT-OBJECT OPERATOR)|
+                |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)|
+                |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-CONSTRUCTOR)|
                 COMPATIBLE-META-CLASS-CHANGE-P
-                |LISP::SEQUENCE class predicate|
-                |(FAST-READER-METHOD CLASS CLASS-EQ-SPECIALIZER)|
                 |(FAST-READER-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)|
+                |(FAST-READER-METHOD CLASS CLASS-EQ-SPECIALIZER)|
                 |(BOUNDP READER-FUNCTION)| TRACE-METHOD-INTERNAL
                 |(BOUNDP PREDICATE-NAME)| |(BOUNDP READERS)|
                 UPDATE-GF-DFUN |(BOUNDP CLASS-PRECEDENCE-LIST)|
-                |(BOUNDP ACCESSOR-FLAGS)| |(BOUNDP DOCUMENTATION)|
-                |(BOUNDP LOCATION)| SPECIALIZER-OBJECT
+                |(BOUNDP ACCESSOR-FLAGS)| |(BOUNDP LOCATION)|
+                |(BOUNDP DOCUMENTATION)| SPECIALIZER-OBJECT
                 |(BOUNDP INCOMPATIBLE-SUPERCLASS-LIST)|
                 ACCESSOR-METHOD-SLOT-NAME |(BOUNDP SPECIALIZERS)|
                 |(BOUNDP IDENTITY-WITH-ONE-ARGUMENT)|
                 CLASS-EQ-SPECIALIZER-P
                 |(FAST-BOUNDP-METHOD SLOT-OBJECT SOURCE)| SLOTS-FETCHER
                 |(SETF SLOT-ACCESSOR-STD-P)| REMOVE-WRITER-METHOD
-                |(BOUNDP INITFUNCTION)| |(BOUNDP WRITER-FUNCTION)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT ARG-INFO)|
+                |(BOUNDP WRITER-FUNCTION)| |(BOUNDP INITFUNCTION)|
                 |(FAST-BOUNDP-METHOD SLOT-OBJECT INITIALIZE-INFO)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT ARG-INFO)|
                 STRUCTURE-CLASS-P |(BOUNDP WRITERS)|
-                |(BOUNDP INITFORM)|
+                |(BOUNDP INITFORM)| |SETF COMMON-LISP CLASS-NAME|
                 |(FAST-BOUNDP-METHOD SLOT-OBJECT WRAPPER)|
                 |(FAST-BOUNDP-METHOD SLOT-OBJECT INITARGS)|
-                |LISP::BIT-VECTOR class predicate|
                 |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)|
                 UPDATE-CONSTRUCTORS |(BOUNDP SLOT-NAME)|
                 |(SETF SLOT-DEFINITION-INITARGS)| |(BOUNDP ALLOCATION)|
                 |(FAST-BOUNDP-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)|
-                DOCUMENTATION |(BOUNDP GENERIC-FUNCTION)|
-                |(BOUNDP FUNCTION)| |(BOUNDP LAMBDA-LIST)|
+                DOCUMENTATION |(BOUNDP FUNCTION)|
+                |(BOUNDP GENERIC-FUNCTION)| |(BOUNDP LAMBDA-LIST)|
                 METHOD-PRETTY-ARGLIST |(BOUNDP SLOT-DEFINITION)|
-                |LISP::ARRAY class predicate|
                 |(BOUNDP CAN-PRECEDE-LIST)| |(BOUNDP PROTOTYPE)|
                 CLASS-EQ-SPECIALIZER INFORM-TYPE-SYSTEM-ABOUT-CLASS
                 |PCL::DEFINITION-SOURCE-MIXIN class predicate|
-                |(BOUNDP DFUN-STATE)|
-                |LISP::STRUCTURE-OBJECT class predicate|
-                |(BOUNDP FROM-DEFCLASS-P)| COMPILE |(READER METHOD)|
-                |LISP::STANDARD-OBJECT class predicate|
+                |(BOUNDP DFUN-STATE)| |(BOUNDP FROM-DEFCLASS-P)|
+                |(READER METHOD)|
                 |(CALL STANDARD-COMPUTE-EFFECTIVE-METHOD)|
-                |(BOUNDP FAST-FUNCTION)|
-                |LISP::COMPLEX class predicate| |(BOUNDP METHOD-CLASS)|
-                |(READER SOURCE)| |(BOUNDP METHOD-COMBINATION)|
+                |(BOUNDP FAST-FUNCTION)| |(BOUNDP METHOD-CLASS)|
+                |(READER SOURCE)| |(BOUNDP INTERNAL-WRITER-FUNCTION)|
                 |(BOUNDP INTERNAL-READER-FUNCTION)|
-                |(BOUNDP INTERNAL-WRITER-FUNCTION)|
-                ACCESSOR-METHOD-CLASS |(BOUNDP DIRECT-METHODS)|
-                |(BOUNDP DIRECT-SLOTS)| |(BOUNDP BOUNDP-FUNCTION)|
-                |(BOUNDP DIRECT-SUPERCLASSES)|
-                |(BOUNDP DIRECT-SUBCLASSES)| |(BOUNDP OPTIONS)|
-                |(BOUNDP METHODS)| |(WRITER METHOD)|
-                |LISP::BUILT-IN-CLASS class predicate|
+                |(BOUNDP METHOD-COMBINATION)| ACCESSOR-METHOD-CLASS
+                |(BOUNDP DIRECT-SLOTS)| |(BOUNDP DIRECT-METHODS)|
+                |(BOUNDP BOUNDP-FUNCTION)| |(BOUNDP DIRECT-SUBCLASSES)|
+                |(BOUNDP DIRECT-SUPERCLASSES)| |(BOUNDP METHODS)|
+                |(BOUNDP OPTIONS)| |(WRITER METHOD)|
                 |PCL::DEPENDENT-UPDATE-MIXIN class predicate|
                 GENERIC-FUNCTION-PRETTY-ARGLIST |(WRITER SOURCE)|
+                |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))|
+                |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))|
+                |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))|
                 |(FAST-METHOD UPDATE-INSTANCE-FOR-DIFFERENT-CLASS (STANDARD-OBJECT STANDARD-OBJECT))|
-                |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))|
                 |(FAST-METHOD INITIALIZE-INSTANCE (SLOT-OBJECT))|
-                |(FAST-METHOD REINITIALIZE-INSTANCE (SLOT-OBJECT))|
-                |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (SPECIALIZER-WITH-OBJECT))|
-                |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (SPECIALIZER-WITH-OBJECT))|
+                |(FAST-METHOD SLOTS-TO-INSPECT (SLOT-CLASS SLOT-OBJECT))|
+                |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))|
+                |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))|
+                |(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))|
                 |(FAST-METHOD SAME-SPECIALIZER-P (CLASS-EQ-SPECIALIZER CLASS-EQ-SPECIALIZER))|
                 |(FAST-METHOD SAME-SPECIALIZER-P (EQL-SPECIALIZER EQL-SPECIALIZER))|
                 |(FAST-METHOD SAME-SPECIALIZER-P (SPECIALIZER SPECIALIZER))|
-                |(FAST-METHOD SPECIALIZER-METHOD-TABLE (EQL-SPECIALIZER))|
-                |(FAST-METHOD SPECIALIZER-CLASS (EQL-SPECIALIZER))|
-                |(FAST-METHOD SPECIALIZER-METHOD-TABLE (CLASS-EQ-SPECIALIZER))|
                 MAKE-BOUNDP-METHOD-FUNCTION
-                |LISP::STRING class predicate|
                 |(FAST-METHOD (SETF DOCUMENTATION) (T DOCUMENTATION-MIXIN))|
                 |(FAST-METHOD DOCUMENTATION (DOCUMENTATION-MIXIN))|
                 |PCL::METAOBJECT class predicate|
-                |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
                 |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
                 |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
-                |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
                 |(FAST-METHOD SLOT-BOUNDP-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
-                |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
-                |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
-                |(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))|
-                |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))|
-                |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))|
-                |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))|
-                |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))|
-                |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))|
+                |(FAST-METHOD SLOT-MAKUNBOUND-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
+                |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))|
+                |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))|
+                |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))|
+                |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))|
+                |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))|
+                |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))|
+                |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))|
+                |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))|
+                |(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))|
+                |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))|
+                |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))|
+                |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))|
+                |(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))|
+                |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))|
+                |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))|
+                |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
+                |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))|
                 |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (SYMBOL))|
                 |(FAST-METHOD METHOD-SPECIALIZERS (TRACED-METHOD))|
-                |(FAST-METHOD METHOD-FUNCTION (STANDARD-METHOD))|
+                |(FAST-METHOD METHOD-LAMBDA-LIST (TRACED-METHOD))|
+                |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION (STANDARD-GENERIC-FUNCTION))|
+                |(FAST-METHOD METHOD-PRETTY-ARGLIST (STANDARD-METHOD))|
                 |(FAST-METHOD ACCESSOR-METHOD-SLOT-NAME (TRACED-METHOD))|
                 |(FAST-METHOD COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO (STANDARD-GENERIC-FUNCTION))|
+                |(FAST-METHOD METHOD-QUALIFIERS (TRACED-METHOD))|
+                |(FAST-METHOD FUNCTION-KEYWORDS (STANDARD-METHOD))|
+                |(FAST-METHOD SLOT-VALUE-USING-CLASS (STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
+                |(FAST-METHOD (SETF DOCUMENTATION) (T STANDARD-SLOT-DEFINITION))|
+                |(FAST-METHOD SLOT-VALUE-USING-CLASS (STD-CLASS STANDARD-OBJECT STANDARD-EFFECTIVE-SLOT-DEFINITION))|
+                |(FAST-METHOD CHANGE-CLASS (T SYMBOL))|
                 |(FAST-METHOD DOCUMENTATION (STANDARD-SLOT-DEFINITION))|
                 |(FAST-METHOD MAKE-INSTANCE (SYMBOL))|
-                |(FAST-METHOD CHANGE-CLASS (T SYMBOL))|
                 |(FAST-METHOD (SETF SLOT-VALUE-USING-CLASS) (T STRUCTURE-CLASS STRUCTURE-OBJECT STRUCTURE-EFFECTIVE-SLOT-DEFINITION))|
-                |(FAST-METHOD ADD-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))|
-                |(FAST-METHOD REINITIALIZE-INSTANCE (STANDARD-METHOD))|
-                |(FAST-METHOD REMOVE-DIRECT-METHOD (CLASS METHOD))|
-                |(FAST-METHOD INITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))|
-                |(FAST-METHOD REMOVE-DIRECT-METHOD (SPECIALIZER-WITH-OBJECT METHOD))|
-                |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (STANDARD-GENERIC-FUNCTION))|
-                |(FAST-METHOD ADD-DIRECT-METHOD (CLASS METHOD))|
-                |(FAST-METHOD GENERIC-FUNCTION-PRETTY-ARGLIST (STANDARD-GENERIC-FUNCTION))|
-                |(FAST-METHOD INITIALIZE-INTERNAL-SLOT-FUNCTIONS (EFFECTIVE-SLOT-DEFINITION))|
-                |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-WRITER-METHOD))|
-                |(FAST-METHOD ACCESSOR-METHOD-CLASS (STANDARD-ACCESSOR-METHOD))|
-                |(FAST-METHOD GF-FAST-METHOD-FUNCTION-P (STANDARD-GENERIC-FUNCTION))|
-                |(FAST-METHOD GENERIC-FUNCTION-LAMBDA-LIST (GENERIC-FUNCTION))|
-                |(FAST-METHOD METHOD-QUALIFIERS (STANDARD-METHOD))|
-                |(FAST-METHOD SLOT-DEFINITION-ALLOCATION (STRUCTURE-SLOT-DEFINITION))|
                 |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T PCL-CLASS))|
-                |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))|
-                |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))|
-                |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))|
-                |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))|
-                |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))|
-                |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))|
-                |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))|
-                |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))|
-                |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))|
-                |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))|
-                |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))|
-                |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))|
-                |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))|
-                |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))|
-                |(FAST-METHOD MAKE-INSTANCE (CLASS))|
-                |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))|
-                |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))|
-                |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))|
-                |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))|
-                |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))|
-                |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))|
-                |(FAST-METHOD SPECIALIZER-CLASS (CLASS))|
+                |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))|
                 |(FAST-METHOD SLOTS-FETCHER (STANDARD-CLASS))|
-                |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))|
-                |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))|
-                |(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))|
-                |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))|
-                |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))|
-                |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))|
-                |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))|
-                |(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))|
-                |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))|
-                |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))|
-                |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))|
-                |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))|
-                |(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))|
+                |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))|
+                |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))|
                 |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (SLOT-CLASS))|
+                |(FAST-METHOD COMPUTE-SLOTS (STRUCTURE-CLASS))|
+                |(FAST-METHOD COMPUTE-SLOTS (STD-CLASS))|
                 |(FAST-METHOD WRAPPER-FETCHER (FUNCALLABLE-STANDARD-CLASS))|
-                |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))|
+                |(FAST-METHOD CLASS-DIRECT-DEFAULT-INITARGS (BUILT-IN-CLASS))|
+                |(FAST-METHOD CLASS-DIRECT-SLOTS (BUILT-IN-CLASS))|
+                |(FAST-METHOD FINALIZE-INHERITANCE (STRUCTURE-CLASS))|
+                |(FAST-METHOD MAKE-INSTANCES-OBSOLETE (STD-CLASS))|
                 |(FAST-METHOD WRAPPER-FETCHER (STANDARD-CLASS))|
-                |(FAST-METHOD CLASS-CONSTRUCTORS (SLOT-CLASS))|
-                |(FAST-METHOD CLASS-DEFAULT-INITARGS (BUILT-IN-CLASS))|
+                |(FAST-METHOD COMPUTE-SLOTS :AROUND (STRUCTURE-CLASS))|
+                |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (STANDARD-CLASS))|
+                |(FAST-METHOD SPECIALIZER-DIRECT-METHODS (CLASS))|
+                |(FAST-METHOD COMPUTE-DEFAULT-INITARGS (SLOT-CLASS))|
                 |(FAST-METHOD SPECIALIZER-DIRECT-GENERIC-FUNCTIONS (CLASS))|
-                |(FAST-METHOD CLASS-SLOT-CELLS (STD-CLASS))|
+                |(FAST-METHOD COMPUTE-SLOTS :AROUND (STD-CLASS))|
+                |(FAST-METHOD COMPUTE-CLASS-PRECEDENCE-LIST (SLOT-CLASS))|
+                |(FAST-METHOD CLASS-FINALIZED-P (PCL-CLASS))|
+                |(FAST-METHOD SLOTS-FETCHER (FUNCALLABLE-STANDARD-CLASS))|
+                |(FAST-METHOD SPECIALIZER-CLASS (CLASS))|
+                |(FAST-METHOD CLASS-DEFAULT-INITARGS (SLOT-CLASS))|
+                |(FAST-METHOD CLASS-SLOTS (BUILT-IN-CLASS))|
+                |(FAST-METHOD RAW-INSTANCE-ALLOCATOR (FUNCALLABLE-STANDARD-CLASS))|
+                |(FAST-METHOD FINALIZE-INHERITANCE (STD-CLASS))|
+                |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS BUILT-IN-CLASS))|
+                |(FAST-METHOD SAME-SPECIALIZER-P (CLASS CLASS))|
+                |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT STANDARD-CLASS))|
+                |(FAST-METHOD CHANGE-CLASS (STANDARD-OBJECT FUNCALLABLE-STANDARD-CLASS))|
+                |(FAST-METHOD VALIDATE-SUPERCLASS (FUNCALLABLE-STANDARD-CLASS STANDARD-CLASS))|
+                |(FAST-METHOD ALLOCATE-INSTANCE (FUNCALLABLE-STANDARD-CLASS))|
+                |(FAST-METHOD ALLOCATE-INSTANCE (STANDARD-CLASS))|
+                |(FAST-METHOD MAKE-INSTANCE (CLASS))|
+                |(FAST-METHOD VALIDATE-SUPERCLASS (CLASS CLASS))|
+                |(FAST-METHOD ADD-DIRECT-SUBCLASS (CLASS CLASS))|
+                |(FAST-METHOD VALIDATE-SUPERCLASS (SLOT-CLASS FORWARD-REFERENCED-CLASS))|
+                |(FAST-METHOD REMOVE-DIRECT-SUBCLASS (CLASS CLASS))|
+                |(FAST-METHOD REINITIALIZE-INSTANCE :BEFORE (SLOT-CLASS))|
+                |(FAST-METHOD CLASS-PROTOTYPE (STRUCTURE-CLASS))|
+                |(FAST-METHOD CLASS-PROTOTYPE (STD-CLASS))|
+                |(FAST-METHOD ALLOCATE-INSTANCE (STRUCTURE-CLASS))|
+                |(FAST-METHOD REINITIALIZE-INSTANCE :AFTER (SLOT-CLASS))|
                 CLASS-PREDICATE-NAME
-                |PCL::STRUCTURE-EFFECTIVE-SLOT-DEFINITION class predicate|
-                |PCL::STRUCTURE-DIRECT-SLOT-DEFINITION class predicate|
                 |PCL::STRUCTURE-SLOT-DEFINITION class predicate|
-                |PCL::STRUCTURE-OBJECT class predicate|
-                |LISP::SYMBOL class predicate|
+                |PCL::STRUCTURE-DIRECT-SLOT-DEFINITION class predicate|
+                |PCL::STRUCTURE-EFFECTIVE-SLOT-DEFINITION class predicate|
                 |PCL::EFFECTIVE-SLOT-DEFINITION class predicate|
                 |(COMBINED-METHOD SHARED-INITIALIZE)|
                 LEGAL-QUALIFIERS-P ADD-BOUNDP-METHOD
-                LEGAL-LAMBDA-LIST-P |LISP::VECTOR class predicate|
-                |SETF PCL GENERIC-FUNCTION-NAME|
+                LEGAL-LAMBDA-LIST-P |SETF PCL GENERIC-FUNCTION-NAME|
                 |(READER READER-FUNCTION)| |(READER PREDICATE-NAME)|
-                |(READER READERS)| DESCRIBE-OBJECT
-                |(READER CLASS-PRECEDENCE-LIST)|
-                |(READER ACCESSOR-FLAGS)| |(READER DOCUMENTATION)|
-                |(READER LOCATION)| CLASS-INITIALIZE-INFO
+                |(READER READERS)| |(READER CLASS-PRECEDENCE-LIST)|
+                |(READER ACCESSOR-FLAGS)| |(READER LOCATION)|
+                |(READER DOCUMENTATION)| CLASS-INITIALIZE-INFO
                 |(SETF CLASS-SLOT-VALUE)| MAKE-WRITER-METHOD-FUNCTION
                 |SETF PCL GF-DFUN-STATE|
                 |(READER INCOMPATIBLE-SUPERCLASS-LIST)|
                 |(READER IDENTITY-WITH-ONE-ARGUMENT)|
                 |(SETF CLASS-INITIALIZE-INFO)|
                 |(READER PRETTY-ARGLIST)| |(READER DEFSTRUCT-FORM)|
-                |SETF PCL CLASS-NAME| |SETF PCL SLOT-DEFINITION-NAME|
+                |SETF PCL SLOT-DEFINITION-NAME|
                 |(WRITER READER-FUNCTION)|
                 |(SETF CLASS-DEFSTRUCT-CONSTRUCTOR)|
                 |(WRITER PREDICATE-NAME)| |(WRITER READERS)|
-                |(READER INITFUNCTION)| |(READER WRITER-FUNCTION)|
+                |(READER WRITER-FUNCTION)| |(READER INITFUNCTION)|
                 INITIALIZE-INTERNAL-SLOT-FUNCTIONS
-                |SETF PCL SLOT-DEFINITION-TYPE|
-                |(WRITER CLASS-PRECEDENCE-LIST)| |(READER WRITERS)|
+                |SETF PCL SLOT-DEFINITION-TYPE| |(READER WRITERS)|
+                |(WRITER CLASS-PRECEDENCE-LIST)|
                 |(WRITER ACCESSOR-FLAGS)| |(READER INITFORM)|
-                METHOD-COMBINATION-P |(WRITER DOCUMENTATION)|
-                |(WRITER LOCATION)|
+                METHOD-COMBINATION-P |(WRITER LOCATION)|
+                |(WRITER DOCUMENTATION)|
                 |(CALL REAL-ENSURE-GF-USING-CLASS--GENERIC-FUNCTION)|
-                |SETF PCL METHOD-GENERIC-FUNCTION|
-                |SETF PCL GENERIC-FUNCTION-METHOD-COMBINATION|
                 |SETF PCL GENERIC-FUNCTION-METHODS|
-                |(READER SLOT-NAME)|
+                |SETF PCL GENERIC-FUNCTION-METHOD-COMBINATION|
+                |SETF PCL METHOD-GENERIC-FUNCTION| |(READER SLOT-NAME)|
                 |(WRITER INCOMPATIBLE-SUPERCLASS-LIST)|
                 |SETF PCL SLOT-ACCESSOR-STD-P|
                 |(CALL REAL-MAKE-METHOD-INITARGS-FORM)|
                 |(READER ALLOCATION)| |(WRITER SPECIALIZERS)|
                 |(CALL REAL-ENSURE-GF-USING-CLASS--NULL)|
                 |(WRITER IDENTITY-WITH-ONE-ARGUMENT)|
-                |(SETF METHOD-GENERIC-FUNCTION)| LEGAL-SPECIALIZERS-P
-                |(WRITER PRETTY-ARGLIST)| |SETF PCL OBJECT-PLIST|
-                |LISP::FLOAT class predicate| |(WRITER DEFSTRUCT-FORM)|
-                |(READER GENERIC-FUNCTION)| |(READER FUNCTION)|
+                |(SETF METHOD-GENERIC-FUNCTION)|
+                |(WRITER PRETTY-ARGLIST)| LEGAL-SPECIALIZERS-P
+                |SETF PCL OBJECT-PLIST| |(WRITER DEFSTRUCT-FORM)|
+                |(READER FUNCTION)| |(READER GENERIC-FUNCTION)|
                 |(READER LAMBDA-LIST)| |(READER SLOT-DEFINITION)|
                 |PCL::CLASS-PROTOTYPE-SPECIALIZER class predicate|
-                |SETF PCL CLASS-DEFSTRUCT-FORM|
                 |SETF PCL SLOT-DEFINITION-INITFORM|
+                |SETF PCL CLASS-DEFSTRUCT-FORM|
                 |(READER CAN-PRECEDE-LIST)|
                 |SETF PCL GENERIC-FUNCTION-METHOD-CLASS|
-                |(READER PROTOTYPE)| |(WRITER INITFUNCTION)|
-                |(WRITER WRITER-FUNCTION)| |(WRITER WRITERS)|
+                |(READER PROTOTYPE)| |(WRITER WRITER-FUNCTION)|
+                |(WRITER INITFUNCTION)| |(WRITER WRITERS)|
                 SLOT-ACCESSOR-STD-P |(WRITER INITFORM)|
                 |(READER DFUN-STATE)| |(READER FROM-DEFCLASS-P)|
                 |SETF PCL GF-PRETTY-ARGLIST|
-                |SETF PCL SLOT-DEFINITION-INITFUNCTION|
-                |SETF PCL SLOT-DEFINITION-ALLOCATION|
-                |SETF PCL SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION|
-                |SETF PCL SLOT-DEFINITION-INTERNAL-READER-FUNCTION|
-                |SETF PCL SLOT-DEFINITION-BOUNDP-FUNCTION|
-                |SETF PCL SLOT-DEFINITION-WRITER-FUNCTION|
-                |SETF PCL SLOT-DEFINITION-READER-FUNCTION|
+                |SETF PCL SLOT-ACCESSOR-FUNCTION|
                 |SETF PCL SLOT-DEFINITION-LOCATION|
-                |SETF PCL SLOT-ACCESSOR-FUNCTION| |(WRITER SLOT-NAME)|
-                |(BOUNDP NAME)| |(WRITER ALLOCATION)|
-                |(READER FAST-FUNCTION)| |(READER METHOD-CLASS)|
-                |(SETF OBJECT-PLIST)| |(READER METHOD-COMBINATION)|
-                |(READER INTERNAL-READER-FUNCTION)|
+                |SETF PCL SLOT-DEFINITION-READER-FUNCTION|
+                |SETF PCL SLOT-DEFINITION-WRITER-FUNCTION|
+                |SETF PCL SLOT-DEFINITION-BOUNDP-FUNCTION|
+                |SETF PCL SLOT-DEFINITION-INTERNAL-READER-FUNCTION|
+                |SETF PCL SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION|
+                |SETF PCL SLOT-DEFINITION-ALLOCATION|
+                |SETF PCL SLOT-DEFINITION-INITFUNCTION|
+                |(WRITER SLOT-NAME)| |(BOUNDP NAME)|
+                |(READER FAST-FUNCTION)| |(WRITER ALLOCATION)|
+                |(READER METHOD-CLASS)| |(SETF OBJECT-PLIST)|
                 |(READER INTERNAL-WRITER-FUNCTION)|
-                METHOD-COMBINATION-OPTIONS |(READER DIRECT-METHODS)|
-                |(READER DIRECT-SLOTS)|
-                |SETF PCL SLOT-DEFINITION-READERS|
-                |(READER BOUNDP-FUNCTION)| |(WRITER GENERIC-FUNCTION)|
-                |(WRITER FUNCTION)| |(READER DIRECT-SUPERCLASSES)|
-                |(READER DIRECT-SUBCLASSES)| |SETF PCL DOCUMENTATION|
-                |(WRITER LAMBDA-LIST)| |LISP::LIST class predicate|
-                FUNCALLABLE-STANDARD-CLASS-P |(BOUNDP CLASS)|
+                |(READER INTERNAL-READER-FUNCTION)|
+                |(READER METHOD-COMBINATION)|
+                METHOD-COMBINATION-OPTIONS |(READER DIRECT-SLOTS)|
+                |(READER DIRECT-METHODS)|
+                |SETF PCL SLOT-DEFINITION-READERS| |(WRITER FUNCTION)|
+                |(WRITER GENERIC-FUNCTION)| |(READER BOUNDP-FUNCTION)|
+                |SETF PCL DOCUMENTATION| |(READER DIRECT-SUBCLASSES)|
+                |(READER DIRECT-SUPERCLASSES)| |(WRITER LAMBDA-LIST)|
+                FUNCALLABLE-STANDARD-CLASS-P
                 |(FAST-WRITER-METHOD SLOT-OBJECT METHOD)|
-                |(WRITER SLOT-DEFINITION)| |(READER OPTIONS)|
-                |(READER METHODS)| |(WRITER CAN-PRECEDE-LIST)|
-                |SETF PCL SLOT-VALUE-USING-CLASS|
+                |(BOUNDP CLASS)| |(WRITER SLOT-DEFINITION)|
+                |(READER METHODS)| |(READER OPTIONS)|
+                |(WRITER CAN-PRECEDE-LIST)|
                 |SETF PCL SLOT-DEFINITION-CLASS|
-                |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)|
+                |SETF PCL SLOT-VALUE-USING-CLASS|
                 |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-ACCESSOR-SYMBOL)|
-                |(WRITER PROTOTYPE)| |(BOUNDP OBJECT)| |(BOUNDP TYPE)|
-                CLASS-CAN-PRECEDE-LIST |SETF PCL CLASS-SLOTS|
-                |SETF PCL CLASS-DIRECT-SLOTS| SLOT-ACCESSOR-FUNCTION
+                |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION DEFSTRUCT-ACCESSOR-SYMBOL)|
+                |(WRITER PROTOTYPE)| |(BOUNDP TYPE)| |(BOUNDP OBJECT)|
+                CLASS-CAN-PRECEDE-LIST |SETF PCL CLASS-DIRECT-SLOTS|
+                |SETF PCL CLASS-SLOTS| SLOT-ACCESSOR-FUNCTION
                 |(BOUNDP PLIST)|
                 |SETF PCL CLASS-INCOMPATIBLE-SUPERCLASS-LIST|
                 |SETF PCL SLOT-DEFINITION-WRITERS|
                 |(WRITER DFUN-STATE)| |(WRITER FROM-DEFCLASS-P)|
                 |(BOUNDP SLOTS)| SLOT-CLASS-P
                 MAKE-READER-METHOD-FUNCTION LEGAL-METHOD-FUNCTION-P
-                |(FAST-WRITER-METHOD SLOT-OBJECT ARG-INFO)|
-                |(FAST-WRITER-METHOD SLOT-CLASS INITIALIZE-INFO)|
                 |(FAST-WRITER-METHOD SLOT-OBJECT INITIALIZE-INFO)|
+                |(FAST-WRITER-METHOD SLOT-CLASS INITIALIZE-INFO)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT ARG-INFO)|
                 |PCL::PLIST-MIXIN class predicate|
                 |(WRITER FAST-FUNCTION)| |(WRITER METHOD-CLASS)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)|
-                |(WRITER METHOD-COMBINATION)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT WRAPPER)| GET-METHOD
+                |(WRITER INTERNAL-WRITER-FUNCTION)|
                 |(WRITER INTERNAL-READER-FUNCTION)|
-                |(WRITER INTERNAL-WRITER-FUNCTION)| GET-METHOD
-                |(WRITER DIRECT-METHODS)| |(WRITER DIRECT-SLOTS)|
-                |(FAST-WRITER-METHOD SLOT-DEFINITION INITARGS)|
+                |(WRITER METHOD-COMBINATION)| |(WRITER DIRECT-SLOTS)|
+                |(WRITER DIRECT-METHODS)|
                 |(FAST-WRITER-METHOD SLOT-OBJECT INITARGS)|
-                |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-CONSTRUCTOR)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)|
+                |(FAST-WRITER-METHOD SLOT-DEFINITION INITARGS)|
                 |(FAST-WRITER-METHOD SLOT-OBJECT OPERATOR)|
-                |(WRITER BOUNDP-FUNCTION)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-CONSTRUCTOR)|
+                |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-CONSTRUCTOR)|
+                |(WRITER BOUNDP-FUNCTION)| |(WRITER DIRECT-SUBCLASSES)|
                 |(WRITER DIRECT-SUPERCLASSES)|
-                |(WRITER DIRECT-SUBCLASSES)|
                 |(FAST-WRITER-METHOD SLOT-OBJECT CLASS-EQ-SPECIALIZER)|
-                |(WRITER OPTIONS)| |(WRITER METHODS)|
+                |(WRITER METHODS)| |(WRITER OPTIONS)|
                 SHORT-METHOD-COMBINATION-P GF-ARG-INFO
                 SPECIALIZER-METHOD-TABLE MAKE-METHOD-INITARGS-FORM
                 CLASS-DEFSTRUCT-FORM
-                |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION NAME)|
-                |(FAST-READER-METHOD SLOT-OBJECT NAME)|
-                |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION DFUN-STATE)|
-                |(FAST-READER-METHOD SLOT-OBJECT DFUN-STATE)|
-                |(FAST-READER-METHOD STANDARD-ACCESSOR-METHOD SLOT-NAME)|
-                |(FAST-READER-METHOD SLOT-OBJECT SLOT-NAME)|
-                |(FAST-READER-METHOD SLOT-DEFINITION NAME)|
-                |(FAST-READER-METHOD CLASS NAME)|
-                |(FAST-READER-METHOD CLASS PREDICATE-NAME)|
                 |(FAST-READER-METHOD SLOT-OBJECT PREDICATE-NAME)|
-                |LISP::INTEGER class predicate| GF-PRETTY-ARGLIST
-                SAME-SPECIALIZER-P
-                SLOT-DEFINITION-INTERNAL-READER-FUNCTION
-                SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION
-                SLOT-DEFINITION-READER-FUNCTION
-                SLOT-DEFINITION-WRITER-FUNCTION
+                |(FAST-READER-METHOD CLASS PREDICATE-NAME)|
+                |(FAST-READER-METHOD CLASS NAME)|
+                |(FAST-READER-METHOD SLOT-DEFINITION NAME)|
+                |(FAST-READER-METHOD SLOT-OBJECT SLOT-NAME)|
+                |(FAST-READER-METHOD STANDARD-ACCESSOR-METHOD SLOT-NAME)|
+                |(FAST-READER-METHOD SLOT-OBJECT DFUN-STATE)|
+                |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION DFUN-STATE)|
+                |(FAST-READER-METHOD SLOT-OBJECT NAME)|
+                |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION NAME)|
+                GF-PRETTY-ARGLIST SAME-SPECIALIZER-P
                 SLOT-DEFINITION-BOUNDP-FUNCTION
-                |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHOD-CLASS)|
-                |(FAST-READER-METHOD SLOT-OBJECT METHOD-CLASS)|
-                |(FAST-READER-METHOD SLOT-OBJECT ACCESSOR-FLAGS)|
-                |(FAST-READER-METHOD SLOT-DEFINITION CLASS)|
-                |(FAST-READER-METHOD SLOT-OBJECT CLASS)|
-                |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION DOCUMENTATION)|
-                |(FAST-READER-METHOD SLOT-OBJECT DOCUMENTATION)|
-                |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHOD-COMBINATION)|
-                |(FAST-READER-METHOD SLOT-OBJECT METHOD-COMBINATION)|
-                |(FAST-READER-METHOD STANDARD-ACCESSOR-METHOD SLOT-DEFINITION)|
-                |(FAST-READER-METHOD SLOT-OBJECT SLOT-DEFINITION)|
-                |(FAST-READER-METHOD STANDARD-METHOD GENERIC-FUNCTION)|
-                |(FAST-READER-METHOD SLOT-OBJECT GENERIC-FUNCTION)|
-                |(FAST-READER-METHOD SLOT-OBJECT FUNCTION)|
-                |(FAST-READER-METHOD STANDARD-METHOD FAST-FUNCTION)|
-                |(FAST-READER-METHOD SLOT-OBJECT FAST-FUNCTION)|
-                |(FAST-READER-METHOD STANDARD-EFFECTIVE-SLOT-DEFINITION LOCATION)|
-                |(FAST-READER-METHOD SLOT-OBJECT LOCATION)|
-                |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION READER-FUNCTION)|
-                |(FAST-READER-METHOD SLOT-OBJECT READER-FUNCTION)|
-                |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION WRITER-FUNCTION)|
-                |(FAST-READER-METHOD SLOT-OBJECT WRITER-FUNCTION)|
-                |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION BOUNDP-FUNCTION)|
-                |(FAST-READER-METHOD SLOT-OBJECT BOUNDP-FUNCTION)|
-                |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-READER-FUNCTION)|
-                |(FAST-READER-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)|
-                |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-WRITER-FUNCTION)|
-                |(FAST-READER-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)|
-                |(FAST-READER-METHOD STANDARD-SLOT-DEFINITION ALLOCATION)|
-                |(FAST-READER-METHOD SLOT-OBJECT ALLOCATION)|
-                |(FAST-READER-METHOD SLOT-DEFINITION INITFUNCTION)|
-                |(FAST-READER-METHOD SLOT-OBJECT INITFUNCTION)|
-                |(FAST-READER-METHOD LONG-METHOD-COMBINATION FUNCTION)|
-                |(FAST-READER-METHOD TRACED-METHOD FUNCTION)|
+                SLOT-DEFINITION-WRITER-FUNCTION
+                SLOT-DEFINITION-READER-FUNCTION
+                SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION
+                SLOT-DEFINITION-INTERNAL-READER-FUNCTION
+                |(FAST-READER-METHOD SLOT-OBJECT CLASS)|
+                |(FAST-READER-METHOD SLOT-DEFINITION CLASS)|
+                |(FAST-READER-METHOD SLOT-OBJECT ACCESSOR-FLAGS)|
+                |(FAST-READER-METHOD SLOT-OBJECT METHOD-CLASS)|
+                |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHOD-CLASS)|
                 |(FAST-READER-METHOD TRACED-METHOD GENERIC-FUNCTION)|
-                |(FAST-READER-METHOD STANDARD-METHOD SPECIALIZERS)|
-                |(FAST-READER-METHOD SLOT-OBJECT SPECIALIZERS)|
-                |(FAST-READER-METHOD SLOT-DEFINITION READERS)|
-                |(FAST-READER-METHOD SLOT-OBJECT READERS)|
-                |(FAST-READER-METHOD SLOT-DEFINITION WRITERS)|
+                |(FAST-READER-METHOD TRACED-METHOD FUNCTION)|
+                |(FAST-READER-METHOD LONG-METHOD-COMBINATION FUNCTION)|
+                |(FAST-READER-METHOD SLOT-OBJECT INITFUNCTION)|
+                |(FAST-READER-METHOD SLOT-DEFINITION INITFUNCTION)|
+                |(FAST-READER-METHOD SLOT-OBJECT ALLOCATION)|
+                |(FAST-READER-METHOD STANDARD-SLOT-DEFINITION ALLOCATION)|
+                |(FAST-READER-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)|
+                |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-WRITER-FUNCTION)|
+                |(FAST-READER-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)|
+                |(FAST-READER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-READER-FUNCTION)|
+                |(FAST-READER-METHOD SLOT-OBJECT BOUNDP-FUNCTION)|
+                |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION BOUNDP-FUNCTION)|
+                |(FAST-READER-METHOD SLOT-OBJECT WRITER-FUNCTION)|
+                |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION WRITER-FUNCTION)|
+                |(FAST-READER-METHOD SLOT-OBJECT READER-FUNCTION)|
+                |(FAST-READER-METHOD EFFECTIVE-SLOT-DEFINITION READER-FUNCTION)|
+                |(FAST-READER-METHOD SLOT-OBJECT LOCATION)|
+                |(FAST-READER-METHOD STANDARD-EFFECTIVE-SLOT-DEFINITION LOCATION)|
+                |(FAST-READER-METHOD SLOT-OBJECT FAST-FUNCTION)|
+                |(FAST-READER-METHOD STANDARD-METHOD FAST-FUNCTION)|
+                |(FAST-READER-METHOD SLOT-OBJECT FUNCTION)|
+                |(FAST-READER-METHOD SLOT-OBJECT GENERIC-FUNCTION)|
+                |(FAST-READER-METHOD STANDARD-METHOD GENERIC-FUNCTION)|
+                |(FAST-READER-METHOD SLOT-OBJECT SLOT-DEFINITION)|
+                |(FAST-READER-METHOD STANDARD-ACCESSOR-METHOD SLOT-DEFINITION)|
+                |(FAST-READER-METHOD SLOT-OBJECT METHOD-COMBINATION)|
+                |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHOD-COMBINATION)|
+                |(FAST-READER-METHOD SLOT-OBJECT DOCUMENTATION)|
+                |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION DOCUMENTATION)|
                 |(FAST-READER-METHOD SLOT-OBJECT WRITERS)|
-                |(FAST-READER-METHOD EQL-SPECIALIZER OBJECT)|
-                |(FAST-READER-METHOD SLOT-OBJECT OBJECT)|
-                |(FAST-READER-METHOD CLASS-PROTOTYPE-SPECIALIZER OBJECT)|
-                |(FAST-READER-METHOD CLASS-EQ-SPECIALIZER OBJECT)|
-                |(FAST-READER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)|
-                |(FAST-READER-METHOD SHORT-METHOD-COMBINATION IDENTITY-WITH-ONE-ARGUMENT)|
-                |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION TYPE)|
-                |(FAST-READER-METHOD SLOT-OBJECT TYPE)|
-                |(FAST-READER-METHOD SLOT-DEFINITION TYPE)|
-                |(FAST-READER-METHOD PCL-CLASS PROTOTYPE)|
-                |(FAST-READER-METHOD SLOT-OBJECT PROTOTYPE)|
+                |(FAST-READER-METHOD SLOT-DEFINITION WRITERS)|
+                |(FAST-READER-METHOD SLOT-OBJECT READERS)|
+                |(FAST-READER-METHOD SLOT-DEFINITION READERS)|
+                |(FAST-READER-METHOD SLOT-OBJECT SPECIALIZERS)|
+                |(FAST-READER-METHOD STANDARD-METHOD SPECIALIZERS)|
                 |(FAST-READER-METHOD SPECIALIZER TYPE)|
-                |(FAST-READER-METHOD SLOT-DEFINITION INITFORM)|
-                |(FAST-READER-METHOD SLOT-OBJECT INITFORM)|
-                |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)|
+                |(FAST-READER-METHOD SLOT-OBJECT PROTOTYPE)|
+                |(FAST-READER-METHOD PCL-CLASS PROTOTYPE)|
+                |(FAST-READER-METHOD SLOT-DEFINITION TYPE)|
+                |(FAST-READER-METHOD SLOT-OBJECT TYPE)|
+                |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION TYPE)|
+                |(FAST-READER-METHOD SHORT-METHOD-COMBINATION IDENTITY-WITH-ONE-ARGUMENT)|
+                |(FAST-READER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)|
+                |(FAST-READER-METHOD CLASS-EQ-SPECIALIZER OBJECT)|
+                |(FAST-READER-METHOD CLASS-PROTOTYPE-SPECIALIZER OBJECT)|
+                |(FAST-READER-METHOD SLOT-OBJECT OBJECT)|
+                |(FAST-READER-METHOD EQL-SPECIALIZER OBJECT)|
                 |(FAST-READER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)|
-                |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION PRETTY-ARGLIST)|
-                |(FAST-READER-METHOD SLOT-OBJECT PRETTY-ARGLIST)|
-                |(FAST-READER-METHOD STANDARD-METHOD LAMBDA-LIST)|
-                |(FAST-READER-METHOD SLOT-OBJECT LAMBDA-LIST)|
-                |(FAST-READER-METHOD PCL-CLASS CLASS-PRECEDENCE-LIST)|
-                |(FAST-READER-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)|
-                |(FAST-READER-METHOD PCL-CLASS CAN-PRECEDE-LIST)|
-                |(FAST-READER-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)|
-                |(FAST-READER-METHOD PCL-CLASS INCOMPATIBLE-SUPERCLASS-LIST)|
-                |(FAST-READER-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)|
-                |(FAST-READER-METHOD PLIST-MIXIN PLIST)|
+                |(FAST-READER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)|
+                |(FAST-READER-METHOD SLOT-OBJECT INITFORM)|
+                |(FAST-READER-METHOD SLOT-DEFINITION INITFORM)|
                 |(FAST-READER-METHOD SLOT-OBJECT PLIST)|
-                |(FAST-READER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)|
-                |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION OPTIONS)|
-                |(FAST-READER-METHOD SLOT-OBJECT OPTIONS)|
-                |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHODS)|
-                |(FAST-READER-METHOD SLOT-OBJECT METHODS)|
-                |(FAST-READER-METHOD SLOT-CLASS DIRECT-SLOTS)|
-                |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SLOTS)|
-                |(FAST-READER-METHOD SLOT-CLASS SLOTS)|
-                |(FAST-READER-METHOD SLOT-OBJECT SLOTS)|
+                |(FAST-READER-METHOD PLIST-MIXIN PLIST)|
+                |(FAST-READER-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)|
+                |(FAST-READER-METHOD PCL-CLASS INCOMPATIBLE-SUPERCLASS-LIST)|
+                |(FAST-READER-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)|
+                |(FAST-READER-METHOD PCL-CLASS CAN-PRECEDE-LIST)|
+                |(FAST-READER-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)|
+                |(FAST-READER-METHOD PCL-CLASS CLASS-PRECEDENCE-LIST)|
+                |(FAST-READER-METHOD SLOT-OBJECT LAMBDA-LIST)|
+                |(FAST-READER-METHOD STANDARD-METHOD LAMBDA-LIST)|
+                |(FAST-READER-METHOD SLOT-OBJECT PRETTY-ARGLIST)|
+                |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION PRETTY-ARGLIST)|
                 |(FAST-READER-METHOD SLOT-OBJECT DIRECT-METHODS)|
-                |(FAST-READER-METHOD CLASS DIRECT-SUPERCLASSES)|
-                |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)|
-                |(FAST-READER-METHOD CLASS DIRECT-SUBCLASSES)|
+                |(FAST-READER-METHOD SLOT-OBJECT SLOTS)|
+                |(FAST-READER-METHOD SLOT-CLASS SLOTS)|
+                |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SLOTS)|
+                |(FAST-READER-METHOD SLOT-CLASS DIRECT-SLOTS)|
+                |(FAST-READER-METHOD SLOT-OBJECT METHODS)|
+                |(FAST-READER-METHOD STANDARD-GENERIC-FUNCTION METHODS)|
+                |(FAST-READER-METHOD SLOT-OBJECT OPTIONS)|
+                |(FAST-READER-METHOD STANDARD-METHOD-COMBINATION OPTIONS)|
+                |(FAST-READER-METHOD SLOT-OBJECT FROM-DEFCLASS-P)|
                 |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)|
+                |(FAST-READER-METHOD CLASS DIRECT-SUBCLASSES)|
+                |(FAST-READER-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)|
+                |(FAST-READER-METHOD CLASS DIRECT-SUPERCLASSES)|
                 SLOT-DEFINITION-CLASS EQL-SPECIALIZER-OBJECT
                 |PCL::DIRECT-SLOT-DEFINITION class predicate|
                 CLASS-CONSTRUCTORS |(BOUNDP WRAPPER)| SLOTS-TO-INSPECT
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT NAME)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT DFUN-STATE)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOT-NAME)|
                 |(FAST-BOUNDP-METHOD SLOT-OBJECT PREDICATE-NAME)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOT-NAME)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT DFUN-STATE)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT NAME)|
                 |(BOUNDP DEFSTRUCT-ACCESSOR-SYMBOL)|
                 SPECIALIZER-DIRECT-GENERIC-FUNCTIONS
                 |(BOUNDP CLASS-EQ-SPECIALIZER)|
                 |(SETF SLOT-DEFINITION-NAME)| ADD-WRITER-METHOD
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT METHOD-CLASS)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT ACCESSOR-FLAGS)|
                 |(FAST-BOUNDP-METHOD SLOT-OBJECT CLASS)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT DOCUMENTATION)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT METHOD-COMBINATION)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOT-DEFINITION)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT GENERIC-FUNCTION)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT FUNCTION)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT FAST-FUNCTION)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT LOCATION)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT READER-FUNCTION)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT WRITER-FUNCTION)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT BOUNDP-FUNCTION)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT ALLOCATION)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT ACCESSOR-FLAGS)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT METHOD-CLASS)|
                 |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFUNCTION)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT ALLOCATION)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT BOUNDP-FUNCTION)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT WRITER-FUNCTION)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT READER-FUNCTION)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT LOCATION)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT FAST-FUNCTION)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT FUNCTION)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT GENERIC-FUNCTION)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOT-DEFINITION)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT METHOD-COMBINATION)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT DOCUMENTATION)|
                 |(BOUNDP OPERATOR)| |(BOUNDP ARG-INFO)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT SPECIALIZERS)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT READERS)|
                 |(FAST-BOUNDP-METHOD SLOT-OBJECT WRITERS)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT OBJECT)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT TYPE)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT READERS)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT SPECIALIZERS)|
                 |(FAST-BOUNDP-METHOD SLOT-OBJECT PROTOTYPE)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFORM)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT TYPE)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT OBJECT)|
                 |(FAST-BOUNDP-METHOD SLOT-OBJECT DEFSTRUCT-FORM)|
-                |(SETF SLOT-DEFINITION-CLASS)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT INITFORM)|
                 |(SETF SLOT-VALUE-USING-CLASS)|
-                |(SETF SLOT-DEFINITION-LOCATION)|
-                |(SETF SLOT-DEFINITION-READER-FUNCTION)|
-                |(SETF SLOT-DEFINITION-WRITER-FUNCTION)|
-                |(SETF SLOT-DEFINITION-BOUNDP-FUNCTION)|
-                |(SETF SLOT-DEFINITION-INTERNAL-READER-FUNCTION)|
-                |(SETF SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION)|
-                |(SETF SLOT-DEFINITION-ALLOCATION)|
-                |(SETF SLOT-DEFINITION-INITFUNCTION)|
+                |(SETF SLOT-DEFINITION-CLASS)|
                 |(SETF SLOT-ACCESSOR-FUNCTION)|
+                |(SETF SLOT-DEFINITION-INITFUNCTION)|
+                |(SETF SLOT-DEFINITION-ALLOCATION)|
+                |(SETF SLOT-DEFINITION-INTERNAL-WRITER-FUNCTION)|
+                |(SETF SLOT-DEFINITION-INTERNAL-READER-FUNCTION)|
+                |(SETF SLOT-DEFINITION-BOUNDP-FUNCTION)|
+                |(SETF SLOT-DEFINITION-WRITER-FUNCTION)|
+                |(SETF SLOT-DEFINITION-READER-FUNCTION)|
+                |(SETF SLOT-DEFINITION-LOCATION)|
                 |(BOUNDP DEFSTRUCT-CONSTRUCTOR)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT PRETTY-ARGLIST)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT LAMBDA-LIST)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)|
                 |(FAST-BOUNDP-METHOD SLOT-OBJECT PLIST)|
-                |(SETF SLOT-DEFINITION-READERS)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT LAMBDA-LIST)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT PRETTY-ARGLIST)|
                 |(SETF SLOT-DEFINITION-WRITERS)|
+                |(SETF SLOT-DEFINITION-READERS)|
                 |(SETF SLOT-DEFINITION-TYPE)|
                 |(SETF SLOT-DEFINITION-INITFORM)|
                 |(BOUNDP INITIALIZE-INFO)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT OPTIONS)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT METHODS)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SLOTS)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOTS)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-METHODS)|
                 |(FAST-BOUNDP-METHOD SLOT-OBJECT FROM-DEFCLASS-P)|
-                |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-METHODS)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT SLOTS)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SLOTS)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT METHODS)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT OPTIONS)|
                 |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUBCLASSES)|
+                |(FAST-BOUNDP-METHOD SLOT-OBJECT DIRECT-SUPERCLASSES)|
                 |(FAST-INTERNAL-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)|
                 |(BOUNDP INITARGS)| LONG-METHOD-COMBINATION-FUNCTION
                 GENERIC-FUNCTION-P
-                |PCL::SLOT-DEFINITION class predicate|
-                |LISP::NULL class predicate| |(READER NAME)|
-                |(READER CLASS)| |(FAST-METHOD SLOT-MISSING (T T T T))|
+                |PCL::SLOT-DEFINITION class predicate| |(READER NAME)|
+                |(READER CLASS)| |(FAST-METHOD SLOT-UNBOUND (T T T))|
                 |(FAST-METHOD (SETF DOCUMENTATION) (T T))|
-                |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))|
-                |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))|
-                |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))|
-                |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))|
-                |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))|
-                |(FAST-METHOD SLOT-UNBOUND (T T T))|
-                |(FAST-METHOD REMOVE-NAMED-METHOD (T T))|
-                |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))|
+                |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))|
                 |(FAST-METHOD COMPUTE-SLOT-ACCESSOR-INFO (EFFECTIVE-SLOT-DEFINITION T T))|
                 |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-CLASS T))|
-                |(FAST-METHOD SHARED-INITIALIZE :BEFORE (BUILT-IN-CLASS T))|
                 |(FAST-METHOD READER-METHOD-CLASS (SLOT-CLASS T))|
+                |(FAST-METHOD SHARED-INITIALIZE :AFTER (DOCUMENTATION-MIXIN T))|
+                |(FAST-METHOD WRITER-METHOD-CLASS (SLOT-CLASS T))|
+                |(FAST-METHOD SHARED-INITIALIZE :AFTER (STRUCTURE-SLOT-DEFINITION T))|
+                |(FAST-METHOD REMOVE-NAMED-METHOD (T T))|
+                |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))|
                 |(FAST-METHOD SHARED-INITIALIZE :AFTER (STD-CLASS T))|
+                |(FAST-METHOD (SETF SLOT-ACCESSOR-STD-P) (T EFFECTIVE-SLOT-DEFINITION T))|
                 |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION SHORT-METHOD-COMBINATION T))|
-                |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-METHOD T))|
-                |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))|
-                |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))|
-                |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))|
-                |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))|
+                |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-ACCESSOR-METHOD T))|
+                |(FAST-METHOD FIND-METHOD-COMBINATION (GENERIC-FUNCTION (EQL STANDARD) T))|
+                |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))|
+                |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))|
+                |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))|
+                |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))|
+                |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))|
+                |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))|
+                |(FAST-METHOD PRINT-OBJECT (CLASS T))|
+                |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))|
+                |(FAST-METHOD PRINT-OBJECT (T T))|
+                |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))|
+                |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))|
+                |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))|
+                |(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))|
+                |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))|
+                |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))|
+                |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))|
+                |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))|
+                |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))|
+                |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))|
+                |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))|
+                |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))|
+                |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))|
+                |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))|
+                |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))|
+                |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))|
+                |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))|
+                |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))|
+                |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))|
+                |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))|
+                |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))|
+                |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))|
+                |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))|
+                |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))|
+                |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))|
+                |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))|
+                |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))|
+                |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))|
+                |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))|
                 |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-METHOD T))|
+                |(FAST-METHOD SHARED-INITIALIZE :BEFORE (CLASS T))|
                 |(FAST-METHOD (SETF SLOT-ACCESSOR-FUNCTION) (T EFFECTIVE-SLOT-DEFINITION T))|
+                |(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))|
+                |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))|
+                |(FAST-METHOD (SETF CLASS-SLOT-VALUE) (T STD-CLASS T))|
+                |(FAST-METHOD SHARED-INITIALIZE :AFTER (CLASS-EQ-SPECIALIZER T))|
+                |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))|
+                |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))|
+                |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-SLOT-DEFINITION T))|
                 |(FAST-METHOD SHARED-INITIALIZE :AFTER (STANDARD-ACCESSOR-METHOD T))|
-                |(FAST-METHOD COMPUTE-EFFECTIVE-METHOD (GENERIC-FUNCTION LONG-METHOD-COMBINATION T))|
-                |(FAST-METHOD ADD-WRITER-METHOD (SLOT-CLASS T T))|
                 |(FAST-METHOD ADD-BOUNDP-METHOD (SLOT-CLASS T T))|
-                |(FAST-METHOD SHARED-INITIALIZE :AFTER (EQL-SPECIALIZER T))|
-                |(FAST-METHOD SHARED-INITIALIZE (SLOT-OBJECT T))|
-                |(FAST-METHOD SHARED-INITIALIZE :BEFORE (STANDARD-GENERIC-FUNCTION T))|
-                |(FAST-METHOD ADD-READER-METHOD (SLOT-CLASS T T))|
-                |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))|
-                |(FAST-METHOD DESCRIBE-OBJECT (T T))|
-                |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))|
-                |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))|
-                |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))|
                 |(FAST-METHOD DESCRIBE-OBJECT (CLASS T))|
+                |(FAST-METHOD LEGAL-SPECIALIZERS-P (STANDARD-METHOD T))|
+                |(FAST-METHOD LEGAL-QUALIFIERS-P (STANDARD-METHOD T))|
                 |(FAST-METHOD DEFAULT-INITARGS (SLOT-CLASS T))|
+                |(FAST-METHOD DESCRIBE-OBJECT (T T))|
                 |(FAST-METHOD CLASS-SLOT-VALUE (STD-CLASS T))|
                 |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION (SLOT-CLASS T))|
                 |(FAST-METHOD DESCRIBE-OBJECT (SLOT-OBJECT T))|
+                |(FAST-METHOD DESCRIBE-OBJECT (STANDARD-GENERIC-FUNCTION T))|
+                |(FAST-METHOD COMPUTE-APPLICABLE-METHODS-USING-CLASSES (GENERIC-FUNCTION T))|
                 |(FAST-METHOD SLOT-ACCESSOR-FUNCTION (EFFECTIVE-SLOT-DEFINITION T))|
+                |(FAST-METHOD SLOT-MISSING (T T T T))|
                 |(FAST-METHOD UPDATE-INSTANCE-FOR-REDEFINED-CLASS (STANDARD-OBJECT T T T))|
-                |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))|
-                |(FAST-METHOD COMPUTE-APPLICABLE-METHODS (GENERIC-FUNCTION T))|
-                |(FAST-METHOD REMOVE-BOUNDP-METHOD (SLOT-CLASS T))|
-                |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STD-CLASS T))|
-                |(FAST-METHOD PRINT-OBJECT (T T))|
-                |(FAST-METHOD MAP-DEPENDENTS (DEPENDENT-UPDATE-MIXIN T))|
-                |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STRUCTURE-CLASS T))|
-                |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))|
-                |(FAST-METHOD SLOT-ACCESSOR-STD-P (EFFECTIVE-SLOT-DEFINITION T))|
-                |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (SLOT-CLASS T))|
-                |(FAST-METHOD EFFECTIVE-SLOT-DEFINITION-CLASS (STD-CLASS T))|
-                |(FAST-METHOD PRINT-OBJECT (CLASS T))|
-                |(FAST-METHOD REMOVE-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))|
-                |(FAST-METHOD UPDATE-GF-DFUN (STD-CLASS T))|
-                |(FAST-METHOD PRINT-OBJECT (SLOT-DEFINITION T))|
-                |(FAST-METHOD COMPATIBLE-META-CLASS-CHANGE-P (T T))|
-                |(FAST-METHOD MAKE-WRITER-METHOD-FUNCTION (SLOT-CLASS T))|
-                |(FAST-METHOD LEGAL-QUALIFIER-P (STANDARD-METHOD T))|
-                |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS (SLOT-CLASS T))|
-                |(FAST-METHOD LEGAL-LAMBDA-LIST-P (STANDARD-METHOD T))|
-                |(FAST-METHOD LEGAL-SLOT-NAME-P (STANDARD-METHOD T))|
-                |(FAST-METHOD PRINT-OBJECT (STANDARD-ACCESSOR-METHOD T))|
-                |(FAST-METHOD COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS :AROUND (STRUCTURE-CLASS T))|
-                |(FAST-METHOD ADD-DEPENDENT (DEPENDENT-UPDATE-MIXIN T))|
-                |(FAST-METHOD MAKE-BOUNDP-METHOD-FUNCTION (SLOT-CLASS T))|
-                |(FAST-METHOD LEGAL-DOCUMENTATION-P (STANDARD-METHOD T))|
-                |(FAST-METHOD LEGAL-SPECIALIZER-P (STANDARD-METHOD T))|
-                |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD T))|
-                |(FAST-METHOD PRINT-OBJECT (GENERIC-FUNCTION T))|
-                |(FAST-METHOD PRINT-OBJECT (STANDARD-METHOD-COMBINATION T))|
-                |(FAST-METHOD DIRECT-SLOT-DEFINITION-CLASS (STD-CLASS T))|
-                |(FAST-METHOD LEGAL-METHOD-FUNCTION-P (STANDARD-METHOD T))|
-                |(FAST-METHOD REMOVE-WRITER-METHOD (SLOT-CLASS T))|
-                |(FAST-METHOD INFORM-TYPE-SYSTEM-ABOUT-CLASS (STRUCTURE-CLASS T))|
-                |(FAST-METHOD REMOVE-READER-METHOD (SLOT-CLASS T))|
-                |(FAST-METHOD MAKE-READER-METHOD-FUNCTION (FUNCALLABLE-STANDARD-CLASS T))|
-                LEGAL-SLOT-NAME-P |(READER OBJECT)| |(READER TYPE)|
+                LEGAL-SLOT-NAME-P |(READER TYPE)| |(READER OBJECT)|
                 CLASS-WRAPPER |(READER PLIST)|
-                |(FAST-METHOD NO-APPLICABLE-METHOD (T))|
-                |(FAST-METHOD DOCUMENTATION (T))|
                 |(FAST-METHOD CLASS-PREDICATE-NAME (T))|
+                |(FAST-METHOD DOCUMENTATION (T))|
+                |(FAST-METHOD NO-APPLICABLE-METHOD (T))|
                 |(READER SLOTS)| |(WRITER NAME)| DEFINITION-SOURCE
                 |PCL::SLOT-OBJECT class predicate| DEFAULT-INITARGS
-                |(WRITER CLASS)| CLASS-SLOT-VALUE |(WRITER OBJECT)|
-                |(WRITER TYPE)|
+                |(WRITER CLASS)| CLASS-SLOT-VALUE |(WRITER TYPE)|
+                |(WRITER OBJECT)|
                 |(FAST-METHOD ENSURE-CLASS-USING-CLASS (T NULL))|
                 |(WRITER PLIST)| |(WRITER SLOTS)|
                 |PCL::DOCUMENTATION-MIXIN class predicate|
                 LEGAL-QUALIFIER-P METHOD-P
                 |PCL::SPECIALIZER-WITH-OBJECT class predicate|
                 CLASS-SLOT-CELLS
-                |(COMBINED-METHOD REINITIALIZE-INSTANCE)|
                 |(COMBINED-METHOD INITIALIZE-INSTANCE)|
+                |(COMBINED-METHOD REINITIALIZE-INSTANCE)|
                 STANDARD-ACCESSOR-METHOD-P |(SETF CLASS-NAME)|
-                STANDARD-METHOD-P STANDARD-READER-METHOD-P
-                STANDARD-GENERIC-FUNCTION-P |(READER WRAPPER)|
+                STANDARD-GENERIC-FUNCTION-P STANDARD-READER-METHOD-P
+                STANDARD-METHOD-P |(READER WRAPPER)|
                 |(READER DEFSTRUCT-ACCESSOR-SYMBOL)|
                 |(READER CLASS-EQ-SPECIALIZER)|
-                COMPUTE-DEFAULT-INITARGS
                 COMPUTE-EFFECTIVE-SLOT-DEFINITION-INITARGS
-                |(SETF CLASS-DEFSTRUCT-FORM)|
+                COMPUTE-DEFAULT-INITARGS |(SETF CLASS-DEFSTRUCT-FORM)|
                 |(CALL REAL-MAKE-METHOD-LAMBDA)|
                 |(SETF CLASS-INCOMPATIBLE-SUPERCLASS-LIST)|
-                |SETF PCL CLASS-SLOT-VALUE| |(SETF CLASS-DIRECT-SLOTS)|
-                |(SETF CLASS-SLOTS)| DO-STANDARD-DEFSETF-1
-                |(READER OPERATOR)| |(CALL REAL-ADD-METHOD)|
-                |(CALL REAL-REMOVE-METHOD)| |(CALL REAL-GET-METHOD)|
+                |COMMON-LISP::NULL class predicate|
+                |COMMON-LISP::SYMBOL class predicate|
+                |COMMON-LISP::CHARACTER class predicate|
+                |COMMON-LISP::BIT-VECTOR class predicate|
+                |COMMON-LISP::STRING class predicate|
+                |COMMON-LISP::VECTOR class predicate|
+                |COMMON-LISP::ARRAY class predicate|
+                |COMMON-LISP::CONS class predicate|
+                |COMMON-LISP::LIST class predicate|
+                |COMMON-LISP::SEQUENCE class predicate|
+                |COMMON-LISP::RATIO class predicate|
+                |COMMON-LISP::INTEGER class predicate|
+                |COMMON-LISP::RATIONAL class predicate|
+                |COMMON-LISP::FLOAT class predicate|
+                |COMMON-LISP::COMPLEX class predicate|
+                |COMMON-LISP::NUMBER class predicate|
+                |COMMON-LISP::T class predicate|
+                |COMMON-LISP::STRUCTURE-OBJECT class predicate|
+                |COMMON-LISP::STANDARD-OBJECT class predicate|
+                |COMMON-LISP::BUILT-IN-CLASS class predicate|
+                |SETF PCL CLASS-SLOT-VALUE| |(SETF CLASS-SLOTS)|
+                |(SETF CLASS-DIRECT-SLOTS)| DO-STANDARD-DEFSETF-1
+                |(READER OPERATOR)| |(CALL REAL-GET-METHOD)|
+                |(CALL REAL-REMOVE-METHOD)| |(CALL REAL-ADD-METHOD)|
                 |(READER ARG-INFO)| METHOD-COMBINATION-TYPE
                 |(READER DEFSTRUCT-CONSTRUCTOR)|
                 |(INTERNAL-READER-METHOD STANDARD-GENERIC-FUNCTION ARG-INFO)|
                 |(READER INITIALIZE-INFO)| |(WRITER WRAPPER)|
-                STANDARD-CLASS-P |LISP::NUMBER class predicate|
-                LEGAL-SPECIALIZER-P
+                STANDARD-CLASS-P LEGAL-SPECIALIZER-P
                 |PCL::LONG-METHOD-COMBINATION class predicate|
                 |(WRITER DEFSTRUCT-ACCESSOR-SYMBOL)|
                 COMPUTE-SLOT-ACCESSOR-INFO |(READER INITARGS)|
                 |(WRITER CLASS-EQ-SPECIALIZER)|
                 STANDARD-BOUNDP-METHOD-P FDEFINE-CAREFULLY
                 |(SETF DOCUMENTATION)| RAW-INSTANCE-ALLOCATOR
-                |SETF PCL CLASS-INITIALIZE-INFO|
                 |SETF PCL SLOT-DEFINITION-DEFSTRUCT-ACCESSOR-SYMBOL|
-                |(WRITER OPERATOR)| |(WRITER ARG-INFO)|
+                |SETF PCL CLASS-INITIALIZE-INFO| |(WRITER OPERATOR)|
+                |(WRITER ARG-INFO)|
                 COMPUTE-DISCRIMINATING-FUNCTION-ARGLIST-INFO
                 STANDARD-WRITER-METHOD-P
                 CLASS-INCOMPATIBLE-SUPERCLASS-LIST
                 METHOD-COMBINATION-DOCUMENTATION
                 |SETF PCL SLOT-DEFINITION-INITARGS|
                 REMOVE-BOUNDP-METHOD ADD-NAMED-METHOD
-                |(WRITER INITARGS)|
                 |SETF PCL CLASS-DEFSTRUCT-CONSTRUCTOR|
-                |LISP::CONS class predicate| |(BOUNDP METHOD)|
-                |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION NAME)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT NAME)|
-                |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION DFUN-STATE)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT DFUN-STATE)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT SLOT-NAME)|
-                |(FAST-WRITER-METHOD SLOT-DEFINITION NAME)|
-                |(FAST-WRITER-METHOD CLASS NAME)|
+                |(WRITER INITARGS)| |(BOUNDP METHOD)|
                 |(FAST-WRITER-METHOD SLOT-OBJECT PREDICATE-NAME)|
+                |(FAST-WRITER-METHOD CLASS NAME)|
+                |(FAST-WRITER-METHOD SLOT-DEFINITION NAME)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT SLOT-NAME)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT DFUN-STATE)|
+                |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION DFUN-STATE)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT NAME)|
+                |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION NAME)|
                 |(BOUNDP SOURCE)| |(SETF GF-DFUN-STATE)|
                 SHORT-COMBINATION-OPERATOR
-                |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHOD-CLASS)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT METHOD-CLASS)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT ACCESSOR-FLAGS)|
-                |(FAST-WRITER-METHOD SLOT-DEFINITION CLASS)|
                 |(FAST-WRITER-METHOD SLOT-OBJECT CLASS)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT DOCUMENTATION)|
-                |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHOD-COMBINATION)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT METHOD-COMBINATION)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT SLOT-DEFINITION)|
-                |(FAST-WRITER-METHOD STANDARD-METHOD GENERIC-FUNCTION)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT GENERIC-FUNCTION)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT FUNCTION)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT FAST-FUNCTION)|
-                |(FAST-WRITER-METHOD STANDARD-EFFECTIVE-SLOT-DEFINITION LOCATION)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT LOCATION)|
-                |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION READER-FUNCTION)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT READER-FUNCTION)|
-                |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION WRITER-FUNCTION)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT WRITER-FUNCTION)|
-                |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION BOUNDP-FUNCTION)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT BOUNDP-FUNCTION)|
-                |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-READER-FUNCTION)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)|
-                |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-WRITER-FUNCTION)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)|
-                |(FAST-WRITER-METHOD STANDARD-SLOT-DEFINITION ALLOCATION)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT ALLOCATION)|
-                |(FAST-WRITER-METHOD SLOT-DEFINITION INITFUNCTION)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT INITFUNCTION)|
+                |(FAST-WRITER-METHOD SLOT-DEFINITION CLASS)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT ACCESSOR-FLAGS)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT METHOD-CLASS)|
+                |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHOD-CLASS)|
                 |(FAST-WRITER-METHOD TRACED-METHOD GENERIC-FUNCTION)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT SPECIALIZERS)|
-                |(FAST-WRITER-METHOD SLOT-DEFINITION READERS)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT READERS)|
-                |(FAST-WRITER-METHOD SLOT-DEFINITION WRITERS)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT INITFUNCTION)|
+                |(FAST-WRITER-METHOD SLOT-DEFINITION INITFUNCTION)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT ALLOCATION)|
+                |(FAST-WRITER-METHOD STANDARD-SLOT-DEFINITION ALLOCATION)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT INTERNAL-WRITER-FUNCTION)|
+                |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-WRITER-FUNCTION)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT INTERNAL-READER-FUNCTION)|
+                |(FAST-WRITER-METHOD STRUCTURE-SLOT-DEFINITION INTERNAL-READER-FUNCTION)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT BOUNDP-FUNCTION)|
+                |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION BOUNDP-FUNCTION)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT WRITER-FUNCTION)|
+                |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION WRITER-FUNCTION)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT READER-FUNCTION)|
+                |(FAST-WRITER-METHOD EFFECTIVE-SLOT-DEFINITION READER-FUNCTION)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT LOCATION)|
+                |(FAST-WRITER-METHOD STANDARD-EFFECTIVE-SLOT-DEFINITION LOCATION)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT FAST-FUNCTION)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT FUNCTION)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT GENERIC-FUNCTION)|
+                |(FAST-WRITER-METHOD STANDARD-METHOD GENERIC-FUNCTION)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT SLOT-DEFINITION)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT METHOD-COMBINATION)|
+                |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION METHOD-COMBINATION)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT DOCUMENTATION)|
                 |(FAST-WRITER-METHOD SLOT-OBJECT WRITERS)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT OBJECT)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT TYPE)|
-                |(FAST-WRITER-METHOD SLOT-DEFINITION TYPE)|
+                |(FAST-WRITER-METHOD SLOT-DEFINITION WRITERS)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT READERS)|
+                |(FAST-WRITER-METHOD SLOT-DEFINITION READERS)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT SPECIALIZERS)|
                 |(FAST-WRITER-METHOD SLOT-OBJECT PROTOTYPE)|
+                |(FAST-WRITER-METHOD SLOT-DEFINITION TYPE)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT TYPE)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT IDENTITY-WITH-ONE-ARGUMENT)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT OBJECT)|
                 REMOVE-NAMED-METHOD
-                |(FAST-WRITER-METHOD SLOT-DEFINITION INITFORM)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT INITFORM)|
-                |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)|
                 |(FAST-WRITER-METHOD SLOT-OBJECT DEFSTRUCT-FORM)|
-                |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION PRETTY-ARGLIST)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT PRETTY-ARGLIST)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT LAMBDA-LIST)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)|
-                |(FAST-WRITER-METHOD PCL-CLASS INCOMPATIBLE-SUPERCLASS-LIST)|
-                |(FAST-WRITER-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)|
-                |(FAST-WRITER-METHOD PLIST-MIXIN PLIST)|
+                |(FAST-WRITER-METHOD STRUCTURE-CLASS DEFSTRUCT-FORM)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT INITFORM)|
+                |(FAST-WRITER-METHOD SLOT-DEFINITION INITFORM)|
                 |(FAST-WRITER-METHOD SLOT-OBJECT PLIST)|
+                |(FAST-WRITER-METHOD PLIST-MIXIN PLIST)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT INCOMPATIBLE-SUPERCLASS-LIST)|
+                |(FAST-WRITER-METHOD PCL-CLASS INCOMPATIBLE-SUPERCLASS-LIST)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT CAN-PRECEDE-LIST)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT CLASS-PRECEDENCE-LIST)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT LAMBDA-LIST)|
+                |(FAST-WRITER-METHOD SLOT-OBJECT PRETTY-ARGLIST)|
+                |(FAST-WRITER-METHOD STANDARD-GENERIC-FUNCTION PRETTY-ARGLIST)|
                 LEGAL-DOCUMENTATION-P CLASS-DIRECT-SUPERCLASSES
                 CLASS-DIRECT-SUBCLASSES CLASS-DIRECT-DEFAULT-INITARGS
                 SLOT-DEFINITION-READERS SLOT-VALUE-USING-CLASS
-                COMPUTE-APPLICABLE-METHODS CLASS-NAME CLASSP
-                CLASS-PROTOTYPE READER-METHOD-CLASS REMOVE-METHOD
+                COMPUTE-APPLICABLE-METHODS CLASS-NAME CLASS-PROTOTYPE
+                CLASSP READER-METHOD-CLASS REMOVE-METHOD
                 SLOT-DEFINITION-INITFORM
                 UPDATE-INSTANCE-FOR-REDEFINED-CLASS
                 UPDATE-INSTANCE-FOR-DIFFERENT-CLASS CHANGE-CLASS
                 ENSURE-CLASS-USING-CLASS NO-APPLICABLE-METHOD
                 SLOT-DEFINITION-WRITERS
                 COMPUTE-APPLICABLE-METHODS-USING-CLASSES
-                CLASS-PRECEDENCE-LIST))
+                CLASS-PRECEDENCE-LIST DISASSEMBLE DESCRIBE-OBJECT
+                COMPILE))
   (SETF (GET V 'SYSTEM::PROCLAIMED-CLOSURE) T)) 
index c0511840eb7adf801f5a088c493158f8e656b4e6..9561e767620f8f1e3599d8bdbe7e23d2312e8077 100644 (file)
@@ -69,42 +69,7 @@ $(LSPDIR)/auto_new.lsp: $(LSPDIR)/auto.lsp
        [ "$(RL_OBJS)" = "" ] || \
                echo "(AUTOLOAD 'init-readline '|readline|)" >>$@
 
-init_gcl.lsp.tmp: init_gcl.lsp.in
-       cp $< $@
-
-init_pre_gcl.lsp.tmp: init_pre_gcl.lsp.in
-       cp $< $@
-
-init_mod_gcl.lsp.tmp: init_mod_gcl.lsp.in
-       cp $< $@
-
-init_xgcl.lsp.tmp: init_gcl.lsp.tmp
-       ln -snf $< $@
-
-init_pcl_gcl.lsp.tmp: init_pcl_gcl.lsp.in ../cmpnew/gcl_cmpmain.lsp \
-               ../pcl/sys-package.lisp ../clcs/package.lisp \
-               $(shell find ../clcs/ -name "clcs_*.lisp")
-
-       awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} {if (i==0) print}' $< >$@
-#      cat ../cmpnew/gcl_cmpmain.lsp >>$@
-       cat ../pcl/sys-package.lisp >>$@
-       awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} {if (i==1) print}' $< >>$@
-
-init_ansi_gcl.lsp.tmp: init_ansi_gcl.lsp.in ../cmpnew/gcl_cmpmain.lsp \
-               ../pcl/sys-package.lisp ../clcs/package.lisp
-
-       awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} \
-               /^ *@LI-CLCS-PACKAGE@/{i=2;next} {if (i==0) print}' $< >$@
-#      cat ../cmpnew/gcl_cmpmain.lsp >>$@
-       cat ../pcl/sys-package.lisp >>$@
-       awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} \
-               /^ *@LI-CLCS-PACKAGE@/{i=2;next} {if (i==1) print}' $< >>$@
-       cat ../clcs/package.lisp >>$@
-       awk '/^ *@LI-PCL-PACKAGE@/{i=1;next} \
-               /^ *@LI-CLCS-PACKAGE@/{i=2;next} {if (i==2) print}' $< >>$@
-
-
-init_%.lsp: init_%.lsp.tmp
+sys_init.lsp: sys_init.lsp.in
 
        cat $< | sed \
                -e "s#@LI-VERS@#(`cat ../majvers`.`cat ../minvers`) `date`#1" \
@@ -118,14 +83,14 @@ init_%.lsp: init_%.lsp.tmp
                -e "s#@LI-OPT-TWO@#\"$(O2FLAGS)\"#1" \
                -e "s#@LI-INIT-LSP@#\"$@\"#1" >$@
 
-saved_%:raw_% $(RSYM) init_%.lsp raw_%_map msys \
+saved_%:raw_% $(RSYM) sys_init.lsp raw_%_map msys \
                $(CMPDIR)/gcl_cmpmain.lsp \
                $(CMPDIR)/gcl_lfun_list.lsp \
                $(CMPDIR)/gcl_cmpopt.lsp $(HDIR)/cmpinclude.h \
                $(LSPDIR)/gcl_auto_new.lsp
 
-       cp init_$*.lsp foo
-       echo " (in-package \"USER\")(system:save-system \"$@\")" >>foo
+       cp sys_init.lsp foo
+       echo "(unless si::*quit-tags* (in-package \"USER\")(system:save-system \"$@\"))" >>foo
        ar x lib$*.a $$(ar t lib$*.a |grep ^gcl_)
        $(PORTDIR)/raw_$*$(EXE) $(PORTDIR)/ -libdir $(GCLDIR)/ < foo
 #       check that saved image can be prelinked
@@ -194,7 +159,7 @@ map_%:
 clean:
        rm -rf  saved_*$(EXE) raw_*$(EXE) *.o core a.out $(RSYM) \
                $(LSPDIR)/auto_new.lsp foo *maxima* init_*.lsp lib*.a gmp* bfd* *.lsp.tmp \
-               gazonk*.lsp plt*h *_map saved_* lib* raw_* msys out* log* tmp* gcl.script
+               gazonk*.lsp plt*h *_map saved_* lib* raw_* msys out* log* tmp* gcl.script sys_init.lsp
 
 .INTERMEDIATE: init_ansi_gcl.lsp.tmp init_gcl.lsp.tmp raw_gcl raw_ansi_gcl
 .PRECIOUS: init_pre_gcl.lsp init_gcl.lsp init_ansi_gcl.lsp
index 49364c2bb6f8704c39848e22efb022d4d7b648b7..a2a635ca7010e56477dfc8a591d5da615f86ab40 100644 (file)
@@ -7,6 +7,10 @@ void
 gcl_init_init()
 {
 
+  object features;
+  features=find_symbol(make_simple_string("*FEATURES*"),system_package);
+  features->s.s_dbind=make_cons(make_keyword("ANSI-CL"),make_cons(make_keyword("COMMON-LISP"),features->s.s_dbind));
+
   build_symbol_table();
 
   lsp_init("../lsp/gcl_export.lsp");
@@ -86,7 +90,7 @@ gcl_init_system(object no_init)
   ar_check_init(gcl_cmpmain,no_init);
 
 #ifdef HAVE_XGCL
-  lsp_init("../xgcl-2/sysdef.lisp");
+  lsp_init("../xgcl-2/package.lisp");
   ar_check_init(gcl_Xlib,no_init);
   ar_check_init(gcl_Xutil,no_init);
   ar_check_init(gcl_X,no_init);
index 67c71f9c2bc379ee57c5c0f2e0b893d964986aae..80a9b4e9eb986f4436b1bb0ac2219a52145b6ec0 100755 (executable)
@@ -83,7 +83,7 @@ gcl_init_system(object no_init) {
   ar_check_init(gcl_cmpmain,no_init);
 
 #ifdef HAVE_XGCL
-  lsp_init("../xgcl-2/sysdef.lisp");
+  lsp_init("../xgcl-2/package.lisp");
   ar_check_init(gcl_Xlib,no_init);
   ar_check_init(gcl_Xutil,no_init);
   ar_check_init(gcl_X,no_init);
diff --git a/unixport/sys_init.lsp.in b/unixport/sys_init.lsp.in
new file mode 100644 (file)
index 0000000..22fc50a
--- /dev/null
@@ -0,0 +1,82 @@
+(make-package :compiler :use '(:lisp :si))
+(make-package :sloop :use '(:lisp))
+(make-package :ansi-loop :use'(:lisp))
+(make-package :defpackage :use '(:lisp))
+(make-package :tk :use '(:lisp :sloop))
+(make-package :fpe :use '(:lisp))
+(make-package :cltl1-compat)
+
+(in-package :system)
+(use-package :fpe)
+
+#+(or pcl ansi-cl)(load "../pcl/package.lisp")
+#+ansi-cl(load "../clcs/package.lisp")
+
+(init-system) 
+(in-package :si)
+(gbc t)
+
+(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 *system-directory*) (list :parent)))
+       (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 #-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))
+  (load (make-pathname :name "gcl_auto_new" :type "lsp" :directory lsp))
+  
+  (gbc t))
+
+(setf (symbol-function 'clear-compiler-properties)
+      (symbol-function 'compiler::compiler-clear-compiler-properties))
+
+(terpri)
+(setq *inhibit-macro-special* t)
+(gbc t)
+(reset-gbc-count)
+
+(defun top-level nil (gcl-top-level))
+
+(set-up-top-level)
+
+(setq *gcl-extra-version* @LI-EXTVERS@
+      *gcl-minor-version* @LI-MINVERS@ 
+      *gcl-major-version* @LI-MAJVERS@)
+
+(defvar *system-banner* (default-system-banner))
+(setq *optimize-maximum-pages* t)
+
+(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@
+      *opt-three* @LI-OPT-THREE@
+      *opt-two* @LI-OPT-TWO@
+      *init-lsp* @LI-INIT-LSP@)
+
+(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)))
+(export '*load-pathname* :si);For maxima, at least as of 5.34.1
+
+#+ansi-cl (use-package :pcl :user)
index 3c809f0e1a56309aace3458fc638ada8dad23547..721f820ce378b01c2c7a03e196f6f8954b0a55fd 100644 (file)
@@ -7,6 +7,10 @@ void
 gcl_init_init()
 {
 
+  object features;
+  features=find_symbol(make_simple_string("*FEATURES*"),system_package);
+  features->s.s_dbind=make_cons(make_keyword("PCL"),features->s.s_dbind);
+
   build_symbol_table();
 
   lsp_init("../lsp/gcl_export.lsp");
@@ -86,7 +90,7 @@ gcl_init_system(object no_init)
   ar_check_init(gcl_cmpmain,no_init);
 
 #ifdef HAVE_XGCL
-  lsp_init("../xgcl-2/sysdef.lisp");
+  lsp_init("../xgcl-2/package.lisp");
   ar_check_init(gcl_Xlib,no_init);
   ar_check_init(gcl_Xutil,no_init);
   ar_check_init(gcl_X,no_init);
index cad70b7de310aa0ef96f549cc01c398fd54b8902..60446ff10cf111ac09a19f60c884125a91c17461 100755 (executable)
@@ -4,6 +4,10 @@ void
 gcl_init_init()
 {
 
+  object features;
+  features=find_symbol(make_simple_string("*FEATURES*"),system_package);
+  features->s.s_dbind=make_cons(make_keyword("PRE-GCL"),features->s.s_dbind);
+
   build_symbol_table();
 
   lsp_init("../lsp/gcl_export.lsp");
@@ -80,6 +84,7 @@ gcl_init_system(object no_init)
   lsp_init("../cmpnew/gcl_cmpvar.lsp");
   lsp_init("../cmpnew/gcl_cmpvs.lsp");
   lsp_init("../cmpnew/gcl_cmpwt.lsp");
+  lsp_init("../cmpnew/gcl_cmpmain.lsp");
 
   
 }
index bf10ca0ffecfadd55ddb6a7decc7069359065349..cc89f2d0491a783c61755805ac67309dd7991cb8 100644 (file)
@@ -36,8 +36,8 @@
 (progn (allocate 'cons 100) (allocate 'string 40)
  (system:init-system) (gbc t)
  (si::multiply-bignum-stack 25)
- (or lisp::*link-array*
-  (setq lisp::*link-array*
+ (or si::*link-array*
+  (setq si::*link-array*
      (make-array 500 :element-type 'fixnum :fill-pointer 0)))
  (use-fast-links t)
 (setq compiler::*cmpinclude* "<cmpinclude.h>") (load #"../cmpnew/cmpmain.lsp") (gbc t) (load #"../cmpnew/lfun_list.lsp")
index 2353b0fa2c8afa806831798fffd575e044244be2..8c9654a436475a251007e5dd151e4449f1122fa3 100644 (file)
@@ -4,10 +4,13 @@
 all: objects #docs
 
 objects: $(LISP)
-       echo '(load "sysdef.lisp")(xlib::compile-xgcl)' | $(LISP)
+       echo '(load "sysdef.lisp")(load "sys-proclaim.lisp")(xlib::compile-xgcl)' | $(LISP)
 
 saved_xgcl: $(LISP)
-       echo '(load "sysdef.lisp")(xlib::compile-xgcl)(xlib::save-xgcl "$@")' | $(LISP)
+       echo '(load "sysdef.lisp")(load "sys-proclaim.lisp")(xlib::compile-xgcl)(xlib::save-xgcl "$@")' | $(LISP)
+
+sys-proclaim.lisp:
+       echo '(load "sysdef.lisp")(compiler::emit-fn t)(xlib::compile-xgcl)(compiler::make-all-proclaims "*.fn")' | $(LISP)
 
 docs: dwdoc/dwdoccontents.html dwdoc.pdf
 
@@ -22,7 +25,7 @@ dwdoc.pdf: dwdoc.tex
 
 clean:
        rm -f *.o *.data saved_*  cmpinclude.h dwdoc.aux dwdoc.log gmon.out
-       rm -f gcl*c gcl*h gcl*data gcl_xrecompile* user-init*
+       rm -f gcl*c gcl*h gcl*data gcl_xrecompile* user-init* *fn
 
 clean-docs:
        rm -rf dwdoc dwdoc.pdf
diff --git a/xgcl-2/package.lisp b/xgcl-2/package.lisp
new file mode 100644 (file)
index 0000000..89b147d
--- /dev/null
@@ -0,0 +1 @@
+(make-package :XLIB :use '(:lisp :system))
diff --git a/xgcl-2/sys-proclaim.lisp b/xgcl-2/sys-proclaim.lisp
new file mode 100644 (file)
index 0000000..6428f0c
--- /dev/null
@@ -0,0 +1,287 @@
+
+(COMMON-LISP::IN-PACKAGE "COMMON-LISP-USER") 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::*)
+         XLIB::WINDOW-UNSET XLIB::WINDOW-GET-GEOMETRY
+         XLIB::WINDOW-SET-INVERT XLIB::WINDOW-FONT-INFO
+         XLIB::GET-ST-POINT XLIB::EDITMENU-YANK
+         XLIB::WINDOW-INIT-MOUSE-POLL XLIB::WINDOW-SET-XOR
+         XLIB::WINDOW-TOP-NEG-Y XLIB::WINDOW-LEFT
+         XLIB::WINDOW-QUERY-POINTER XLIB::TEXTMENU-DRAW
+         XLIB::EDITMENU-CARAT XLIB::EDITMENU-DRAW
+         XLIB::WINDOW-STD-LINE-ATTR XLIB::WINDOW-UNMAP
+         XLIB::WINDOW-QUERY-POINTER-B XLIB::WINDOW-BACKGROUND
+         XLIB::EDITMENU-DELETE XLIB::WINDOW-MOVE XLIB::DOWINDOWCOM
+         XLIB::WINDOW-SYNC XLIB::PICMENU-DRAW XLIB::WINDOW-MAP
+         XLIB::WINDOW-RESET-COLOR XLIB::EDITMENU-KILL
+         XLIB::BARMENU-DRAW XLIB::WINDOW-GET-GEOMETRY-B
+         XLIB::MENU-CLEAR XLIB::WINDOW-RESET XLIB::WINDOW-WFUNCTION
+         XLIB::MENU-DRAW XLIB::WINDOW-FOREGROUND XLIB::WINDOW-CLEAR
+         XLIB::EDITMENU-BACKSPACE XLIB::WINDOW-DRAW-BORDER
+         XLIB::LISP-STRING XLIB::WINDOW-SET-ERASE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::T)
+         XLIB::OPEN-WINDOW)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::T)
+         XLIB::WINDOW-GET-ELLIPSE XLIB::EDITMENU-SELECT
+         XLIB::WINDOW-SET-XCOLOR XLIB::TEXTMENU-SELECT
+         XLIB::PICMENU-SELECT XLIB::MAKECONT XLIB::WINDOW-GET-CIRCLE
+         XLIB::MENU XLIB::WINDOW-GET-REGION XLIB::TEXTMENU-SET-TEXT
+         XLIB::MENU-SELECT XLIB::BARMENU-SELECT
+         XLIB::PICMENU-CREATE-FROM-SPEC XLIB::PRINTINDEX
+         XLIB::EDITMENU-EDIT XLIB::MENU-CREATE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::*)
+         XLIB::BARMENU-UPDATE-VALUE XLIB::WINDOW-FONT-STRING-WIDTH
+         XLIB::MENU-FIND-ITEM-WIDTH XLIB::WINDOW-STRING-WIDTH
+         XLIB::PICMENU-BOX-ITEM XLIB::WINDOW-SET-FOREGROUND
+         XLIB::WINDOW-INVERTAREA XLIB::PICMENU-UNBOX-ITEM
+         XLIB::PICMENU-DRAW-NAMED-BUTTON XLIB::WINDOW-SET-CURSOR
+         XLIB::WINDOW-SET-LINE-WIDTH XLIB::PICMENU-DELETE-NAMED-BUTTON
+         XLIB::EDITMENU-ERASE XLIB::PICMENU-DRAW-BUTTON
+         XLIB::WINDOW-SET-BACKGROUND)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::*)
+         XLIB::XINIT XLIB::WINDOW-SCREEN-HEIGHT)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
+             (COMMON-LISP::VALUES COMMON-LISP::T COMMON-LISP::T))
+         XLIB::WINDOW-CIRCLE-RADIUS)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::*)
+         XLIB::WINDOW-XOR-BOX-XY XLIB::WINDOW-DRAW-BOX-CORNERS
+         XLIB::WINDOW-DRAW-LINE-XY XLIB::WINDOW-DRAW-ARROW2-XY
+         XLIB::WINDOW-DRAW-ARROW-XY XLIB::WINDOW-DRAW-ELLIPSE-XY
+         XLIB::WINDOW-ERASE-BOX-XY XLIB::WINDOW-DRAW-BOX-XY
+         XLIB::WINDOW-DRAW-ARROWHEAD-XY)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T)
+             COMMON-LISP::*)
+         XLIB::WINDOW-COPY-AREA-XY)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::*)
+         XLIB::WINDOW-PRETTYPRINTAT XLIB::MENU-UNBOX-ITEM
+         XLIB::WINDOW-PRINTAT XLIB::WINDOW-DRAW-CROSSHAIRS-XY
+         XLIB::WINDOW-MOVETO-XY XLIB::WINDOW-INVERT-AREA
+         XLIB::WINDOW-DRAW-DOT-XY XLIB::WINDOW-DRAW-CARAT
+         XLIB::WINDOW-ERASE-AREA XLIB::MENU-BOX-ITEM
+         XLIB::WINDOW-DRAW-CROSS-XY)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::*)
+         XLIB::WINDOW-DRAW-CIRCLE-XY XLIB::WINDOW-PRINT-LINE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T)
+             COMMON-LISP::*)
+         XLIB::WINDOW-PRETTYPRINTAT-XY XLIB::WINDOW-DRAW-CIRCLE-PT
+         XLIB::EDITMENU-DISPLAY XLIB::WINDOW-PRINTAT-XY
+         XLIB::WINDOW-PROCESS-CHAR-EVENT XLIB::MENU-DISPLAY-ITEM)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::*)
+         XLIB::WINDOW-ADJ-BOX-XY)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::*)
+         XLIB::WINDOW-DRAW-ARC-XY)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::*)
+         XLIB::WINDOW-DRAW-ELLIPSE-PT XLIB::WINDOW-ERASE-AREA-XY
+         XLIB::WINDOW-INVERT-AREA-XY XLIB::WINDOW-DRAW-VECTOR-PT)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::*)
+             COMMON-LISP::*)
+         XLIB::WINDOW-DRAW-LINE XLIB::WINDOW-DRAW-BOX
+         XLIB::WINDOW-DRAW-CIRCLE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::*)
+             COMMON-LISP::*)
+         XLIB::WINDOW-DRAW-RCBOX-XY)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::*)
+         XLIB::WINDOW-DRAW-LATEX-XY)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::*)
+         XLIB::WINDOW-SET-LINE-ATTR)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::*)
+         XLIB::WINDOW-DRAW-BOX-LINE-XY)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::T)
+         XLIB::WINDOW-POSITIVE-Y XLIB::WINDOW-STRING-EXTENTS
+         XLIB::MENU-CHOOSE XLIB::WINDOW-SET-FONT XLIB::PUSHFONT
+         XLIB::WINDOW-STRING-HEIGHT XLIB::WORDLIST<
+         XLIB::EDITMENU-LINE-Y XLIB::MENU-ITEM-Y
+         XLIB::MENU-FIND-ITEM-HEIGHT XLIB::XFERCHARS
+         XLIB::WINDOW-CENTEROFFSET XLIB::MENU-FIND-ITEM-Y
+         XLIB::EDITMENU-CHAR XLIB::MENU-ITEM-VALUE
+         XLIB::MENU-FIND-ITEM)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::*)
+         XLIB::WINDOW-FREE-COLOR)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::T)
+         XLIB::SEARCHFORALPHA XLIB::SAFE-CHAR XLIB::WINDOW-XINIT
+         XLIB::WINDOW-MENU XLIB::WINDOW-INIT-KEYMAP XLIB::PARSE-INT
+         XLIB::WINDOW-DESTROY-SELECTED-WINDOW
+         XLIB::WINDOW-GET-MOUSE-POSITION)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION COMMON-LISP::NIL COMMON-LISP::FIXNUM)
+         XLIB::FLUSHLINE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::T)
+         XLIB::PICMENU-BUTTON-CONTAINSXY? XLIB::MENU-MOVETO-XY
+         XLIB::WINDOW-GET-BOX-SIZE XLIB::PRINTINDEXN
+         XLIB::WINDOW-GET-LINE-POSITION
+         XLIB::PICMENU-SET-NAMED-BUTTON-COLOR XLIB::EDITMENU-SETXY
+         XLIB::MENU-SELECT-B XLIB::MENU-REPOSITION-LINE
+         XLIB::WINDOW-GET-VECTOR-END)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::T)
+         XLIB::WINDOW-CREATE XLIB::WINDOW-TRACK-MOUSE
+         XLIB::PICMENU-ITEM-POSITION XLIB::WINDOW-GET-CHARS
+         XLIB::TEXTMENU-CREATE XLIB::EDITMENU-CREATE XLIB::TOHTML
+         XLIB::WINDOW-SET-COLOR XLIB::MENU-ITEM-POSITION)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::T)
+         XLIB::WINDOW-INPUT-STRING XLIB::PICMENU-CREATE-SPEC
+         XLIB::WINDOW-SET-COLOR-RGB XLIB::WINDOW-PRINT-LINES
+         XLIB::PICMENU-CREATE)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::*)
+             COMMON-LISP::T)
+         XLIB::WINDOW-GET-ICON-POSITION XLIB::BARMENU-CREATE
+         XLIB::WINDOW-GET-LATEX-POSITION XLIB::WINDOW-GET-BOX-POSITION)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::T)
+         XLIB::WINDOW-EDIT XLIB::WINDOW-TRACK-MOUSE-IN-REGION)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T)
+             COMMON-LISP::T)
+         XLIB::WINDOW-ADJUST-BOX-SIDE XLIB::EDITMENU-EDIT-FN)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION
+             (COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::T COMMON-LISP::T
+                 COMMON-LISP::T COMMON-LISP::*)
+             COMMON-LISP::T)
+         XLIB::WINDOW-GET-BOX-LINE-POSITION)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::T) COMMON-LISP::T)
+         XLIB::WINDOW-DESTROY XLIB::EDITMENU-CALCULATE-SIZE
+         XLIB::STRINGIFY XLIB::DOLINE XLIB::PUSHENV
+         XLIB::WINDOW-POLL-MOUSE XLIB::WINDOW-FONT XLIB::WINDOW-SIZE
+         XLIB::EDITMENU-END XLIB::WINDOW-PAINT XLIB::WINDOW-GEOMETRY
+         XLIB::MENU-DESTROY XLIB::WINDOW-LABEL
+         XLIB::PICMENU-CALCULATE-SIZE XLIB::POPENV XLIB::WINDOW-PARENT
+         XLIB::WINDOW-WAIT-UNMAP XLIB::EDITMENU-INIT
+         XLIB::WINDOW-GET-POINT XLIB::MENU-SELECT!
+         XLIB::MENU-CALCULATE-SIZE XLIB::BARMENU-INIT XLIB::DOCOMMAND
+         XLIB::MENU-INIT XLIB::WINDOW-OPEN XLIB::EDITMENU-META-B
+         XLIB::WINDOW-GET-RAW-CHAR XLIB::WINDOW-DRAWABLE-HEIGHT
+         XLIB::MENU-REPOSITION XLIB::WINDOW-YPOSITION
+         XLIB::EDITMENU-ALPHANUMBERICP XLIB::EDITMENU-NEXT
+         XLIB::MENU-SIZE XLIB::EDITMENU-PREVIOUS XLIB::EDITMENU-FORWARD
+         XLIB::EDITMENU-BEGINNING XLIB::PICMENU-DESTROY
+         XLIB::WINDOW-RESET-GEOMETRY XLIB::WINDOW-GCONTEXT
+         XLIB::EDITMENU-BACKWARD XLIB::TERMLINE
+         XLIB::WINDOW-DRAWABLE-WIDTH XLIB::WINDOW-GET-CROSSHAIRS
+         XLIB::BARMENU-CALCULATE-SIZE XLIB::WINDOW-CHAR-DECODE
+         XLIB::DOTABULAR XLIB::PICMENU-INIT XLIB::WINDOW-WAIT-EXPOSURE
+         XLIB::PARSE-WORD XLIB::TEXTMENU-INIT XLIB::SEARCHFOR
+         XLIB::MENU-OFFSET XLIB::MENU-ADJUST-OFFSET
+         XLIB::WINDOW-SET-COPY XLIB::TEXTMENU-CALCULATE-SIZE
+         XLIB::WINDOW-GET-CROSS XLIB::EDITMENU-META-F
+         XLIB::WINDOW-GET-CLICK XLIB::EDITMENU-CURRENT-CHAR
+         XLIB::DOHTML XLIB::WINDOW-CLOSE XLIB::EDITMENU-RETURN
+         XLIB::WINDOW-CODE-CHAR)) 
+(COMMON-LISP::PROCLAIM
+    '(COMMON-LISP::FTYPE
+         (COMMON-LISP::FUNCTION (COMMON-LISP::*) COMMON-LISP::*)
+         XLIB::WINDOW-FORCE-OUTPUT)) 
\ No newline at end of file
index a60a607173cc2e17ee38ecf2fceb29d154688e2a..00c27d97122de9275cde4fdc08a2ed7a67f7ee63 100644 (file)
@@ -19,9 +19,8 @@
 ; Some of the files that interface to the Xlib are adapted from DEC/MIT files.
 ; See the file dec.copyright for details.
 
-(make-package :XLIB)
+(load "package.lisp")
 (in-package :XLIB)
-(sys::use-package '(:lisp :system :sys))
 
 (defvar *files* '( "gcl_Xlib"
       "gcl_Xutil"