Description: <short summary of the patch>
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
Author: Camm Maguire <camm@debian.org>
---
The information above should follow the Patch Tagging Guidelines, please
checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
are templates for supplementary fields that you might want to add:
Origin: <vendor|upstream|other>, <url of original patch>
Bug: <url in upstream bugtracker>
Bug-Debian: https://bugs.debian.org/<bugnumber>
Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
Forwarded: <no|not-needed|url proving that it has been forwarded>
Reviewed-By: <name and email of someone who approved the patch>
Last-Update: <YYYY-MM-DD>
--- gcl-2.6.12.orig/clcs/package.lisp
+++ gcl-2.6.12/clcs/package.lisp
@@ -20,3 +20,4 @@
(defvar *this-package* (find-package :conditions))
+(import 'si::(clines defentry defcfun object void int double))
--- gcl-2.6.12.orig/clcs/sys-proclaim.lisp
+++ gcl-2.6.12/clcs/sys-proclaim.lisp
@@ -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
--- gcl-2.6.12.orig/cmpnew/gcl_cmpbind.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpbind.lsp
@@ -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)
--- gcl-2.6.12.orig/cmpnew/gcl_cmpblock.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpblock.lsp
@@ -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)
--- gcl-2.6.12.orig/cmpnew/gcl_cmpcall.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpcall.lsp
@@ -19,7 +19,7 @@
;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-(in-package 'compiler)
+(in-package :compiler)
(defvar *ifuncall* nil)
--- gcl-2.6.12.orig/cmpnew/gcl_cmpcatch.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpcatch.lsp
@@ -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)
--- gcl-2.6.12.orig/cmpnew/gcl_cmpenv.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpenv.lsp
@@ -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)
@@ -337,7 +337,7 @@
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*)
@@ -366,6 +366,12 @@
(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
@@ -383,10 +389,8 @@
;;; 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)
@@ -449,7 +453,7 @@
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
@@ -667,7 +671,7 @@
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)
--- gcl-2.6.12.orig/cmpnew/gcl_cmpeval.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpeval.lsp
@@ -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)
@@ -180,9 +180,8 @@
(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)
@@ -486,19 +485,22 @@
(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))
--- gcl-2.6.12.orig/cmpnew/gcl_cmpflet.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpflet.lsp
@@ -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)
--- gcl-2.6.12.orig/cmpnew/gcl_cmpfun.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpfun.lsp
@@ -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)
@@ -565,7 +565,7 @@
(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)))))
@@ -803,7 +803,7 @@
(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))
@@ -811,7 +811,7 @@
(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")
--- gcl-2.6.12.orig/cmpnew/gcl_cmpif.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpif.lsp
@@ -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)
--- gcl-2.6.12.orig/cmpnew/gcl_cmpinline.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpinline.lsp
@@ -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 )
--- gcl-2.6.12.orig/cmpnew/gcl_cmplabel.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmplabel.lsp
@@ -19,7 +19,7 @@
;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-(in-package 'compiler)
+(in-package :compiler)
(defvar *last-label* 0)
(defvar *exit*)
--- gcl-2.6.12.orig/cmpnew/gcl_cmplam.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmplam.lsp
@@ -19,7 +19,7 @@
;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-(in-package 'compiler)
+(in-package :compiler)
;;; During Pass1, a lambda-list
;;;
--- gcl-2.6.12.orig/cmpnew/gcl_cmplet.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmplet.lsp
@@ -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")))
--- gcl-2.6.12.orig/cmpnew/gcl_cmploc.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmploc.lsp
@@ -19,7 +19,7 @@
;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-(in-package 'compiler)
+(in-package :compiler)
(defvar *value-to-go*)
--- gcl-2.6.12.orig/cmpnew/gcl_cmpmain.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpmain.lsp
@@ -24,7 +24,7 @@
;;; *****************
-(in-package 'compiler)
+(in-package :compiler)
(export '(*compile-print* *compile-verbose*))
@@ -49,7 +49,11 @@
(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.
--- gcl-2.6.12.orig/cmpnew/gcl_cmpmap.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpmap.lsp
@@ -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)
--- gcl-2.6.12.orig/cmpnew/gcl_cmpmulti.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpmulti.lsp
@@ -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)
--- gcl-2.6.12.orig/cmpnew/gcl_cmpopt.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpopt.lsp
@@ -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
@@ -136,8 +136,11 @@
(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)")
@@ -159,7 +162,7 @@
(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))
@@ -433,7 +436,9 @@
(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))
@@ -456,7 +461,7 @@
(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)
--- gcl-2.6.12.orig/cmpnew/gcl_cmpspecial.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpspecial.lsp
@@ -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)
--- gcl-2.6.12.orig/cmpnew/gcl_cmptag.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmptag.lsp
@@ -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)
--- gcl-2.6.12.orig/cmpnew/gcl_cmptest.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmptest.lsp
@@ -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)
--- gcl-2.6.12.orig/cmpnew/gcl_cmptop.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmptop.lsp
@@ -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)
@@ -572,7 +572,7 @@
(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))
@@ -696,7 +696,7 @@
)))
(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)
@@ -1237,10 +1237,10 @@
(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) )
))
))))
@@ -1406,7 +1406,7 @@
((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)
@@ -1457,7 +1457,7 @@
(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)))
@@ -1484,7 +1484,7 @@
(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))
@@ -1493,7 +1493,7 @@
(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)))
--- gcl-2.6.12.orig/cmpnew/gcl_cmptype.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmptype.lsp
@@ -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))))
@@ -109,8 +109,8 @@
((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))
@@ -142,11 +142,13 @@
((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)
@@ -160,7 +162,7 @@
(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)
--- gcl-2.6.12.orig/cmpnew/gcl_cmputil.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmputil.lsp
@@ -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*
@@ -204,7 +204,7 @@
(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))
@@ -214,7 +214,7 @@
(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*)))
--- gcl-2.6.12.orig/cmpnew/gcl_cmpvar.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpvar.lsp
@@ -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)
--- gcl-2.6.12.orig/cmpnew/gcl_cmpvs.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpvs.lsp
@@ -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)
--- gcl-2.6.12.orig/cmpnew/gcl_cmpwt.lsp
+++ gcl-2.6.12/cmpnew/gcl_cmpwt.lsp
@@ -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")
--- gcl-2.6.12.orig/cmpnew/gcl_collectfn.lsp
+++ gcl-2.6.12/cmpnew/gcl_collectfn.lsp
@@ -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
--- gcl-2.6.12.orig/cmpnew/gcl_lfun_list.lsp
+++ gcl-2.6.12/cmpnew/gcl_lfun_list.lsp
@@ -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)
@@ -129,7 +129,7 @@
(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)
@@ -303,7 +303,7 @@
(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)
@@ -365,7 +365,7 @@
(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)
--- gcl-2.6.12.orig/cmpnew/gcl_make_ufun.lsp
+++ gcl-2.6.12/cmpnew/gcl_make_ufun.lsp
@@ -20,13 +20,13 @@
-(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)
--- gcl-2.6.12.orig/cmpnew/gcl_nocmpinc.lsp
+++ gcl-2.6.12/cmpnew/gcl_nocmpinc.lsp
@@ -1,6 +1,6 @@
-(in-package 'compiler)
+(in-package :compiler)
(defvar *cmpinclude-string* nil)
@@ -20,4 +20,4 @@
-
\ No newline at end of file
+
--- gcl-2.6.12.orig/cmpnew/sys-proclaim.lisp
+++ gcl-2.6.12/cmpnew/sys-proclaim.lisp
@@ -1,168 +1,377 @@
-(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
--- gcl-2.6.12.orig/configure
+++ gcl-2.6.12/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
--- gcl-2.6.12.orig/configure.in
+++ gcl-2.6.12/configure.in
@@ -2112,7 +2112,6 @@ AC_ARG_ENABLE(ansi,[--enable-ansi builds
if test "$enable_ansi" = "yes" ; then
SYSTEM=ansi_gcl
- AC_DEFINE(ANSI_COMMON_LISP,1,[compile ansi compliant image])
CLSTANDARD=ANSI
else
SYSTEM=gcl
--- gcl-2.6.12.orig/h/amd64-linux.h
+++ gcl-2.6.12/h/amd64-linux.h
@@ -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*/
--- gcl-2.6.12.orig/h/att_ext.h
+++ gcl-2.6.12/h/att_ext.h
@@ -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
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;
--- gcl-2.6.12.orig/h/compdefs.h
+++ gcl-2.6.12/h/compdefs.h
@@ -114,3 +114,4 @@ stp_ordinary
SIGNED_CHAR(x)
FEerror(x,y...)
FEwrong_type_argument(x,y)
+BIT_ENDIAN(x)
--- gcl-2.6.12.orig/h/elf64_i386_reloc.h
+++ gcl-2.6.12/h/elf64_i386_reloc.h
@@ -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;
--- gcl-2.6.12.orig/h/lu.h
+++ gcl-2.6.12/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;
};
--- gcl-2.6.12.orig/h/notcomp.h
+++ gcl-2.6.12/h/notcomp.h
@@ -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
--- gcl-2.6.12.orig/h/object.h
+++ gcl-2.6.12/h/object.h
@@ -77,7 +77,7 @@ Foundation, 675 Mass Ave, Cambridge, MA
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 /
/*
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;
/*
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 */
--- gcl-2.6.12.orig/h/page.h
+++ gcl-2.6.12/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
@@ -31,9 +28,10 @@
#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
@@ -47,33 +45,25 @@
#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))
--- gcl-2.6.12.orig/h/protoize.h
+++ gcl-2.6.12/h/protoize.h
@@ -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; */
@@ -862,9 +863,6 @@ void
Lstandard_char_p(void);
void
-Lstring_char_p(void);
-
-void
Lchar_code(void);
void
@@ -955,9 +953,6 @@ void
Lstandard_char_p(void);
void
-Lstring_char_p(void);
-
-void
Lcharacter(void);
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);
--- gcl-2.6.12.orig/h/symbol.h
+++ gcl-2.6.12/h/symbol.h
@@ -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;
--- gcl-2.6.12.orig/h/writable.h
+++ gcl-2.6.12/h/writable.h
@@ -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);
}
--- gcl-2.6.12.orig/info/form.texi
+++ gcl-2.6.12/info/form.texi
@@ -8,18 +8,6 @@ List of all the lambda-list keywords use
@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
--- gcl-2.6.12.orig/lsp/gcl_arraylib.lsp
+++ gcl-2.6.12/lsp/gcl_arraylib.lsp
@@ -22,23 +22,7 @@
;;;; 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)))))
--- gcl-2.6.12.orig/lsp/gcl_auto.lsp
+++ gcl-2.6.12/lsp/gcl_auto.lsp
@@ -1,4 +1,4 @@
-(in-package 'si)
+(in-package :si)
;;; Autoloaders.
--- gcl-2.6.12.orig/lsp/gcl_auto_new.lsp
+++ gcl-2.6.12/lsp/gcl_auto_new.lsp
@@ -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|)
--- gcl-2.6.12.orig/lsp/gcl_autoload.lsp
+++ gcl-2.6.12/lsp/gcl_autoload.lsp
@@ -21,8 +21,9 @@
;;;; AUTOLOAD
-;;; Go into LISP.
-(in-package 'lisp)
+(in-package :si)
+
+(export '(clines defentry defcfun object void int double))
;(defvar *features*)
@@ -127,13 +128,13 @@
;;; 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 . #\.)
@@ -279,12 +280,12 @@
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)
--- gcl-2.6.12.orig/lsp/gcl_debug.lsp
+++ gcl-2.6.12/lsp/gcl_debug.lsp
@@ -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)
@@ -583,7 +583,7 @@
;; 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)))
@@ -625,7 +625,7 @@
(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)))))))
@@ -677,7 +677,7 @@
(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
@@ -717,7 +717,7 @@
(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)
--- gcl-2.6.12.orig/lsp/gcl_defmacro.lsp
+++ gcl-2.6.12/lsp/gcl_defmacro.lsp
@@ -22,11 +22,7 @@
;;;; 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))))
--- gcl-2.6.12.orig/lsp/gcl_defstruct.lsp
+++ gcl-2.6.12/lsp/gcl_defstruct.lsp
@@ -22,21 +22,13 @@
;;;; 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))
@@ -99,7 +91,10 @@
(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))
@@ -504,7 +499,7 @@
;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
@@ -569,9 +564,7 @@
(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)
--- gcl-2.6.12.orig/lsp/gcl_describe.lsp
+++ gcl-2.6.12/lsp/gcl_describe.lsp
@@ -22,12 +22,7 @@
;;;; DESCRIBE and INSPECT
-(in-package 'lisp)
-
-(export '(describe inspect))
-
-
-(in-package 'system)
+(in-package :si)
(proclaim '(optimize (safety 2) (space 3)))
@@ -191,7 +186,6 @@
(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))
@@ -353,7 +347,7 @@
(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]"
--- gcl-2.6.12.orig/lsp/gcl_destructuring_bind.lsp
+++ gcl-2.6.12/lsp/gcl_destructuring_bind.lsp
@@ -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.")
--- gcl-2.6.12.orig/lsp/gcl_doc-file.lsp
+++ gcl-2.6.12/lsp/gcl_doc-file.lsp
@@ -13,7 +13,7 @@
for w in-package v
when (setq doc (documentation w 'function))
do (format st " F~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 ""))
--- gcl-2.6.12.orig/lsp/gcl_evalmacros.lsp
+++ gcl-2.6.12/lsp/gcl_evalmacros.lsp
@@ -20,11 +20,7 @@
;;;; evalmacros.lsp
-(in-package "LISP")
-
-(export '(defvar defparameter defconstant))
-
-(in-package "SYSTEM")
+(in-package :si)
(eval-when (compile) (proclaim '(optimize (safety 2) (space 3))))
--- gcl-2.6.12.orig/lsp/gcl_export.lsp
+++ gcl-2.6.12/lsp/gcl_export.lsp
@@ -21,313 +21,468 @@
;;;;
;;;; 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))
--- gcl-2.6.12.orig/lsp/gcl_fpe.lsp
+++ gcl-2.6.12/lsp/gcl_fpe.lsp
@@ -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
--- gcl-2.6.12.orig/lsp/gcl_info.lsp
+++ gcl-2.6.12/lsp/gcl_info.lsp
@@ -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)))
@@ -105,7 +105,7 @@
((> 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)))
--- gcl-2.6.12.orig/lsp/gcl_iolib.lsp
+++ gcl-2.6.12/lsp/gcl_iolib.lsp
@@ -22,21 +22,7 @@
;;;; 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)))
--- gcl-2.6.12.orig/lsp/gcl_listlib.lsp
+++ gcl-2.6.12/lsp/gcl_listlib.lsp
@@ -25,13 +25,7 @@
; 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)))
--- gcl-2.6.12.orig/lsp/gcl_mislib.lsp
+++ gcl-2.6.12/lsp/gcl_mislib.lsp
@@ -20,15 +20,7 @@
;;;; 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)))
@@ -37,13 +29,13 @@
(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)
--- gcl-2.6.12.orig/lsp/gcl_module.lsp
+++ gcl-2.6.12/lsp/gcl_module.lsp
@@ -22,13 +22,7 @@
;;;; 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))))
--- gcl-2.6.12.orig/lsp/gcl_numlib.lsp
+++ gcl-2.6.12/lsp/gcl_numlib.lsp
@@ -22,20 +22,7 @@
;;;; 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)))
--- gcl-2.6.12.orig/lsp/gcl_packlib.lsp
+++ gcl-2.6.12/lsp/gcl_packlib.lsp
@@ -22,14 +22,7 @@
;;;; 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)))
@@ -121,7 +114,7 @@
(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")
--- gcl-2.6.12.orig/lsp/gcl_predlib.lsp
+++ gcl-2.6.12/lsp/gcl_predlib.lsp
@@ -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)
@@ -206,8 +204,8 @@
(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
@@ -309,7 +307,7 @@
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
@@ -583,23 +581,23 @@
(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
@@ -635,7 +633,7 @@
(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?
@@ -658,7 +656,7 @@
(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) '*))
--- gcl-2.6.12.orig/lsp/gcl_profile.lsp
+++ gcl-2.6.12/lsp/gcl_profile.lsp
@@ -1,5 +1,5 @@
-(in-package 'si)
+(in-package :si)
(use-package "SLOOP")
;; Sample Usage:
--- gcl-2.6.12.orig/lsp/gcl_seq.lsp
+++ gcl-2.6.12/lsp/gcl_seq.lsp
@@ -22,11 +22,7 @@
;;;; 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
--- gcl-2.6.12.orig/lsp/gcl_seqlib.lsp
+++ gcl-2.6.12/lsp/gcl_seqlib.lsp
@@ -22,24 +22,7 @@
;;;; 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)))
--- gcl-2.6.12.orig/lsp/gcl_serror.lsp
+++ gcl-2.6.12/lsp/gcl_serror.lsp
@@ -100,6 +100,8 @@
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)))
--- gcl-2.6.12.orig/lsp/gcl_setf.lsp
+++ gcl-2.6.12/lsp/gcl_setf.lsp
@@ -22,16 +22,7 @@
;;;; 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))))
@@ -86,10 +77,10 @@
',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)
@@ -218,7 +209,7 @@
(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)
@@ -234,7 +225,7 @@
(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)
@@ -246,7 +237,7 @@
(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
@@ -261,7 +252,7 @@
(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))
@@ -277,7 +268,7 @@
(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)))
@@ -290,7 +281,7 @@
(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)))
@@ -303,7 +294,7 @@
(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)))
@@ -346,7 +337,7 @@
(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)
@@ -397,7 +388,7 @@
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
@@ -426,7 +417,7 @@
,@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))
@@ -451,7 +442,7 @@
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))
@@ -480,7 +471,7 @@
(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)
@@ -492,7 +483,7 @@
(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)
@@ -508,7 +499,7 @@
(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))))
@@ -520,7 +511,7 @@
(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
@@ -535,7 +526,7 @@
(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))))
--- gcl-2.6.12.orig/lsp/gcl_sloop.lsp
+++ gcl-2.6.12/lsp/gcl_sloop.lsp
@@ -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
--- gcl-2.6.12.orig/lsp/gcl_stack-problem.lsp
+++ gcl-2.6.12/lsp/gcl_stack-problem.lsp
@@ -1,4 +1,4 @@
-(in-package 'si)
+(in-package :si)
(defvar *old-handler* #'si::universal-error-handler)
--- gcl-2.6.12.orig/lsp/gcl_top.lsp
+++ gcl-2.6.12/lsp/gcl_top.lsp
@@ -24,24 +24,14 @@
;;;; 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)
@@ -330,7 +318,7 @@
(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))))))
@@ -384,7 +372,7 @@
(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)
)))
--- gcl-2.6.12.orig/lsp/gcl_trace.lsp
+++ gcl-2.6.12/lsp/gcl_trace.lsp
@@ -27,13 +27,7 @@
;; 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)))
@@ -169,7 +163,7 @@
(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)
--- gcl-2.6.12.orig/lsp/sys-proclaim.lisp
+++ gcl-2.6.12/lsp/sys-proclaim.lisp
@@ -1,294 +1,522 @@
-(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
--- gcl-2.6.12.orig/o/alloc.c
+++ gcl-2.6.12/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
d=d<0 ? 0 : d;
d=new_holepage<d ? new_holepage : d;
- holepage = d + n;
+ resize_hole(d+n,t_relocatable);
-#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 */
-
-
-#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
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
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
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 typ
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, fi
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
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 typemana
}
- 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 type
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,fSallocate
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,fSallocate
));
}
-/* 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",ob
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 els
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);
}
}
--- gcl-2.6.12.orig/o/array.c
+++ gcl-2.6.12/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),"")
--- gcl-2.6.12.orig/o/assignment.c
+++ gcl-2.6.12/o/assignment.c
@@ -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 {
--- gcl-2.6.12.orig/o/bind.c
+++ gcl-2.6.12/o/bind.c
@@ -918,8 +918,8 @@ parse_key_new_new(int n, object *base, s
/* 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, s
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, o
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, o
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, o
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
--- gcl-2.6.12.orig/o/cfun.c
+++ gcl-2.6.12/o/cfun.c
@@ -306,6 +306,15 @@ make_special_form_internal(char *s, void
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),"")
--- gcl-2.6.12.orig/o/character.d
+++ gcl-2.6.12/o/character.d
@@ -50,14 +50,6 @@ Foundation, 675 Mass Ave, Cambridge, MA
@(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);
}
--- gcl-2.6.12.orig/o/cmpaux.c
+++ gcl-2.6.12/o/cmpaux.c
@@ -48,7 +48,7 @@ DEFUNO_NEW("SPECIALP",object,fSspecialp,
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);
}
--- gcl-2.6.12.orig/o/error.c
+++ gcl-2.6.12/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 */
--- gcl-2.6.12.orig/o/eval.c
+++ gcl-2.6.12/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);
}
--- gcl-2.6.12.orig/o/fasdump.c
+++ gcl-2.6.12/o/fasdump.c
@@ -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);
--- gcl-2.6.12.orig/o/file.d
+++ gcl-2.6.12/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_modu
}
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_modu
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,"");
--- gcl-2.6.12.orig/o/funlink.c
+++ gcl-2.6.12/o/funlink.c
@@ -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 **
}
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 **
/* 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 f
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 a
}
- (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, i
}
- (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)
--- gcl-2.6.12.orig/o/gbc.c
+++ gcl-2.6.12/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
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,stru
}
#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 *b
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 *b
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 (
#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);
+ if (&where > cs_org)
+ (*fn)(0,cs_org,C_GC_OFFSET);
+ else
+ (*fn)(cs_org,0,C_GC_OFFSET);
- contblock_stack_list=NULL;
- }}
+ }
#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;
+ char *new_start=heap_end+holepage*PAGESIZE,*new_end=new_start+nrbpage*PAGESIZE;
- rb_end = heap_end + (holepage + 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
-
+
}
--- gcl-2.6.12.orig/o/gmp.c
+++ gcl-2.6.12/o/gmp.c
@@ -18,12 +18,12 @@ static void *gcl_gmp_realloc(void *oldme
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;
}
--- gcl-2.6.12.orig/o/hash.d
+++ gcl-2.6.12/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-THRES
`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-THRES
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);
--- gcl-2.6.12.orig/o/let.c
+++ gcl-2.6.12/o/let.c
@@ -226,7 +226,7 @@ is an illegal function definition in FLE
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 LAB
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);
}
--- gcl-2.6.12.orig/o/lex.c
+++ gcl-2.6.12/o/lex.c
@@ -58,7 +58,7 @@ lex_macro_bind(object name, object exp_f
{
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);
}
--- gcl-2.6.12.orig/o/macros.c
+++ gcl-2.6.12/o/macros.c
@@ -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;
--- gcl-2.6.12.orig/o/main.c
+++ gcl-2.6.12/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
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
}
#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
static void
init_main(void) {
- make_function("BY", Lby);
+ make_si_function("BY", Lby);
make_si_function("ARGC", siLargc);
make_si_function("ARGV", siLargv);
--- gcl-2.6.12.orig/o/package.d
+++ gcl-2.6.12/o/package.d
@@ -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);
--- gcl-2.6.12.orig/o/predicate.c
+++ gcl-2.6.12/o/predicate.c
@@ -341,9 +341,9 @@ DEFUNO_NEW("FUNCTIONP",object,fLfunction
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),"")
@@ -377,18 +385,6 @@ DEFUNO_NEW("COMPILED-FUNCTION-P",object,
x0 = Ct;
else
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),"") {
--- gcl-2.6.12.orig/o/read.d
+++ gcl-2.6.12/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()`))
--- gcl-2.6.12.orig/o/reference.c
+++ gcl-2.6.12/o/reference.c
@@ -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);
}
--- gcl-2.6.12.orig/o/run_process.c
+++ gcl-2.6.12/o/run_process.c
@@ -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);
--- gcl-2.6.12.orig/o/save.c
+++ gcl-2.6.12/o/save.c
@@ -16,11 +16,12 @@ memory_save(char *original_file, char *s
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
--- gcl-2.6.12.orig/o/sfaslbfd.c
+++ gcl-2.6.12/o/sfaslbfd.c
@@ -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;
--- gcl-2.6.12.orig/o/sfaslelf.c
+++ gcl-2.6.12/o/sfaslelf.c
@@ -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
}
+#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 *
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;
--- gcl-2.6.12.orig/o/sgbc.c
+++ gcl-2.6.12/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
#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.
@@ -134,415 +62,6 @@ sgc_mark_cons(object x) {
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) {
STATIC fixnum i, j;
@@ -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, v
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;
--- gcl-2.6.12.orig/o/string.d
+++ gcl-2.6.12/o/string.d
@@ -403,7 +403,7 @@ LFD(Lstring_not_equal)() { string_sign
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));
--- gcl-2.6.12.orig/o/structure.c
+++ gcl-2.6.12/o/structure.c
@@ -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); */
--- gcl-2.6.12.orig/o/toplevel.c
+++ gcl-2.6.12/o/toplevel.c
@@ -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];
--- gcl-2.6.12.orig/o/typespec.c
+++ gcl-2.6.12/o/typespec.c
@@ -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,LIS
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
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",sLunde
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_
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");
--- gcl-2.6.12.orig/o/unexelf.c
+++ gcl-2.6.12/o/unexelf.c
@@ -634,7 +634,7 @@ find_section (char *name, char *section_
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,
/* 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. */
--- gcl-2.6.12.orig/o/unixsave.c
+++ gcl-2.6.12/o/unixsave.c
@@ -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);
}
--- gcl-2.6.12.orig/o/unixsys.c
+++ gcl-2.6.12/o/unixsys.c
@@ -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);
}
--- gcl-2.6.12.orig/o/unixtime.c
+++ gcl-2.6.12/o/unixtime.c
@@ -282,7 +282,7 @@ DEFUN_NEW("CURRENT-TIMEZONE",object,fScu
localtime_r(&_t, <);
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,fScurren
#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
}
--- gcl-2.6.12.orig/pcl/defsys.lisp
+++ gcl-2.6.12/pcl/defsys.lisp
@@ -52,24 +52,10 @@
(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))
--- gcl-2.6.12.orig/pcl/gcl_pcl_pkg.lisp
+++ gcl-2.6.12/pcl/gcl_pcl_pkg.lisp
@@ -176,11 +176,8 @@
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
--- gcl-2.6.12.orig/pcl/gcl_pcl_walk.lisp
+++ gcl-2.6.12/pcl/gcl_pcl_walk.lisp
@@ -608,7 +608,7 @@
(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)))
@@ -623,7 +623,7 @@
(when env
(let ((entry (assoc macro (second env))))
(and entry
- (eq (cadr entry) 'macro)
+ (eq (cadr entry) 'si::macro)
(caddr entry)))))
);#+(or KCL IBCL)
@@ -1202,7 +1202,7 @@
#+(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.
)
@@ -1367,7 +1367,7 @@
#+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.~%~
--- gcl-2.6.12.orig/pcl/impl/gcl/gcl_pcl_impl_low.lisp
+++ gcl-2.6.12/pcl/impl/gcl/gcl_pcl_impl_low.lisp
@@ -277,17 +277,17 @@ static object set_cclosure (object resul
(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")
--- gcl-2.6.12.orig/pcl/makefile
+++ gcl-2.6.12/pcl/makefile
@@ -9,9 +9,7 @@ GFILES:=$(addprefix gcl_pcl_gazonk,$(GFI
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")' \
--- /dev/null
+++ gcl-2.6.12/pcl/package.lisp
@@ -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)
--- gcl-2.6.12.orig/pcl/sys-proclaim.lisp
+++ gcl-2.6.12/pcl/sys-proclaim.lisp
@@ -1,775 +1,1044 @@
-(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)|
@@ -783,158 +1052,146 @@
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)|
@@ -942,75 +1199,75 @@
|(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|
@@ -1018,290 +1275,287 @@
|(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|
@@ -1309,37 +1563,55 @@
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
@@ -1349,78 +1621,77 @@
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
@@ -1454,5 +1725,6 @@
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))
--- gcl-2.6.12.orig/unixport/makefile
+++ gcl-2.6.12/unixport/makefile
@@ -69,42 +69,7 @@ $(LSPDIR)/auto_new.lsp: $(LSPDIR)/auto.l
[ "$(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
--- gcl-2.6.12.orig/unixport/sys_ansi_gcl.c
+++ gcl-2.6.12/unixport/sys_ansi_gcl.c
@@ -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);
--- gcl-2.6.12.orig/unixport/sys_gcl.c
+++ gcl-2.6.12/unixport/sys_gcl.c
@@ -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);
--- /dev/null
+++ gcl-2.6.12/unixport/sys_init.lsp.in
@@ -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)
--- gcl-2.6.12.orig/unixport/sys_pcl_gcl.c
+++ gcl-2.6.12/unixport/sys_pcl_gcl.c
@@ -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);
--- gcl-2.6.12.orig/unixport/sys_pre_gcl.c
+++ gcl-2.6.12/unixport/sys_pre_gcl.c
@@ -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");
}
--- gcl-2.6.12.orig/xgcl-2/gcl_init_xgcl.lsp
+++ gcl-2.6.12/xgcl-2/gcl_init_xgcl.lsp
@@ -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")
--- gcl-2.6.12.orig/xgcl-2/makefile
+++ gcl-2.6.12/xgcl-2/makefile
@@ -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
--- /dev/null
+++ gcl-2.6.12/xgcl-2/package.lisp
@@ -0,0 +1 @@
+(make-package :XLIB :use '(:lisp :system))
--- /dev/null
+++ gcl-2.6.12/xgcl-2/sys-proclaim.lisp
@@ -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
--- gcl-2.6.12.orig/xgcl-2/sysdef.lisp
+++ gcl-2.6.12/xgcl-2/sysdef.lisp
@@ -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"